diff --git a/.gitignore b/.gitignore index 8923d4f..5320c17 100644 --- a/.gitignore +++ b/.gitignore @@ -23,3 +23,4 @@ setup.log # Binaries a.out joujou +*.swo diff --git a/src/.merlin b/src/.merlin index 7de32a3..35bca6a 100644 --- a/src/.merlin +++ b/src/.merlin @@ -1,8 +1,10 @@ S kremlin S alphalib +S prettify B _build B _build/kremlin B _build/alphalib +B _build/prettify PKG unix PKG process PKG pprint diff --git a/src/Main.ml b/src/Main.ml index 9c8eed4..eed0b13 100644 --- a/src/Main.ml +++ b/src/Main.ml @@ -87,6 +87,7 @@ let process filename = |> dump "Lambda" Lambda.show_term |> CPS.cps_term |> dump "Tail" Tail.show_term + |> dump "PrettyTail" PrettyTail.show |> Defun.defun_term |> dump "Top" Top.show_program |> Finish.finish_program diff --git a/src/Makefile b/src/Makefile index 73f39e1..dd907cf 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,7 +1,7 @@ SHELL := bash TARGET := Main.native JOUJOU := joujou -DIRS := kremlin,alphalib +DIRS := kremlin,alphalib,prettify OCAMLBUILD :=\ ocamlbuild \ -classic-display \ diff --git a/src/prettify/PrettyTail.ml b/src/prettify/PrettyTail.ml new file mode 100644 index 0000000..cacdb95 --- /dev/null +++ b/src/prettify/PrettyTail.ml @@ -0,0 +1,58 @@ +module S = Tail + +let rec fmt_list disp fmt xs = match xs with +| [] -> () +| x :: [] -> Format.fprintf fmt "(%a)" disp x +| x :: xs -> Format.fprintf fmt "(%a) %a" disp x (fmt_list disp) xs + +let fmt_var fmt var = + Format.fprintf fmt "%s" (Atom.hint var) + +let fmt_vars = fmt_list fmt_var + +let fmt_op fmt (op: S.binop) = + Format.fprintf fmt ( + match op with + | S.OpAdd -> "+" + | S.OpSub -> "-" + | S.OpMul -> "*" + | S.OpDiv -> "/" + ) + +let rec fmt_val fmt (v: S.value) = match v with +| S.VVar var -> fmt_var fmt var +| S.VLit intVal -> Format.fprintf fmt "%d" intVal +| S.VBinOp (v1, op, v2) -> + Format.fprintf fmt "%a %a %a" + fmt_val v1 + fmt_op op + fmt_val v2 + +let fmt_vals = fmt_list fmt_val + +let fmt_self fmt self = match self with +| S.NoSelf -> () +| S.Self(v) -> Format.fprintf fmt "[%a]" fmt_var v + +let rec fmt_block fmt (S.Lam (self, vars, body)) = + Format.fprintf fmt "λ%a(%a) ·@ %a" + fmt_self self + fmt_vars vars + fmt_term body + +and fmt_term fmt (t: S.term) = match t with +| S.Exit -> + Format.fprintf fmt "Exit"; +| S.TailCall(fct, args) -> + Format.fprintf fmt "Call %a %a" fmt_val fct fmt_vals args +| S.Print (value, next) -> + Format.fprintf fmt "Print %a;@ %a" fmt_val value fmt_term next +| S.LetVal (var, value, next) -> + Format.fprintf fmt "@[let %a = %a@] in@ %a" + fmt_var var fmt_val value fmt_term next +| S.LetBlo (var, block, next) -> + Format.fprintf fmt "@[let %a = %a@] in@ %a" + fmt_var var fmt_block block fmt_term next + +let show term = + Format.asprintf "%a" fmt_term term diff --git a/src/prettify/PrettyTail.mli b/src/prettify/PrettyTail.mli new file mode 100644 index 0000000..1a660a8 --- /dev/null +++ b/src/prettify/PrettyTail.mli @@ -0,0 +1 @@ +val show: Tail.term -> string diff --git a/src/prettify/README.md b/src/prettify/README.md new file mode 100644 index 0000000..f514e1f --- /dev/null +++ b/src/prettify/README.md @@ -0,0 +1,5 @@ +# Prettify + +This directory contains modules to pretty-print every intermediary language I +found useful, at some point, to read in some kind of human-readable form +(instead of an AST).