59 lines
1.6 KiB
OCaml
59 lines
1.6 KiB
OCaml
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
|