Add pretty printer for Top

src/Main.ml

@@ -90,6 +90,7 @@ let process filename =
   |> dump "PrettyTail" PrettyTail.show
   |> Defun.defun_term
   |> dump "Top" Top.show_program
+  |> dump "PrettyTop" PrettyTop.show
   |> Finish.finish_program
   |> dump "C" C.show_program
   |> output

src/prettify/PrettyTop.ml

@@ -0,0 +1,59 @@
+module S = Top
+open PrettyCommon
+
+let fmt_tag fmt tag = Format.fprintf fmt "%d" tag
+
+let fmt_block fmt (S.Con(tag, args)) =
+    Format.fprintf fmt "Block[%a](%a)"
+        fmt_tag tag
+        fmt_vals args
+
+let rec fmt_term fmt (term: S.term) = match term with
+| S.Exit -> Format.fprintf fmt "Exit"
+| S.TailCall (fct, args) ->
+        Format.fprintf fmt "Call %a %a"
+            fmt_var fct
+            fmt_vals args
+| S.Print (value, next) ->
+        Format.fprintf fmt "Print %a@ %a"
+            fmt_val value
+            fmt_term next
+| S.LetVal (name, value, next) ->
+        Format.fprintf fmt "@[<v 4>letv %a = %a in@]@ %a"
+            fmt_var name
+            fmt_val value
+            fmt_term next
+| S.LetBlo (name, block, next) ->
+        Format.fprintf fmt "@[<v 4>let %a = %a in@]@ %a"
+            fmt_var name
+            fmt_block block
+            fmt_term next
+| S.Swi (value, branches) ->
+        Format.fprintf fmt "@[<v 4>switch(%a)" fmt_val value ;
+        List.iter
+            (fun branch -> Format.fprintf fmt "@ %a" fmt_branch branch)
+            branches ;
+        Format.fprintf fmt "@]"
+
+and fmt_branch fmt (S.Branch (tag, args, body)) =
+    Format.fprintf fmt "@[<v 4>Case %a [%a]:@ %a@]"
+        fmt_tag tag
+        fmt_vars args
+        fmt_term body
+
+let fmt_function fmt (S.Fun(name, args, body)) =
+    Format.fprintf fmt "@[<v 4>Fun %a %a =@ %a@]"
+        fmt_var name
+        fmt_vars args
+        fmt_term body
+
+let fmt_program fmt (S.Prog(funcs, body)) =
+    Format.fprintf fmt "@[<v 0>" ;
+    List.iter
+        (fun fct ->
+            Format.fprintf fmt "%a@ @ " fmt_function fct)
+        funcs ;
+    Format.fprintf fmt "%a@ @]" fmt_term body
+
+let show (prog: S.program) =
+    Format.asprintf "%a" fmt_program prog

src/prettify/PrettyTop.mli

@@ -0,0 +1 @@
+val show: Top.program -> string