module S = Top
open PrettyCommon

let fmt_tag fmt tag = Format.fprintf fmt "%d" tag

let fmt_block fmt (S.Con(tag, args)) =
    Format.fprintf fmt "Block[%a](%a)"
        fmt_tag tag
        fmt_vals args

let rec fmt_term fmt (term: S.term) = match term with
| S.Exit -> Format.fprintf fmt "Exit"
| S.TailCall (fct, args) ->
        Format.fprintf fmt "Call %a %a"
            fmt_var fct
            fmt_vals args
| S.Print (value, next) ->
        Format.fprintf fmt "Print %a@ %a"
            fmt_val value
            fmt_term next
| S.LetVal (name, value, next) ->
        Format.fprintf fmt "@[<v 4>letv %a = %a in@]@ %a"
            fmt_var name
            fmt_val value
            fmt_term next
| S.LetBlo (name, block, next) ->
        Format.fprintf fmt "@[<v 4>let %a = %a in@]@ %a"
            fmt_var name
            fmt_block block
            fmt_term next
| S.IfZero (cond, tIf, tElse) ->
        Format.fprintf fmt "@[<v 4>ifzero %a then@ %a@]@ @[<v 4>else@ %a@]"
            fmt_val cond
            fmt_term tIf
            fmt_term tElse
| S.Swi (value, branches) ->
        Format.fprintf fmt "@[<v 4>switch(%a)" fmt_val value ;
        List.iter
            (fun branch -> Format.fprintf fmt "@ %a" fmt_branch branch)
            branches ;
        Format.fprintf fmt "@]"

and fmt_branch fmt (S.Branch (tag, args, body)) =
    Format.fprintf fmt "@[<v 4>Case %a [%a]:@ %a@]"
        fmt_tag tag
        fmt_vars args
        fmt_term body

let fmt_function fmt (S.Fun(name, args, body)) =
    Format.fprintf fmt "@[<v 4>Fun %a %a =@ %a@]"
        fmt_var name
        fmt_vars args
        fmt_term body

let fmt_program fmt (S.Prog(funcs, body)) =
    Format.fprintf fmt "@[<v 0>" ;
    List.iter
        (fun fct ->
            Format.fprintf fmt "%a@ @ " fmt_function fct)
        funcs ;
    Format.fprintf fmt "%a@ @]" fmt_term body

let show (prog: S.program) =
    Format.asprintf "%a" fmt_program prog