open Pp;; open Format;; let out f out x = f x;; let rec type_expr = function Integer -> printf "Integer" | Boolean -> printf "Boolean" | Array t -> printf "Array (%a)" (out type_expr) t ;; let result = function None -> printf "None" | Some (Integer | Boolean as t) -> printf "Some %a" (out type_expr) t | Some (Array _ as t) -> printf "Some (%a)" (out type_expr) t ;; let binop = function | Plus -> "Plus" | Minus -> "Minus" | Times -> "Times" | Div -> "Div" | Lt -> "Lt" | Gt -> "Gt" | Le -> "Le" | Ge -> "Ge" | Eq -> "Eq" | Ne -> "Ne" ;; let list sep f = function [] -> () | h::t -> f h; List.iter (fun x -> printf "%s@ " sep; f x) t ;; let print_list left elem sep l right = printf "@[%s @[%a@]@ %s@]" left (out (list sep elem)) l right ;; let head_list head left elem sep l right = printf "@[%s@ %s@[%a@]%s@]" head left (out (list sep elem)) l right ;; let apply f expr args = head_list f "(" expr "," args ")" ;; let apply_first head first h next t = printf "@[%s@ (@[%a,@ %a@])@]" head (out first) h (out (list "," next)) t ;; let string s = printf "\"%s\"" s;; let rec expr = function Int n -> printf "Int %d" n | Bool b -> printf "Bool %s" (if b then "true" else "false") | Bin (op, e1, e2) -> apply_first "Bin" (fun x -> printf "%s" x) (binop op) expr [e1; e2] | Get s -> printf "Get %a" (out string) s; | Function_call (s, l) -> apply_first "Function_call" string s (print_list "[" expr ";" l) ["]"] | Geti (e1, e2) -> apply "Geti" expr [e1;e2] | Alloc (e, t) -> apply_first "Alloc" expr e type_expr [t]; ;; let expression e = printf "@["; expr e; printf "@]";; let rec instruction = function | Set (s,e) -> apply_first "Set" string s expression [e]; | Sequence [ i ] -> instruction i; | Sequence l -> head_list "Sequence" "[" instruction ";" l "]" | If (e, t, f) -> apply_first "If" expr e instruction [t;f] | While (e, i) -> apply_first "While" expr e instruction [i] | Procedure_call (s, l) -> apply_first "Procedure_call" string s (print_list "[" expr ";" l) ["]"] | Seti (e1, e2, e3)-> apply "Seti" expr [e1;e2;e3] | Write_int n -> apply "Write_int" expr [n] | Writeln_int n -> apply "Writeln_int" expr [n] | Read_int x -> printf "Read_int %a" (out string) x ;; let field s ff fx = printf "@[%s =@ %a@]" s (out ff) fx;; let var (s,t) = printf "\"%s\", %a" s (out type_expr) t;; let definition (s,f) = printf "@[\"%s\",@ @[{ @[" s; field "arguments" (print_list "[" var ";" f.arguments) "]"; printf ";@ "; field "result" result f.result; printf ";@ "; field "local_vars" (print_list "[" var ";" f.local_vars) "]"; printf ";@ "; field "body" instruction f.body; printf "@]@]@ }@]"; ;; let definitions l = print_list "[" definition ";" l "]";; let program p = printf "@[{ @["; field "global_vars" (print_list "[" var ";" p.global_vars) "]"; printf ";@ "; field "definitions" definitions p.definitions; printf ";@ "; field "main" instruction p.main; printf "@]@ }@ ;;@]@."; ;;