X-Git-Url: https://git.xandkar.net/?a=blobdiff_plain;f=compiler%2Fsrc%2Flib%2Ftiger%2Ftiger_absyn.ml;h=73a081a0df5dc906c1d5b4c3772726e5c9c35cd4;hb=c16dd441582b7c7c09cdb3e706f4767a5b266177;hp=0161a4bf63dc9c396d923b3e8d0f87ab28ffbed5;hpb=cda83e5ec171672a59966d2bd9cd28bd7a8fe083;p=tiger.ml.git

diff --git a/compiler/src/lib/tiger/tiger_absyn.ml b/compiler/src/lib/tiger/tiger_absyn.ml
index 0161a4b..73a081a 100644
--- a/compiler/src/lib/tiger/tiger_absyn.ml
+++ b/compiler/src/lib/tiger/tiger_absyn.ml
@@ -1,6 +1,40 @@
-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
+
+module Indent : sig
+  type t
+  val init : enabled:bool -> unit:string -> t
+  val next : t -> t
+  val to_string : t -> string
+end = struct
+  type t =
+    { unit   : string option
+    ; levels : int
+    }
+
+  let init ~enabled ~unit =
+    { unit   = if enabled then Some unit else None
+    ; levels = 0
+    }
+
+  let next t =
+    {t with levels = succ t.levels}
+
+  let to_string = function
+    | {unit=None; _} ->
+        ""
+    | {unit=Some u; levels} ->
+        let rec add = function
+          | 0 -> ""
+          | n -> u ^ (add (pred n))
+        in
+        "\n" ^ (add levels)
+end
 
 type oper =
   | PlusOp
