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

Last change on this file was 1542, checked in by tranquil, 8 years ago

merge of indexed labels branch

File size: 3.7 KB
Line 
1
2(** This module provides folding functions over the constructors of the
3    [Cminor]'s AST. *)
4
5
6let expression_subs (Cminor.Expr (ed, _)) = match ed with
7  | Cminor.Id _ | Cminor.Cst _ -> []
8  | Cminor.Op1 (_, e) | Cminor.Mem (_, e) | Cminor.Exp_cost (_, e) -> [e]
9  | Cminor.Op2 (_, e1, e2) -> [e1 ; e2]
10  | Cminor.Cond (e1, e2, e3) -> [e1 ; e2 ; e3]
11
12let expression_fill_subs (Cminor.Expr (ed, t)) subs =
13  let ed = match ed, subs with
14    | Cminor.Id _, _ | Cminor.Cst _, _ -> ed
15    | Cminor.Op1 (op1, _), e :: _ -> Cminor.Op1 (op1, e)
16    | Cminor.Op2 (op2, _, _), e1 :: e2 :: _ -> Cminor.Op2 (op2, e1, e2)
17    | Cminor.Mem (size, _), e :: _ -> Cminor.Mem (size, e)
18    | Cminor.Cond _, e1 :: e2 :: e3 :: _ -> Cminor.Cond (e1, e2, e3)
19    | Cminor.Exp_cost (lbl, _), e :: _ -> Cminor.Exp_cost (lbl, e)
20    | _ -> assert false (* wrong parameter size *) in
21  Cminor.Expr (ed, t)
22
23
24(* In [expression f e], [f]'s second argument is the list of
25   [expression]'s results on [e]'s sub-expressions. *)
26
27let rec expression f_expr e =
28  let sub_es_res = List.map (expression f_expr) (expression_subs e) in
29  f_expr e sub_es_res
30
31
32let statement_subs = function
33  | Cminor.St_skip | (*Cminor.St_exit _ |*) Cminor.St_return None
34  | Cminor.St_goto _ -> ([], [])
35  | Cminor.St_assign (_, e) | Cminor.St_switch (e, _, _)
36  | Cminor.St_return (Some e) -> ([e], [])
37  | Cminor.St_store (_, e1, e2) ->
38    ([e1 ; e2], [])
39  | Cminor.St_call (_, f, args, _) | Cminor.St_tailcall (f, args, _) ->
40    (f :: args, [])
41  | Cminor.St_seq (stmt1, stmt2) ->
42    ([], [stmt1 ; stmt2])
43  | Cminor.St_ifthenelse (e, stmt1, stmt2) ->
44    ([e], [stmt1 ; stmt2])
45  (*| Cminor.St_loop stmt | Cminor.St_block stmt *)
46  | Cminor.St_label (_, stmt) | Cminor.St_cost (_, stmt)
47  | Cminor.St_ind_0 (_, stmt) | Cminor.St_ind_inc (_, stmt) ->
48    ([], [stmt])
49
50let statement_fill_subs stmt sub_es sub_stmts =
51  match stmt, sub_es, sub_stmts with
52    | (  Cminor.St_skip | (*Cminor.St_exit _ |*) Cminor.St_return None
53       | Cminor.St_goto _), _, _ -> stmt
54    | Cminor.St_assign (x, _), e :: _, _ ->
55      Cminor.St_assign (x, e)
56    | Cminor.St_switch (_, cases, dflt), e :: _, _ ->
57      Cminor.St_switch (e, cases, dflt)
58    | Cminor.St_return _, e :: _, _ ->
59      Cminor.St_return (Some e)
60    | Cminor.St_store (size, _, _), e1 :: e2 :: _, _ ->
61      Cminor.St_store (size, e1, e2)
62    | Cminor.St_call (x_opt, _, _, sg), f :: args, _ ->
63      Cminor.St_call (x_opt, f, args, sg)
64    | Cminor.St_tailcall (_, _, sg), f :: args, _ ->
65      Cminor.St_tailcall (f, args, sg)
66    | Cminor.St_seq _, _, stmt1 :: stmt2 :: _ ->
67      Cminor.St_seq (stmt1, stmt2)
68    | Cminor.St_ifthenelse _, e :: _, stmt1 :: stmt2 :: _ ->
69      Cminor.St_ifthenelse (e, stmt1, stmt2)
70 (*   | Cminor.St_loop _, _, stmt :: _ ->
71      Cminor.St_loop stmt
72    | Cminor.St_block _, _, stmt :: _ ->
73      Cminor.St_block stmt *)
74    | Cminor.St_label (lbl, _), _, stmt :: _ ->
75      Cminor.St_label (lbl, stmt)
76    | Cminor.St_cost (lbl, _), _, stmt :: _ ->
77      Cminor.St_cost (lbl, stmt)
78    | Cminor.St_ind_0 (i, _), _, stmt :: _ ->
79      Cminor.St_ind_0 (i, stmt)
80    | Cminor.St_ind_inc (i, _), _, stmt :: _ ->
81      Cminor.St_ind_inc (i, stmt)
82    | _ -> assert false (* do not use on these arguments *)
83
84(* In [statement f_expr f_stmt stmt], [f_stmt]'s second argument is the
85   list of [expression f_expr]'s results on [stmt]'s sub-expressions, and
86   [f_stmt]'s third argument is the list of [statement]'s results
87   on [stmt]'s sub-statements. *)
88
89let rec statement f_expr f_stmt stmt =
90  let (sub_es, sub_stmts) = statement_subs stmt in
91  let sub_es_res = List.map (expression f_expr) sub_es in
92  let sub_stmts_res = List.map (statement f_expr f_stmt) sub_stmts in
93  f_stmt stmt sub_es_res sub_stmts_res
Note: See TracBrowser for help on using the repository browser.