diff --git a/src/Main.ml b/src/Main.ml index eed0b13..0b9badb 100644 --- a/src/Main.ml +++ b/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 diff --git a/src/prettify/PrettyTop.ml b/src/prettify/PrettyTop.ml new file mode 100644 index 0000000..3501637 --- /dev/null +++ b/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 "@[letv %a = %a in@]@ %a" + fmt_var name + fmt_val value + fmt_term next +| S.LetBlo (name, block, next) -> + Format.fprintf fmt "@[let %a = %a in@]@ %a" + fmt_var name + fmt_block block + fmt_term next +| S.Swi (value, branches) -> + Format.fprintf fmt "@[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 "@[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 "@[Fun %a %a =@ %a@]" + fmt_var name + fmt_vars args + fmt_term body + +let fmt_program fmt (S.Prog(funcs, body)) = + Format.fprintf fmt "@[" ; + 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 diff --git a/src/prettify/PrettyTop.mli b/src/prettify/PrettyTop.mli new file mode 100644 index 0000000..a73b982 --- /dev/null +++ b/src/prettify/PrettyTop.mli @@ -0,0 +1 @@ +val show: Top.program -> string