@@ -15,130 +49,316 @@ 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"
+(* For printing error messages *)
+let op_show op =
+  match op with
+  | PlusOp   -> "+"
+  | MinusOp  -> "-"
+  | TimesOp  -> "*"
+  | DivideOp -> "/"
+  | EqOp     -> "="
+  | NeqOp    -> "<>"
+  | LtOp     -> "<"
+  | LeOp     -> "<="
+  | GtOp     -> ">"
+  | GeOp     -> ">="
+
+(* For printing AST *)
+let op_to_string op =
+  match op with
+  | 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 ~indent xs =
+  let i = Indent.to_string indent in
+  xs |> List.map ~f:(fun x -> i ^ (f x)) |> String.concat ~sep
+
+let mexp name params ~indent =
+  let params = xs_to_string ~f:(fun x -> x) ~indent params in
+  sprintf "%s[%s]" name params
+
+let field_to_string ~indent (Field {name; typ; _}) =
+  let name   = Sym.to_string name in
+  let typ    = Sym.to_string typ in
+  let indent = Indent.to_string indent in
+  sprintf "%s%s : %s" indent name typ
+
+let fields_to_string fields ~indent =
+  let fields = List.map fields ~f:(field_to_string ~indent) in
+  mexp "" fields ~indent
+
+let rec exp_to_string ~indent exp =
+  let indent = Indent.next indent in
+  let mexp = mexp ~indent in
+  (match exp with
+  | NilExp ->
+      mexp "NilExp" []
+  | IntExp i ->
+      mexp "IntExp" [(string_of_int i)]
+  | StringExp {string; _} ->
+      mexp "StringExp" [sprintf "%S" string]
+  | CallExp {func; args; _} ->
+      let func = Sym.to_string func in
+      let args = List.map args ~f:(exp_to_string ~indent) in
+      mexp "CallExp" [func; mexp "" args]
+  | OpExp {left; oper; right; _} ->
+      let op_exp =
+        let indent = Indent.next indent in
+        let oper   = op_to_string oper in
+        let left   = exp_to_string ~indent left in
+        let right  = exp_to_string ~indent right in
+        mexp oper [left; right]
+      in
+      mexp "OpExp" [op_exp]
+  | RecordExp {fields; typ; _} ->
+      let fields =
+        List.map fields ~f:(fun (sym, exp, _) ->
+          sprintf
+            "%s = %s"
+            (Sym.to_string sym)
+            (exp_to_string ~indent exp)
+        )
+      in
+      let typ = Sym.to_string typ in
+      mexp "RecordExp" [typ; mexp "" fields]
+  | SeqExp exps ->
+      exps
+      |> List.map ~f:(fun (e, _) -> exp_to_string e ~indent)
+      |> mexp "SeqExp"
+  | AssignExp {var; exp; _} ->
+      let var = var_to_string ~indent var in
+      let exp = exp_to_string ~indent exp in
+      mexp "AssignExp" [var; exp]
+  | IfExp {test; then'; else'; _} ->
+      let test  = exp_to_string ~indent test in
+      let then' = exp_to_string ~indent then' in
+      (match else' with
+      | None ->
+          mexp "IfThen"     [test; then']
+      | Some e ->
+          mexp "IfThenElse" [test; then'; (exp_to_string ~indent e)]
+      )
+  | WhileExp {test; body; _} ->
+      let test = exp_to_string ~indent test in
+      let body = exp_to_string ~indent body in
+      mexp "WhileExp" [test; body]
+  | ForExp {var; lo; hi; body; _} ->
+      mexp "ForExp"
+        [ (Sym.to_string var)
+        ; (exp_to_string ~indent lo)
+        ; (exp_to_string ~indent hi)
+        ; (exp_to_string ~indent body)
+        ]
+  | BreakExp _ ->
+      mexp "BreakExp" []
+  | LetExp {decs; body; _} ->
+      let decs = List.map decs ~f:(dec_to_string ~indent) in
+      let body = exp_to_string ~indent body in
+      mexp "LetExp" [mexp "" decs; body]
+  | ArrayExp {typ; size; init; _} ->
+      let typ = Sym.to_string typ in
+      let size = exp_to_string ~indent size in
+      let init = exp_to_string ~indent init in
+      mexp "ArrayExp" [typ; size; init]
+  | VarExp var ->
+      mexp "VarExp" [(var_to_string ~indent var)]
+  )
+and var_to_string ~indent var =
+  let indent = Indent.next indent in
+  let mexp = mexp ~indent in
+  match var with
+  | SimpleVar {symbol; _} ->
+      mexp "SimpleVar" [(Sym.to_string symbol)]
+  | FieldVar {var; symbol; _} ->
+      mexp "FieldVar"
+        [ (var_to_string ~indent var)
+        ; (Sym.to_string symbol)
+        ]
+  | SubscriptVar {var; exp; _} ->
+      mexp "SubscriptVar[%s]"
+        [ (var_to_string ~indent var)
+        ; (exp_to_string ~indent exp)
+        ]
+and dec_to_string ~indent dec =
+  let indent = Indent.next indent in
+  let mexp = mexp ~indent in
+  match dec with
+  | VarDec {name; typ; init; _} ->
+      let name = Sym.to_string name in
+      let init = exp_to_string ~indent init in
+      (match typ with
+      | Some (typ, _) ->
+          let typ = Sym.to_string typ in
+          mexp "VarDec" [name; typ; init]
+      | None ->
+          mexp "VarDec" [name; init]
+      )
+  | TypeDecs type_decs ->
+      mexp "TypeDecs"
+        (List.map type_decs ~f:(type_dec_to_string ~indent))
+  | FunDecs fun_decs ->
+      mexp "FunDecs"
+        (List.map fun_decs ~f:(fun_dec_to_string ~indent))
+and fun_dec_to_string ~indent fun_dec =
+  let indent = Indent.next indent in
+  let mexp = mexp ~indent in
+  match fun_dec with
+  | FunDec {name; params; body; _} ->
+      let name = Sym.to_string name in
+      let params = fields_to_string ~indent params in
+      let body = exp_to_string ~indent body in
+      mexp "FunDec" [name; params; body]
+and type_dec_to_string ~indent type_dec =
+  let indent = Indent.next indent in
+  let mexp = mexp ~indent in
+  match type_dec with
+  | TypeDec {name; ty; _} ->
+      mexp "TypeDec"
+        [ (Sym.to_string name)
+        ; (ty_to_string ~indent ty)
+        ]
+and ty_to_string ~indent ty =
+  let mexp = mexp ~indent in
+  match ty with
+  | NameTy   {symbol; _} -> mexp "NameTy"   [(Sym.to_string symbol)]
+  | ArrayTy  {symbol; _} -> mexp "ArrayTy"  [(Sym.to_string symbol)]
+  | RecordTy fields      -> mexp "RecordTy" [(fields_to_string ~indent fields)]
+
+let to_string =
+  let unit = String.make 4 ' ' in
+  let indent = Indent.init ~enabled:true ~unit in
+  exp_to_string ~indent