let pretty_print (prog_name, main) =
let get_spaces n =
if n <= 0 then "" else String.make n ' '
in
let string_of_var v =
(string_of_type v.var_type) ^ " " ^ v.var_name
in
let string_of_nature = function
| Varb -> "var"
| Cst -> "cst"
| Fun -> "fun"
| Unknown_nature -> "???"
in
let rec string_of_expression expr =
"(" ^ (string_of_type expr.expr_type) ^ ") " ^
match expr.expr_val with
| Lt(e1, e2) -> (string_of_expression e1) ^ " < " ^ (string_of_expression e2)
| Le(e1, e2) -> (string_of_expression e1) ^ " <= " ^ (string_of_expression e2)
| Eq(e1, e2) -> (string_of_expression e1) ^ " = " ^ (string_of_expression e2)
| Neq(e1, e2) -> (string_of_expression e1) ^ " <> " ^ (string_of_expression e2)
| Plus(e1, e2) -> (string_of_expression e1) ^ " + " ^ (string_of_expression e2)
| Minus(e1, e2) -> (string_of_expression e1) ^ " - " ^ (string_of_expression e2)
| Mult(e1, e2) -> (string_of_expression e1) ^ " * " ^ (string_of_expression e2)
| Div(e1, e2) -> (string_of_expression e1) ^ " / " ^ (string_of_expression e2)
| Mod(e1, e2) -> (string_of_expression e1) ^ " mod " ^ (string_of_expression e2)
| And(e1, e2) -> (string_of_expression e1) ^ " and " ^ (string_of_expression e2)
| Or(e1, e2) -> (string_of_expression e1) ^ " or " ^ (string_of_expression e2)
| Not e -> "not " ^ (string_of_expression e)
| Uminus e -> "-" ^ (string_of_expression e)
| Int i -> string_of_int i
| Bool b -> if b then "true" else "false"
| Var(v, el) ->
v.var_name ^ (String.concat " " (List.map string_of_expression el))
| Arr(e1, e2) -> (string_of_expression e1) ^ "[" ^ (string_of_expression e2) ^ "]"
| Rec(e, f) -> (string_of_expression e) ^ "." ^ f
in
let rec string_of_statement d st =
get_spaces d ^
(
match st.stt_value with
| Assign(v, e) ->
(string_of_var v) ^ " := " ^ (string_of_expression e)
| Proc(v, el) ->
(v.var_name) ^ " (" ^ (String.concat " " (List.map string_of_expression el)) ^ ")"
| ExtProc(n, el) ->
n ^ " (" ^ (String.concat " " (List.map string_of_expression el)) ^ ")"
| Compound stts ->
string_of_statements d stts
| If (e, s1, s2) ->
"if " ^ (string_of_expression e) ^ " then\n" ^ (string_of_statement (d + 2) s1) ^ (get_spaces d) ^ "else\n" ^ (string_of_statement (d + 2) s2)
| While (e, s) ->
"while " ^ (string_of_expression e) ^ "\n" ^ (string_of_statement (d + 2) s)
| Noop -> "NOP"
) ^ "\n"
and string_of_statements d stts =
String.concat "" (List.map (string_of_statement (d + 4)) stts)
in
let rec string_of_value d = function
| Constant c -> string_of_expression c
| Variable -> "<var>"
| Variable_ref -> "<var_ref>"
| Procedure (a, b) ->
"<proc>\n" ^ string_of_block (d + 2) b
| Function _ -> "<fun>"
| Type t -> "<type : " ^ (string_of_type t) ^ ">"
and string_of_block d block =
(fold_env
(fun n v s ->
s ^
get_spaces d ^ (string_of_nature v.def_nature) ^ " " ^ (string_of_type v.def_type) ^ " " ^ v.def_name ^ " = " ^ (string_of_value d v.def_value) ^ "\n"
) "" block.block_env
) ^ (string_of_statements d block.block_stts)
in
prog_name ^ "\n" ^ (String.make (String.length prog_name) '=') ^ "\n\n" ^ (string_of_block 0 main)