+(* 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