Implement a basic AST printer

diff --git a/compiler/src/lib/tiger/tiger_absyn.ml b/compiler/src/lib/tiger/tiger_absyn.ml
index 0161a4b..bc8d43d 100644 (file)
--- 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 (file)
--- 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