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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
open Ast
open Static
open Misc
exception Fallback
type 'a it_funs = {
static_exp : 'a it_funs -> 'a -> static_exp -> static_exp * 'a;
static_exp_desc : 'a it_funs -> 'a -> static_exp_desc -> static_exp_desc * 'a;
ty : 'a it_funs -> 'a -> ty -> ty * 'a;
link : 'a it_funs -> 'a -> link -> link * 'a;
edesc : 'a it_funs -> 'a -> edesc -> edesc * 'a;
exp : 'a it_funs -> 'a -> exp -> exp * 'a;
pat : 'a it_funs -> 'a -> pat -> pat * 'a;
equation : 'a it_funs -> 'a -> equation -> equation * 'a;
var_dec : 'a it_funs -> 'a -> var_dec -> var_dec * 'a;
block : 'a it_funs -> 'a -> block -> block * 'a;
node_dec : 'a it_funs -> 'a -> node_dec -> node_dec * 'a;
const_dec : 'a it_funs -> 'a -> const_dec -> const_dec * 'a;
program : 'a it_funs -> 'a -> program -> program * 'a;
}
let rec exp_it funs acc e = funs.exp funs acc e
and exp funs acc e =
let e_desc, acc = edesc_it funs acc e.e_desc in
let e_ty, acc = ty_it funs acc e.e_ty in
{ e with e_desc = e_desc; e_ty = e_ty }, acc
and edesc_it funs acc ed =
try funs.edesc funs acc ed
with Fallback -> edesc funs acc ed
and edesc funs acc ed = match ed with
| Econst v -> Econst v, acc
| Evar id -> Evar id, acc
| Ereg e ->
let e, acc = exp_it funs acc e in
Ereg e, acc
| Emem(k, addr_size, word_size, s, args) ->
let addr_size, acc = static_exp_it funs acc addr_size in
let word_size, acc = static_exp_it funs acc word_size in
let args, acc = mapfold (exp_it funs) acc args in
Emem(k, addr_size, word_size, s, args), acc
| Ecall(id, params, args) ->
let params, acc = mapfold (static_exp_it funs) acc params in
let args, acc = mapfold (exp_it funs) acc args in
Ecall(id, params, args), acc
and static_exp_it funs acc sd =
try funs.static_exp funs acc sd
with Fallback -> static_exp funs acc sd
and static_exp funs acc se =
let se_desc, acc = static_exp_desc_it funs acc se.se_desc in
{ se with se_desc = se_desc }, acc
and static_exp_desc_it funs acc sed =
try funs.static_exp_desc funs acc sed
with Fallback -> static_exp_desc funs acc sed
and static_exp_desc funs acc sed = match sed with
| SInt _ | SBool _ | SVar _ -> sed, acc
| SBinOp (sop, se1, se2) ->
let se1, acc = static_exp_it funs acc se1 in
let se2, acc = static_exp_it funs acc se2 in
SBinOp(sop, se1, se2), acc
| SIf(c, se1, se2) ->
let c, acc = static_exp_it funs acc c in
let se1, acc = static_exp_it funs acc se1 in
let se2, acc = static_exp_it funs acc se2 in
SIf(c, se1, se2), acc
and ty_it funs acc t = try funs.ty funs acc t with Fallback -> ty funs acc t
and ty funs acc t = match t with
| TUnit | TBit -> t, acc
| TBitArray se ->
let se, acc = static_exp_it funs acc se in
TBitArray se, acc
| TProd t_l ->
let t_l, acc = mapfold (ty_it funs) acc t_l in
TProd t_l, acc
| TVar link ->
let link_v, acc = link_it funs acc !link in
link := link_v;
TVar link, acc
and link_it funs acc c =
try funs.link funs acc c
with Fallback -> link funs acc c
and link funs acc l = match l with
| TIndex _ -> l, acc
| TLink ty ->
let ty, acc = ty_it funs acc ty in
TLink ty, acc
and pat_it funs acc p =
try funs.pat funs acc p
with Fallback -> pat funs acc p
and pat funs acc p = p, acc
and equation_it funs acc eq = funs.equation funs acc eq
and equation funs acc (pat, e) =
let pat, acc = pat_it funs acc pat in
let e, acc = exp_it funs acc e in
(pat, e), acc
and block_it funs acc b =
try funs.block funs acc b
with Fallback -> block funs acc b
and block funs acc b = match b with
| BEqs(eqs, vds) ->
let vds, acc = mapfold (var_dec_it funs) acc vds in
let eqs, acc = mapfold (equation_it funs) acc eqs in
BEqs (eqs, vds), acc
| BIf(se, b1, b2) ->
let se, acc = static_exp_it funs acc se in
let b1, acc = block_it funs acc b1 in
let b2, acc = block_it funs acc b2 in
BIf(se, b1, b2), acc
and var_dec_it funs acc vd = funs.var_dec funs acc vd
and var_dec funs acc vd =
let v_ty, acc = ty_it funs acc vd.v_ty in
{ vd with v_ty = v_ty }, acc
and node_dec_it funs acc nd = funs.node_dec funs acc nd
and node_dec funs acc nd =
let n_inputs, acc = mapfold (var_dec_it funs) acc nd.n_inputs in
let n_outputs, acc = mapfold (var_dec_it funs) acc nd.n_outputs in
let n_constraints, acc = mapfold (static_exp_it funs) acc nd.n_constraints in
let n_body, acc = block_it funs acc nd.n_body in
{ nd with
n_inputs = n_inputs;
n_outputs = n_outputs;
n_body = n_body;
n_constraints = n_constraints }
, acc
and const_dec_it funs acc c = funs.const_dec funs acc c
and const_dec funs acc c =
let c_value, acc = static_exp_it funs acc c.c_value in
{ c with c_value = c_value }, acc
and program_it funs acc p = funs.program funs acc p
and program funs acc p =
let p_consts, acc = mapfold (const_dec_it funs) acc p.p_consts in
let p_nodes, acc = mapfold (node_dec_it funs) acc p.p_nodes in
{ p_nodes = p_nodes; p_consts = p_consts }, acc
let defaults = {
static_exp = static_exp;
static_exp_desc = static_exp_desc;
ty = ty;
link = link;
edesc = edesc;
exp = exp;
pat = pat;
equation = equation;
var_dec = var_dec;
block = block;
node_dec = node_dec;
const_dec = const_dec;
program = program;
}
|
