lib/middleend/pprinter.ml

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88

(** Copyright 2024-2025, Rodion Suvorov, Mikhail Gavrilenko *)

(** SPDX-License-Identifier: LGPL-3.0-or-later *)

open Format
open Common.Ast
open Anf

let pp_list ~sep pp ppf xs =
  let pp_sep ppf () = Format.fprintf ppf "%s@ " sep in
  Format.pp_print_list ~pp_sep pp ppf xs
;;

let pp_rec_flag ppf = function
  | Expression.Recursive -> fprintf ppf "let rec"
  | Expression.Nonrecursive -> fprintf ppf "let"
;;

let pp_immediate ppf = function
  | Imm_num n -> fprintf ppf "%d" n
  | Imm_ident id -> fprintf ppf "%s" id
;;

let pp_app ppf (f, args) =
  fprintf ppf "%a%t" pp_immediate f (fun ppf ->
    List.iter (fun a -> fprintf ppf " %a" pp_immediate a) args)
;;

let rec pp_anf_expr_impl ~parens ppf (e : anf_expr) =
  let pp_comp ppf = function
    | Comp_imm imm -> pp_immediate ppf imm
    | Comp_binop (op, a, b) -> fprintf ppf "(%a %s %a)" pp_immediate a op pp_immediate b
    | Comp_app (f, args) -> pp_app ppf (f, args)
    | Comp_branch (c, t, e) ->
      fprintf
        ppf
        "@[<hov 2>if %a then %a else %a@]"
        pp_immediate
        c
        (pp_anf_expr_impl ~parens:false)
        t
        (pp_anf_expr_impl ~parens:false)
        e
    | Comp_func (params, body) ->
      fprintf
        ppf
        "@[<hov 2>fun %a -> %a@]"
        (pp_list ~sep:"" pp_print_string)
        params
        (pp_anf_expr_impl ~parens:false)
        body
    | Comp_tuple items -> fprintf ppf "(%a)" (pp_list ~sep:", " pp_immediate) items
    | Comp_alloc items -> fprintf ppf "alloc(%a)" (pp_list ~sep:", " pp_immediate) items
    | Comp_load (addr, off) -> fprintf ppf "%a[%d]" pp_immediate addr off
  in
  if parens then fprintf ppf "(";
  (match e with
   | Anf_comp_expr c -> pp_comp ppf c
   | Anf_let (rf, x, c, body) ->
     fprintf
       ppf
       "@[<hov 2>%a %s = %a@ in %a@]"
       pp_rec_flag
       rf
       x
       pp_comp
       c
       (pp_anf_expr_impl ~parens:false)
       body);
  if parens then fprintf ppf ")"
;;

let print_anf_expr ppf e = pp_anf_expr_impl ~parens:false ppf e

let print_anf_structure_item ppf = function
  | Anf_str_eval e -> fprintf ppf "@[<hov 2>%a@];;" print_anf_expr e
  | Anf_str_value (rf, name, e) ->
    fprintf ppf "@[<hov 2>%a %s = %a@];;" pp_rec_flag rf name print_anf_expr e
;;

let print_anf_program ppf (prog : aprogram) =
  pp_print_list
    ~pp_sep:(fun ppf () -> fprintf ppf "@,@,")
    print_anf_structure_item
    ppf
    prog;
  pp_print_newline ppf ()
;;