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
(** Copyright 2025, Ksenia Kotelnikova <xeniia.ka@gmail.com>, Sofya Kozyreva <k81sofia@gmail.com>, Vyacheslav Kochergin <vyacheslav.kochergin1@gmail.com> *)
(** SPDX-License-Identifier: LGPL-3.0-or-later *)
open Anf
open Format
open Ast
let rec pp_aexpr fmt = function
| ALet (Ident name, cexpr, body) ->
(* keep inner lets compact *)
fprintf fmt "@[<v 2>let %s = %a in@,%a@]" name pp_cexpr cexpr pp_aexpr body
| ACExpr cexpr -> fprintf fmt "%a" pp_cexpr cexpr
and pp_cbinop fmt l r = function
| CPlus -> fprintf fmt "%a + %a" pp_imm l pp_imm r
| CMinus -> fprintf fmt "%a - %a" pp_imm l pp_imm r
| CMul -> fprintf fmt "%a * %a" pp_imm l pp_imm r
| CDiv -> fprintf fmt "%a / %a" pp_imm l pp_imm r
| CEq -> fprintf fmt "%a = %a" pp_imm l pp_imm r
| CNeq -> fprintf fmt "%a <> %a" pp_imm l pp_imm r
| CGte -> fprintf fmt "%a >= %a" pp_imm l pp_imm r
| CLte -> fprintf fmt "%a <= %a" pp_imm l pp_imm r
| CGt -> fprintf fmt "%a > %a" pp_imm l pp_imm r
| CLt -> fprintf fmt "%a < %a" pp_imm l pp_imm r
and pp_cexpr fmt = function
| CBinop (op, l, r) -> pp_cbinop fmt l r op
| CImmexpr imm -> fprintf fmt "%a" pp_imm imm
| CIte (c, t, Some e) ->
fprintf fmt "@[<v 2>if %a@ then %a@ else %a@]" pp_cexpr c pp_aexpr t pp_aexpr e
| CIte (c, t, None) -> fprintf fmt "@[<v 2>if %a@ then %a@]" pp_cexpr c pp_aexpr t
| CLam (Ident arg, body) -> fprintf fmt "@[<2>fun %s -> @,%a@]" arg pp_aexpr body
| CApp (fn, args) ->
fprintf
fmt
"@[<2>%a %a@]"
pp_imm
fn
(pp_print_list ~pp_sep:(fun fmt () -> fprintf fmt " ") pp_imm)
args
| CField (imm, num) -> fprintf fmt "%a.%d" pp_imm imm num
and pp_imm fmt = function
| ImmNum n -> fprintf fmt "%d" n
| ImmId (Ident x) -> fprintf fmt "%s" x
| ITuple (fst, snd, rest) ->
fprintf
fmt
"@[<2>(%a)@]"
(pp_print_list ~pp_sep:(fun fmt () -> fprintf fmt ", ") pp_imm)
(fst :: snd :: rest)
and pp_binding fmt (id, aexpr) =
let open Ast in
match id with
| Ident name ->
(* top-level lets print on a new line after '=' *)
fprintf fmt "%s =@,%a" name pp_aexpr aexpr
and pp_astatement fmt (is_rec, bindings) =
let open Ast in
let keyword =
match is_rec with
| Rec -> "let rec"
| Nonrec -> "let"
in
fprintf
fmt
"@[<v 0>%s %a@]\n"
keyword
(pp_print_list ~pp_sep:(fun fmt () -> fprintf fmt "@ and ") pp_binding)
bindings
and pp_aconstruction fmt = function
| AExpr aexpr -> fprintf fmt "%a" pp_aexpr aexpr
| AStatement (flag, bindings) -> pp_astatement fmt (flag, bindings)
and pp_aconstructions fmt (constrs : aconstructions) =
pp_print_list ~pp_sep:(fun fmt () -> fprintf fmt "@,@,") pp_aconstruction fmt constrs
;;