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