source: Deliverables/D2.2/8051/src/cminor/cminorFold.ml @ 486

Last change on this file since 486 was 486, checked in by ayache, 9 years ago

Deliverable D2.2

File size: 4.9 KB
Line 
1
2(** This module provides folding functions over the constructors of the
3    [Cminor]'s AST. *)
4
5
6(* Left operators *)
7
8(* In [expression_left f e], [f]'s second argument is the list of
9   [expression_left]'s results on [e]'s sub-expressions. The results are
10   computed from left to right following their appearance order in the
11   [Cminor.expression] type. *)
12
13let rec expression_left f_expr e =
14  let subexpr_res = match e with
15    | Cminor.Id _ | Cminor.Cst _ -> []
16    | Cminor.Op1 (_, e) | Cminor.Mem (_, e) | Cminor.Exp_cost (_, e) ->
17        [expression_left f_expr e]
18    | Cminor.Op2 (_, e1, e2) ->
19        let res1 = expression_left f_expr e1 in
20        let res2 = expression_left f_expr e2 in
21        [res1 ; res2]
22    | Cminor.Cond (e1, e2, e3) ->
23        let res1 = expression_left f_expr e1 in
24        let res2 = expression_left f_expr e2 in
25        let res3 = expression_left f_expr e3 in
26        [res1 ; res2 ; res3]
27  in
28  f_expr e subexpr_res
29
30let map_left f =
31  let rec aux = function
32    | [] -> []
33    | e :: l -> let x = f e in x :: (aux l)
34  in
35  aux
36
37(* In [statement_left f_expr f_stmt stmt], [f_stmt]'s second argument is the
38   list of [expression_left f_expr]'s results on [stmt]'s sub-expressions, and
39   [f_stmt]'s third argument is the list of [statement_left]'s results
40   on [stmt]'s sub-statements. The results are computed from left to right
41   following their appearance order in the [Cminor.statement] type. *)
42
43let rec statement_left f_expr f_stmt stmt =
44  let expr_res e = expression_left f_expr e in
45  let (subexpr_res, substmt_res) = match stmt with
46    | Cminor.St_skip | Cminor.St_exit _ | Cminor.St_switch _
47    | Cminor.St_return None | Cminor.St_goto _ -> ([], [])
48    | Cminor.St_assign (_, e) | Cminor.St_return (Some e) -> ([expr_res e], [])
49    | Cminor.St_store (_, e1, e2) ->
50        let res1 = expr_res e1 in
51        let res2 = expr_res e2 in
52        ([res1 ; res2], [])
53    | Cminor.St_call (_, f, args, _) | Cminor.St_tailcall (f, args, _) ->
54        let resf = expr_res f in
55        let resargs = map_left expr_res args in
56        (resf :: resargs, [])
57    | Cminor.St_seq (stmt1, stmt2) ->
58        let res1 = statement_left f_expr f_stmt stmt1 in
59        let res2 = statement_left f_expr f_stmt stmt2 in
60        ([], [res1 ; res2])
61    | Cminor.St_ifthenelse (e, stmt1, stmt2) ->
62        let rese = expr_res e in
63        let res1 = statement_left f_expr f_stmt stmt1 in
64        let res2 = statement_left f_expr f_stmt stmt2 in
65        ([rese], [res1 ; res2])
66    | Cminor.St_loop stmt | Cminor.St_block stmt
67    | Cminor.St_label (_, stmt) | Cminor.St_cost (_, stmt) ->
68        ([], [statement_left f_expr f_stmt stmt])
69  in
70  f_stmt stmt subexpr_res substmt_res
71
72
73(* Right operators *)
74
75(* In [expression_right f e], [f]'s second argument is the list of
76   [expression_right]'s results on [e]'s sub-expressions. The results are
77   computed from right to left following their appearance order in the
78   [Cminor.expression] type. *)
79
80let rec expression_right f_expr e =
81  let subexpr_res = match e with
82    | Cminor.Id _ | Cminor.Cst _ -> []
83    | Cminor.Op1 (_, e) | Cminor.Mem (_, e) | Cminor.Exp_cost (_, e) ->
84        [expression_right f_expr e]
85    | Cminor.Op2 (_, e1, e2) ->
86        let res2 = expression_right f_expr e2 in
87        let res1 = expression_right f_expr e1 in
88        [res2 ; res1]
89    | Cminor.Cond (e1, e2, e3) ->
90        let res3 = expression_right f_expr e3 in
91        let res2 = expression_right f_expr e2 in
92        let res1 = expression_right f_expr e1 in
93        [res3 ; res2 ; res1]
94  in
95  f_expr subexpr_res e
96
97let map_right f =
98  let rec aux = function
99    | [] -> []
100    | e :: l -> let res = (aux l) in (f e) :: res
101  in
102  aux
103
104(* In [statement_right f_expr f_stmt stmt], [f_stmt]'s second argument is the
105   list of [expression_left f_expr]'s results on [stmt]'s sub-expressions, and
106   [f_stmt]'s third argument is the list of [statement_left]'s results
107   on [stmt]'s sub-statements. The results are computed from right to left
108   following their appearance order in the [Cminor.statement] type. *)
109
110let rec statement_right f_expr f_stmt stmt =
111  let expr_res e = expression_right f_expr e in
112  let (subexpr_res, substmt_res) = match stmt with
113    | Cminor.St_skip | Cminor.St_exit _ | Cminor.St_switch _
114    | Cminor.St_return None | Cminor.St_goto _ -> ([], [])
115    | Cminor.St_assign (_, e) | Cminor.St_return (Some e) -> ([expr_res e], [])
116    | Cminor.St_store (_, e1, e2) ->
117        let res2 = expr_res e2 in
118        let res1 = expr_res e1 in
119        ([res2 ; res1], [])
120    | Cminor.St_call (_, f, args, _) | Cminor.St_tailcall (f, args, _) ->
121        let resargs = map_right expr_res args in
122        let resf = expr_res f in
123        (resargs @ [resf], [])
124    | Cminor.St_seq (stmt1, stmt2) ->
125        let res2 = statement_right f_expr f_stmt stmt2 in
126        let res1 = statement_right f_expr f_stmt stmt1 in
127        ([], [res2 ; res1])
128    | Cminor.St_ifthenelse (e, stmt1, stmt2) ->
129        let res2 = statement_right f_expr f_stmt stmt2 in
130        let res1 = statement_right f_expr f_stmt stmt1 in
131        let rese = expr_res e in
132        ([rese], [res2 ; res1])
133    | Cminor.St_loop stmt | Cminor.St_block stmt
134    | Cminor.St_label (_, stmt) | Cminor.St_cost (_, stmt) ->
135        ([], [statement_right f_expr f_stmt stmt])
136  in
137  f_stmt subexpr_res substmt_res stmt
Note: See TracBrowser for help on using the repository browser.