Add human-readable pretty printer for Tail

This commit is contained in:
Théophile Bastian 2018-02-15 21:26:15 +01:00
parent 4ec822cfda
commit 3262846faf
7 changed files with 69 additions and 1 deletions

1
.gitignore vendored
View file

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

View file

@ -1,8 +1,10 @@
S kremlin S kremlin
S alphalib S alphalib
S prettify
B _build B _build
B _build/kremlin B _build/kremlin
B _build/alphalib B _build/alphalib
B _build/prettify
PKG unix PKG unix
PKG process PKG process
PKG pprint PKG pprint

View file

@ -87,6 +87,7 @@ let process filename =
|> dump "Lambda" Lambda.show_term |> dump "Lambda" Lambda.show_term
|> CPS.cps_term |> CPS.cps_term
|> dump "Tail" Tail.show_term |> dump "Tail" Tail.show_term
|> dump "PrettyTail" PrettyTail.show
|> Defun.defun_term |> Defun.defun_term
|> dump "Top" Top.show_program |> dump "Top" Top.show_program
|> Finish.finish_program |> Finish.finish_program

View file

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

View file

@ -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

View file

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

5
src/prettify/README.md Normal file
View file

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