From 5597e56d8f5d880cfdd425f4a5d2ae6d2637df70 Mon Sep 17 00:00:00 2001 From: Siraaj Khandkar Date: Thu, 31 May 2018 20:59:05 -0400 Subject: [PATCH] Implement a basic AST printer --- compiler/src/lib/tiger/tiger_absyn.ml | 212 ++++++++++++++++++++----- compiler/src/lib/tiger/tiger_absyn.mli | 82 +++++----- 2 files changed, 209 insertions(+), 85 deletions(-) diff --git a/compiler/src/lib/tiger/tiger_absyn.ml b/compiler/src/lib/tiger/tiger_absyn.ml index 0161a4b..bc8d43d 100644 --- a/compiler/src/lib/tiger/tiger_absyn.ml +++ b/compiler/src/lib/tiger/tiger_absyn.ml @@ -1,6 +1,10 @@ -type pos = Tiger_position.t +open Printf -type symbol = Tiger_symbol.t +module List = ListLabels +module String = StringLabels + +module Sym = Tiger_symbol +module Pos = Tiger_position type oper = | PlusOp @@ -15,130 +19,254 @@ type oper = | GeOp type exp = - | VarExp of - var | NilExp | IntExp of int | StringExp of { string : string - ; pos : pos + ; pos : Pos.t } | CallExp of - { func : symbol + { func : Sym.t ; args : exp list - ; pos : pos + ; pos : Pos.t } | OpExp of { left : exp ; oper : oper ; right : exp - ; pos : pos + ; pos : Pos.t } | RecordExp of - { fields : (symbol * exp * pos) list - ; typ : symbol - ; pos : pos + { fields : (Sym.t * exp * Pos.t) list + ; typ : Sym.t + ; pos : Pos.t } | SeqExp of - (exp * pos) list + (exp * Pos.t) list | AssignExp of { var : var ; exp : exp - ; pos : pos + ; pos : Pos.t } | IfExp of { test : exp ; then' : exp ; else' : exp option - ; pos : pos + ; pos : Pos.t } | WhileExp of { test : exp ; body : exp - ; pos : pos + ; pos : Pos.t } | ForExp of - { var : symbol + { var : Sym.t ; escape : bool ref (* Whoa - why a mutable cell in AST? *) ; lo : exp ; hi : exp ; body : exp - ; pos : pos + ; pos : Pos.t } | BreakExp of - pos + Pos.t | LetExp of { decs : dec list ; body : exp - ; pos : pos + ; pos : Pos.t } | ArrayExp of - { typ : symbol + { typ : Sym.t ; size : exp ; init : exp - ; pos : pos + ; pos : Pos.t } + | VarExp of + var and var = | SimpleVar of - { symbol : symbol - ; pos : pos + { symbol : Sym.t + ; pos : Pos.t } | FieldVar of { var : var - ; symbol : symbol - ; pos : pos + ; symbol : Sym.t + ; pos : Pos.t } | SubscriptVar of { var : var ; exp : exp - ; pos : pos + ; pos : Pos.t } and dec = | FunDecs of (* "FunctionDec" in Appel's code *) fundec list | VarDec of - { name : symbol + { name : Sym.t ; escape : bool ref (* Again, why mutable? *) - ; typ : (symbol * pos) option + ; typ : (Sym.t * Pos.t) option ; init : exp - ; pos : pos + ; pos : Pos.t } | TypeDecs of (* "TypeDec" in Appel's code *) typedec list and ty = | NameTy of - { symbol : symbol - ; pos : pos + { symbol : Sym.t + ; pos : Pos.t } | RecordTy of field list | ArrayTy of - { symbol : symbol - ; pos : pos + { symbol : Sym.t + ; pos : Pos.t } and field = | Field of - { name : symbol + { name : Sym.t ; escape : bool ref - ; typ : symbol - ; pos : pos + ; typ : Sym.t + ; pos : Pos.t } and typedec = | TypeDec of (* An anonymous record in Appel's code *) - { name : symbol + { name : Sym.t ; ty : ty - ; pos : pos + ; pos : Pos.t } and fundec = | FunDec of - { name : symbol + { name : Sym.t ; params : field list - ; result : (symbol * pos) option + ; result : (Sym.t * Pos.t) option ; body : exp - ; pos : pos + ; pos : Pos.t } type t = exp -let to_string _ = "TODO: implement Tiger_absyn.to_string" +let op_to_string = function + | PlusOp -> "PlusOp" + | MinusOp -> "MinusOp" + | TimesOp -> "TimesOp" + | DivideOp -> "DivideOp" + | EqOp -> "EqOp" + | NeqOp -> "NeqOp" + | LtOp -> "LtOp" + | LeOp -> "LeOp" + | GtOp -> "GtOp" + | GeOp -> "GeOp" + +let xs_to_string ?(sep=", ") ~f xs = + xs |> List.map ~f |> String.concat ~sep + +let field_to_string (Field {name; typ; _}) = + let name = Sym.to_string name in + let typ = Sym.to_string typ in + name ^ " : " ^ typ + +let fields_to_string fields = + xs_to_string fields ~f:field_to_string +let rec exp_to_string exp = + (match exp with + | NilExp -> + "NilExp[]" + | IntExp i -> + sprintf "IntExp[%d]" i + | StringExp {string; _} -> + sprintf "StringExp[%S]" string + | CallExp {func; args; _} -> + let func = Sym.to_string func in + let args = xs_to_string args ~f:exp_to_string in + sprintf "CallExp[%s, %s]" func args + | OpExp {left; oper; right; _} -> + let oper = op_to_string oper in + let left = exp_to_string left in + let right = exp_to_string right in + sprintf "OpExp[%s[%s, %s]]" oper left right + | RecordExp {fields; typ; _} -> + let fields = + xs_to_string + fields + ~f:(fun (s, e, _) -> (Sym.to_string s) ^ " = " ^ (exp_to_string e)) + in + let typ = Sym.to_string typ in + sprintf "RecordExp[%s, %s]" typ fields + | SeqExp exps -> + exps + |> List.map ~f:(fun (exp, _pos) -> exp) + |> xs_to_string ~f:exp_to_string + |> sprintf "SeqExp[%s]" + | AssignExp {var; exp; _} -> + let var = var_to_string var in + let exp = exp_to_string exp in + sprintf "AssignExp[%s, %s]" var exp + | IfExp {test; then'; else'; _} -> + let test = exp_to_string test in + let then' = exp_to_string then' in + (match else' with + | None -> sprintf "IfThen[%s, %s]" test then' + | Some e -> sprintf "IfThenElse[%s, %s, %s]" test then' (exp_to_string e) + ) + | WhileExp {test; body; _} -> + let test = exp_to_string test in + let body = exp_to_string body in + sprintf "WhileExp[%s, %s]" test body + | ForExp {var; lo; hi; body; _} -> + sprintf + "ForExp[ForVar[%S], ForLo[%s], ForHi[%s], ForBody[%s]]" + (Sym.to_string var) + (exp_to_string lo) + (exp_to_string hi) + (exp_to_string body) + | BreakExp _ -> + "BreakExp[]" + | LetExp {decs; body; _} -> + let decs = xs_to_string decs ~f:dec_to_string in + let body = exp_to_string body in + sprintf "LetExp[LetDecs[%s], LetIn[%s]]" decs body + | ArrayExp {typ; size; init; _} -> + let typ = Sym.to_string typ in + let size = exp_to_string size in + let init = exp_to_string init in + sprintf "ArrayExp[%s, %s, %s]" typ size init + | VarExp var -> + sprintf "VarExp[%s]" (var_to_string var) + ) +and var_to_string = function + | SimpleVar {symbol; _} -> + sprintf "SimpleVar[%s]" (Sym.to_string symbol) + | FieldVar {var; symbol; _} -> + sprintf "FieldVar[%s, %s]" (var_to_string var) (Sym.to_string symbol) + | SubscriptVar {var; exp; _} -> + sprintf "SubscriptVar[%s, %s]" (var_to_string var) (exp_to_string exp) +and dec_to_string = function + | VarDec {name; typ; init; _} -> + let name = Sym.to_string name in + let init = exp_to_string init in + (match typ with + | Some (typ, _) -> + let typ = Sym.to_string typ in + sprintf "VarDec[%s, %s, %s]" name typ init + | None -> + sprintf "VarDec[%s, %s]" name init + ) + | TypeDecs type_decs -> + sprintf "TypeDecs[%s]" (xs_to_string type_decs ~f:type_dec_to_string) + | FunDecs fun_decs -> + sprintf "FunDecs[%s]" (xs_to_string fun_decs ~f:fun_dec_to_string) +and fun_dec_to_string = function + | FunDec {name; params; body; _} -> + let name = Sym.to_string name in + let params = fields_to_string params in + let body = exp_to_string body in + sprintf "FunDec[%s, FunParams[%s], FunBody[%s]]" name params body +and type_dec_to_string = function + | TypeDec {name; ty; _} -> + sprintf "TypeDec[%s, %s]" (Sym.to_string name) (ty_to_string ty) +and ty_to_string = function + | NameTy {symbol; _} -> sprintf "NameTy[%s]" (Sym.to_string symbol) + | ArrayTy {symbol; _} -> sprintf "ArrayTy[%s]" (Sym.to_string symbol) + | RecordTy fields -> sprintf "RecordTy[%s]" (fields_to_string fields) + +let to_string = exp_to_string diff --git a/compiler/src/lib/tiger/tiger_absyn.mli b/compiler/src/lib/tiger/tiger_absyn.mli index 12dc6a8..662f637 100644 --- a/compiler/src/lib/tiger/tiger_absyn.mli +++ b/compiler/src/lib/tiger/tiger_absyn.mli @@ -1,7 +1,3 @@ -type pos = Tiger_position.t - -type symbol = Tiger_symbol.t - type oper = | PlusOp | MinusOp @@ -15,128 +11,128 @@ type oper = | GeOp type exp = - | VarExp of - var | NilExp | IntExp of int | StringExp of { string : string - ; pos : pos + ; pos : Tiger_position.t } | CallExp of - { func : symbol + { func : Tiger_symbol.t ; args : exp list - ; pos : pos + ; pos : Tiger_position.t } | OpExp of { left : exp ; oper : oper ; right : exp - ; pos : pos + ; pos : Tiger_position.t } | RecordExp of - { fields : (symbol * exp * pos) list - ; typ : symbol - ; pos : pos + { fields : (Tiger_symbol.t * exp * Tiger_position.t) list + ; typ : Tiger_symbol.t + ; pos : Tiger_position.t } | SeqExp of - (exp * pos) list + (exp * Tiger_position.t) list | AssignExp of { var : var ; exp : exp - ; pos : pos + ; pos : Tiger_position.t } | IfExp of { test : exp ; then' : exp ; else' : exp option - ; pos : pos + ; pos : Tiger_position.t } | WhileExp of { test : exp ; body : exp - ; pos : pos + ; pos : Tiger_position.t } | ForExp of - { var : symbol + { var : Tiger_symbol.t ; escape : bool ref (* Whoa - why a mutable cell in AST? *) ; lo : exp ; hi : exp ; body : exp - ; pos : pos + ; pos : Tiger_position.t } | BreakExp of - pos + Tiger_position.t | LetExp of { decs : dec list ; body : exp - ; pos : pos + ; pos : Tiger_position.t } | ArrayExp of - { typ : symbol + { typ : Tiger_symbol.t ; size : exp ; init : exp - ; pos : pos + ; pos : Tiger_position.t } + | VarExp of + var and var = | SimpleVar of - { symbol : symbol - ; pos : pos + { symbol : Tiger_symbol.t + ; pos : Tiger_position.t } | FieldVar of { var : var - ; symbol : symbol - ; pos : pos + ; symbol : Tiger_symbol.t + ; pos : Tiger_position.t } | SubscriptVar of { var : var ; exp : exp - ; pos : pos + ; pos : Tiger_position.t } and dec = | FunDecs of (* "FunctionDec" in Appel's code *) fundec list | VarDec of - { name : symbol + { name : Tiger_symbol.t ; escape : bool ref (* Again, why mutable? *) - ; typ : (symbol * pos) option + ; typ : (Tiger_symbol.t * Tiger_position.t) option ; init : exp - ; pos : pos + ; pos : Tiger_position.t } | TypeDecs of (* "TypeDec" in Appel's code *) typedec list and ty = | NameTy of - { symbol : symbol - ; pos : pos + { symbol : Tiger_symbol.t + ; pos : Tiger_position.t } | RecordTy of field list | ArrayTy of - { symbol : symbol - ; pos : pos + { symbol : Tiger_symbol.t + ; pos : Tiger_position.t } and field = | Field of - { name : symbol + { name : Tiger_symbol.t ; escape : bool ref - ; typ : symbol - ; pos : pos + ; typ : Tiger_symbol.t + ; pos : Tiger_position.t } and typedec = | TypeDec of (* An anonymous record in Appel's code *) - { name : symbol + { name : Tiger_symbol.t ; ty : ty - ; pos : pos + ; pos : Tiger_position.t } and fundec = | FunDec of - { name : symbol + { name : Tiger_symbol.t ; params : field list - ; result : (symbol * pos) option + ; result : (Tiger_symbol.t * Tiger_position.t) option ; body : exp - ; pos : pos + ; pos : Tiger_position.t } type t = exp -- 2.20.1