mpri-funcprog-project/src/prettify/PrettyTop.ml

60 lines
1.7 KiB
OCaml
Raw Normal View History

2018-02-15 22:01:46 +01:00
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.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