60 lines
1.7 KiB
OCaml
60 lines
1.7 KiB
OCaml
|
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
|