compiler/src/lib/tiger/tiger_absyn.ml

   1 open Printf
   2
   3 module List   = ListLabels
   4 module String = StringLabels
   5
   6 module Sym = Tiger_symbol
   7 module Pos = Tiger_position
   8
   9 module Indent : sig
  10   type t
  11   val init : enabled:bool -> unit:string -> t
  12   val next : t -> t
  13   val to_string : t -> string
  14 end = struct
  15   type t =
  16     { unit   : string option
  17     ; levels : int
  18     }
  19
  20   let init ~enabled ~unit =
  21     { unit   = if enabled then Some unit else None
  22     ; levels = 0
  23     }
  24
  25   let next t =
  26     {t with levels = succ t.levels}
  27
  28   let to_string = function
  29     | {unit=None; _} ->
  30         ""
  31     | {unit=Some u; levels} ->
  32         let rec add = function
  33           | 0 -> ""
  34           | n -> u ^ (add (pred n))
  35         in
  36         "\n" ^ (add levels)
  37 end
  38
  39 type oper =
  40   | PlusOp
  41   | MinusOp
  42   | TimesOp
  43   | DivideOp
  44   | EqOp
  45   | NeqOp
  46   | LtOp
  47   | LeOp
  48   | GtOp
  49   | GeOp
  50
  51 type exp =
  52   | NilExp
  53   | IntExp of
  54       int
  55   | StringExp of
  56       { string : string
  57       ; pos    : Pos.t
  58       }
  59   | CallExp of
  60       { func : Sym.t
  61       ; args : exp list
  62       ; pos  : Pos.t
  63       }
  64   | OpExp of
  65       { left  : exp
  66       ; oper  : oper
  67       ; right : exp
  68       ; pos   : Pos.t
  69       }
  70   | RecordExp of
  71       { fields : (Sym.t * exp * Pos.t) list
  72       ; typ    : Sym.t
  73       ; pos    : Pos.t
  74       }
  75   | SeqExp of
  76       (exp * Pos.t) list
  77   | AssignExp of
  78       { var : var
  79       ; exp : exp
  80       ; pos : Pos.t
  81       }
  82   | IfExp of
  83       { test  : exp
  84       ; then' : exp
  85       ; else' : exp option
  86       ; pos   : Pos.t
  87       }
  88   | WhileExp of
  89       { test : exp
  90       ; body : exp
  91       ; pos  : Pos.t
  92       }
  93   | ForExp of
  94       { var    : Sym.t
  95       ; escape : bool ref  (* Whoa - why a mutable cell in AST? *)
  96       ; lo     : exp
  97       ; hi     : exp
  98       ; body   : exp
  99       ; pos    : Pos.t
 100       }
 101   | BreakExp of
 102       Pos.t
 103   | LetExp of
 104       { decs : dec list
 105       ; body : exp
 106       ; pos  : Pos.t
 107       }
 108   | ArrayExp of
 109       { typ  : Sym.t
 110       ; size : exp
 111       ; init : exp
 112       ; pos  : Pos.t
 113       }
 114   | VarExp of
 115       var
 116 and var =
 117   | SimpleVar of
 118       { symbol : Sym.t
 119       ; pos    : Pos.t
 120       }
 121   | FieldVar of
 122       { var    : var
 123       ; symbol : Sym.t
 124       ; pos    : Pos.t
 125       }
 126   | SubscriptVar of
 127       { var : var
 128       ; exp : exp
 129       ; pos : Pos.t
 130       }
 131 and dec =
 132   | FunDecs of  (* "FunctionDec" in Appel's code *)
 133       fundec list
 134   | VarDec of
 135       { name   : Sym.t
 136       ; escape : bool ref  (* Again, why mutable? *)
 137       ; typ    : (Sym.t * Pos.t) option
 138       ; init   : exp
 139       ; pos    : Pos.t
 140       }
 141   | TypeDecs of  (* "TypeDec" in Appel's code *)
 142       typedec list
 143 and ty =
 144   | NameTy of
 145       { symbol : Sym.t
 146       ; pos    : Pos.t
 147       }
 148   | RecordTy of
 149       field list
 150   | ArrayTy of
 151       { symbol : Sym.t
 152       ; pos    : Pos.t
 153       }
 154 and field =
 155   | Field of
 156     { name   : Sym.t
 157     ; escape : bool ref
 158     ; typ    : Sym.t
 159     ; pos    : Pos.t
 160     }
 161 and typedec =
 162   | TypeDec of  (* An anonymous record in Appel's code *)
 163       { name : Sym.t
 164       ; ty   : ty
 165       ; pos  : Pos.t
 166       }
 167 and fundec =
 168   | FunDec of
 169     { name   : Sym.t
 170     ; params : field list
 171     ; result : (Sym.t * Pos.t) option
 172     ; body   : exp
 173     ; pos    : Pos.t
 174     }
 175
 176 type t = exp
 177
 178 (* For printing error messages *)
 179 let op_show op =
 180   match op with
 181   | PlusOp   -> "+"
 182   | MinusOp  -> "-"
 183   | TimesOp  -> "*"
 184   | DivideOp -> "/"
 185   | EqOp     -> "="
 186   | NeqOp    -> "<>"
 187   | LtOp     -> "<"
 188   | LeOp     -> "<="
 189   | GtOp     -> ">"
 190   | GeOp     -> ">="
 191
 192 (* For printing AST *)
 193 let op_to_string op =
 194   match op with
 195   | PlusOp   -> "PlusOp"
 196   | MinusOp  -> "MinusOp"
 197   | TimesOp  -> "TimesOp"
 198   | DivideOp -> "DivideOp"
 199   | EqOp     -> "EqOp"
 200   | NeqOp    -> "NeqOp"
 201   | LtOp     -> "LtOp"
 202   | LeOp     -> "LeOp"
 203   | GtOp     -> "GtOp"
 204   | GeOp     -> "GeOp"
 205
 206 let xs_to_string ?(sep=",") ~f ~indent xs =
 207   let i = Indent.to_string indent in
 208   xs |> List.map ~f:(fun x -> i ^ (f x)) |> String.concat ~sep
 209
 210 let mexp name params ~indent =
 211   let params = xs_to_string ~f:(fun x -> x) ~indent params in
 212   sprintf "%s[%s]" name params
 213
 214 let field_to_string ~indent (Field {name; typ; _}) =
 215   let name   = Sym.to_string name in
 216   let typ    = Sym.to_string typ in
 217   let indent = Indent.to_string indent in
 218   sprintf "%s%s : %s" indent name typ
 219
 220 let fields_to_string fields ~indent =
 221   let fields = List.map fields ~f:(field_to_string ~indent) in
 222   mexp "" fields ~indent
 223
 224 let rec exp_to_string ~indent exp =
 225   let indent = Indent.next indent in
 226   let mexp = mexp ~indent in
 227   (match exp with
 228   | NilExp ->
 229       mexp "NilExp" []
 230   | IntExp i ->
 231       mexp "IntExp" [(string_of_int i)]
 232   | StringExp {string; _} ->
 233       mexp "StringExp" [sprintf "%S" string]
 234   | CallExp {func; args; _} ->
 235       let func = Sym.to_string func in
 236       let args = List.map args ~f:(exp_to_string ~indent) in
 237       mexp "CallExp" [func; mexp "" args]
 238   | OpExp {left; oper; right; _} ->
 239       let op_exp =
 240         let indent = Indent.next indent in
 241         let oper   = op_to_string oper in
 242         let left   = exp_to_string ~indent left in
 243         let right  = exp_to_string ~indent right in
 244         mexp oper [left; right]
 245       in
 246       mexp "OpExp" [op_exp]
 247   | RecordExp {fields; typ; _} ->
 248       let fields =
 249         List.map fields ~f:(fun (sym, exp, _) ->
 250           sprintf
 251             "%s = %s"
 252             (Sym.to_string sym)
 253             (exp_to_string ~indent exp)
 254         )
 255       in
 256       let typ = Sym.to_string typ in
 257       mexp "RecordExp" [typ; mexp "" fields]
 258   | SeqExp exps ->
 259       exps
 260       |> List.map ~f:(fun (e, _) -> exp_to_string e ~indent)
 261       |> mexp "SeqExp"
 262   | AssignExp {var; exp; _} ->
 263       let var = var_to_string ~indent var in
 264       let exp = exp_to_string ~indent exp in
 265       mexp "AssignExp" [var; exp]
 266   | IfExp {test; then'; else'; _} ->
 267       let test  = exp_to_string ~indent test in
 268       let then' = exp_to_string ~indent then' in
 269       (match else' with
 270       | None ->
 271           mexp "IfThen"     [test; then']
 272       | Some e ->
 273           mexp "IfThenElse" [test; then'; (exp_to_string ~indent e)]
 274       )
 275   | WhileExp {test; body; _} ->
 276       let test = exp_to_string ~indent test in
 277       let body = exp_to_string ~indent body in
 278       mexp "WhileExp" [test; body]
 279   | ForExp {var; lo; hi; body; _} ->
 280       mexp "ForExp"
 281         [ (Sym.to_string var)
 282         ; (exp_to_string ~indent lo)
 283         ; (exp_to_string ~indent hi)
 284         ; (exp_to_string ~indent body)
 285         ]
 286   | BreakExp _ ->
 287       mexp "BreakExp" []
 288   | LetExp {decs; body; _} ->
 289       let decs = List.map decs ~f:(dec_to_string ~indent) in
 290       let body = exp_to_string ~indent body in
 291       mexp "LetExp" [mexp "" decs; body]
 292   | ArrayExp {typ; size; init; _} ->
 293       let typ = Sym.to_string typ in
 294       let size = exp_to_string ~indent size in
 295       let init = exp_to_string ~indent init in
 296       mexp "ArrayExp" [typ; size; init]
 297   | VarExp var ->
 298       mexp "VarExp" [(var_to_string ~indent var)]
 299   )
 300 and var_to_string ~indent var =
 301   let indent = Indent.next indent in
 302   let mexp = mexp ~indent in
 303   match var with
 304   | SimpleVar {symbol; _} ->
 305       mexp "SimpleVar" [(Sym.to_string symbol)]
 306   | FieldVar {var; symbol; _} ->
 307       mexp "FieldVar"
 308         [ (var_to_string ~indent var)
 309         ; (Sym.to_string symbol)
 310         ]
 311   | SubscriptVar {var; exp; _} ->
 312       mexp "SubscriptVar[%s]"
 313         [ (var_to_string ~indent var)
 314         ; (exp_to_string ~indent exp)
 315         ]
 316 and dec_to_string ~indent dec =
 317   let indent = Indent.next indent in
 318   let mexp = mexp ~indent in
 319   match dec with
 320   | VarDec {name; typ; init; _} ->
 321       let name = Sym.to_string name in
 322       let init = exp_to_string ~indent init in
 323       (match typ with
 324       | Some (typ, _) ->
 325           let typ = Sym.to_string typ in
 326           mexp "VarDec" [name; typ; init]
 327       | None ->
 328           mexp "VarDec" [name; init]
 329       )
 330   | TypeDecs type_decs ->
 331       mexp "TypeDecs"
 332         (List.map type_decs ~f:(type_dec_to_string ~indent))
 333   | FunDecs fun_decs ->
 334       mexp "FunDecs"
 335         (List.map fun_decs ~f:(fun_dec_to_string ~indent))
 336 and fun_dec_to_string ~indent fun_dec =
 337   let indent = Indent.next indent in
 338   let mexp = mexp ~indent in
 339   match fun_dec with
 340   | FunDec {name; params; body; _} ->
 341       let name = Sym.to_string name in
 342       let params = fields_to_string ~indent params in
 343       let body = exp_to_string ~indent body in
 344       mexp "FunDec" [name; params; body]
 345 and type_dec_to_string ~indent type_dec =
 346   let indent = Indent.next indent in
 347   let mexp = mexp ~indent in
 348   match type_dec with
 349   | TypeDec {name; ty; _} ->
 350       mexp "TypeDec"
 351         [ (Sym.to_string name)
 352         ; (ty_to_string ~indent ty)
 353         ]
 354 and ty_to_string ~indent ty =
 355   let mexp = mexp ~indent in
 356   match ty with
 357   | NameTy   {symbol; _} -> mexp "NameTy"   [(Sym.to_string symbol)]
 358   | ArrayTy  {symbol; _} -> mexp "ArrayTy"  [(Sym.to_string symbol)]
 359   | RecordTy fields      -> mexp "RecordTy" [(fields_to_string ~indent fields)]
 360
 361 let to_string =
 362   let unit = String.make 4 ' ' in
 363   let indent = Indent.init ~enabled:true ~unit in
 364   exp_to_string ~indent