diff --git a/src/prettify/PrettyCommon.ml b/src/prettify/PrettyCommon.ml new file mode 100644 index 0000000..8493fdf --- /dev/null +++ b/src/prettify/PrettyCommon.ml @@ -0,0 +1,35 @@ +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 diff --git a/src/prettify/PrettyCommon.mli b/src/prettify/PrettyCommon.mli new file mode 100644 index 0000000..70674b1 --- /dev/null +++ b/src/prettify/PrettyCommon.mli @@ -0,0 +1,12 @@ +val fmt_list: + (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a list -> unit + +val fmt_var: Format.formatter -> Atom.atom -> unit +val fmt_vars: Format.formatter -> Atom.atom list -> unit + +val fmt_op: Format.formatter -> Tail.binop -> unit + +val fmt_val: Format.formatter -> Tail.value -> unit +val fmt_vals: Format.formatter -> Tail.value list -> unit + +val fmt_self: Format.formatter -> Tail.self -> unit diff --git a/src/prettify/PrettyTail.ml b/src/prettify/PrettyTail.ml index cacdb95..dc59fcd 100644 --- a/src/prettify/PrettyTail.ml +++ b/src/prettify/PrettyTail.ml @@ -1,38 +1,6 @@ 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 +open PrettyCommon let rec fmt_block fmt (S.Lam (self, vars, body)) = Format.fprintf fmt "λ%a(%a) ·@ %a"