Add human-readable pretty printer for Tail

.gitignore

@@ -23,3 +23,4 @@ setup.log
 # Binaries
 a.out
 joujou
+*.swo

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

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

src/Makefile

@@ -1,7 +1,7 @@
 SHELL      := bash
 TARGET     := Main.native
 JOUJOU     := joujou
-DIRS       := kremlin,alphalib
+DIRS       := kremlin,alphalib,prettify
 OCAMLBUILD :=\
   ocamlbuild \
     -classic-display \

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 "@[<v 4>let %a = %a@] in@ %a"
+            fmt_var var fmt_val value fmt_term next
+| S.LetBlo (var, block, next) ->
+        Format.fprintf fmt "@[<v 4>let %a = %a@] in@ %a"
+            fmt_var var fmt_block block fmt_term next
+
+let show term =
+    Format.asprintf "%a" fmt_term term

src/prettify/PrettyTail.mli

@@ -0,0 +1 @@
+val show: Tail.term -> string

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).