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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
open Catala_utils
open Shared_ast
open Ast
let scope ?debug fmt (name, (decl, _pos)) =
Print.attrs fmt (Mark.get (ScopeName.get_info name));
Format.pp_open_vbox fmt 2;
Format.pp_open_hvbox fmt 4;
Print.keyword fmt "let scope ";
ScopeName.format fmt name;
Format.pp_print_space fmt ();
Format.pp_print_list ~pp_sep:Format.pp_print_space
(fun fmt (scope_var, svar) ->
Format.pp_open_hovbox fmt 1;
Print.punctuation fmt "(";
ScopeVar.format fmt scope_var;
Print.punctuation fmt ":";
Format.pp_print_space fmt ();
Print.typ fmt svar.svar_in_ty;
Format.pp_print_cut fmt ();
Print.punctuation fmt "|";
Print.keyword fmt
(match Mark.remove svar.svar_io.Desugared.Ast.io_input with
| NoInput -> "internal"
| OnlyInput -> "input"
| Reentrant -> "context");
if Mark.remove svar.svar_io.Desugared.Ast.io_output then (
Print.punctuation fmt "|";
Print.keyword fmt "output");
Print.punctuation fmt ")";
Format.pp_close_box fmt ())
fmt
(ScopeVar.Map.bindings decl.scope_sig);
Format.pp_print_break fmt 1 (-2);
Print.punctuation fmt "=";
Format.pp_close_box fmt ();
Format.pp_print_space fmt ();
Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt "%a@ " Print.punctuation ";")
(fun fmt rule ->
match rule with
| ScopeVarDefinition { var; typ; io; e } ->
Print.attrs fmt (Mark.get (ScopeVar.get_info (fst var)));
Format.fprintf fmt "@[<hov 2>%a %a %a %a %a@ %t%a@]" Print.keyword "let"
ScopeVar.format (Mark.remove var) Print.punctuation ":" Print.typ typ
Print.punctuation "="
(fun fmt ->
match Mark.remove io.io_input with
| Reentrant ->
Print.op_style fmt "reentrant or by default";
Format.pp_print_space fmt ()
| _ -> ())
(Print.expr ?debug ()) e
| SubScopeVarDefinition { var; typ; e; _ } ->
Print.attrs fmt (Mark.get (ScopeVar.get_info (fst var)));
Format.fprintf fmt "@[<hov 2>%a %a %a %a %a@ %a@]" Print.keyword "let"
ScopeVar.format (Mark.remove var) Print.punctuation ":" Print.typ typ
Print.punctuation "=" (Print.expr ?debug ()) e
| Assertion e ->
Format.fprintf fmt "%a %a" Print.keyword "assert" (Print.expr ?debug ())
e)
fmt decl.scope_decl_rules;
Format.pp_close_box fmt ()
let print_topdef ppf name (e, ty, _vis, _is_external) =
Print.attrs ppf (Mark.get (TopdefName.get_info name));
Format.pp_open_vbox ppf 2;
let () =
Format.pp_open_hovbox ppf 2;
Print.keyword ppf "let";
Format.pp_print_space ppf ();
TopdefName.format ppf name;
Print.punctuation ppf ":";
Format.pp_print_space ppf ();
Print.typ ppf ty;
Format.pp_print_space ppf ();
Print.punctuation ppf "=";
Format.pp_close_box ppf ()
in
Format.pp_print_cut ppf ();
Print.expr () ppf e;
Format.pp_close_box ppf ()
let program ?(debug : bool = false) (fmt : Format.formatter) (p : 'm program) :
unit =
let pp_sep fmt () =
Format.pp_print_cut fmt ();
Format.pp_print_cut fmt ()
in
Format.pp_open_vbox fmt 0;
Print.decl_ctx ~debug fmt p.program_ctx;
TopdefName.Map.iter
(fun name def ->
print_topdef fmt name def;
pp_sep fmt ())
p.program_topdefs;
ScopeName.Map.format_bindings_i
(fun fmt _ name scope_decl ->
Format.pp_print_cut fmt ();
scope ~debug fmt (name, scope_decl))
fmt p.program_scopes;
Format.pp_close_box fmt ()