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

Last change on this file since 818 was 818, checked in by ayache, 8 years ago

32 and 16 bits operations support in D2.2/8051

File size: 3.4 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    ([], [stmt])
48
49let statement_fill_subs stmt sub_es sub_stmts =
50  match stmt, sub_es, sub_stmts with
51    | (  Cminor.St_skip | Cminor.St_exit _ | Cminor.St_return None
52       | Cminor.St_goto _), _, _ -> stmt
53    | Cminor.St_assign (x, _), e :: _, _ ->
54      Cminor.St_assign (x, e)
55    | Cminor.St_switch (_, cases, dflt), e :: _, _ ->
56      Cminor.St_switch (e, cases, dflt)
57    | Cminor.St_return _, e :: _, _ ->
58      Cminor.St_return (Some e)
59    | Cminor.St_store (size, _, _), e1 :: e2 :: _, _ ->
60      Cminor.St_store (size, e1, e2)
61    | Cminor.St_call (x_opt, _, _, sg), f :: args, _ ->
62      Cminor.St_call (x_opt, f, args, sg)
63    | Cminor.St_tailcall (_, _, sg), f :: args, _ ->
64      Cminor.St_tailcall (f, args, sg)
65    | Cminor.St_seq _, _, stmt1 :: stmt2 :: _ ->
66      Cminor.St_seq (stmt1, stmt2)
67    | Cminor.St_ifthenelse _, e :: _, stmt1 :: stmt2 :: _ ->
68      Cminor.St_ifthenelse (e, stmt1, stmt2)
69    | Cminor.St_loop _, _, stmt :: _ ->
70      Cminor.St_loop stmt
71    | Cminor.St_block _, _, stmt :: _ ->
72      Cminor.St_block stmt
73    | Cminor.St_label (lbl, _), _, stmt :: _ ->
74      Cminor.St_label (lbl, stmt)
75    | Cminor.St_cost (lbl, _), _, stmt :: _ ->
76      Cminor.St_cost (lbl, stmt)
77    | _ -> assert false (* do not use on these arguments *)
78
79(* In [statement f_expr f_stmt stmt], [f_stmt]'s second argument is the
80   list of [expression f_expr]'s results on [stmt]'s sub-expressions, and
81   [f_stmt]'s third argument is the list of [statement]'s results
82   on [stmt]'s sub-statements. *)
83
84let rec statement f_expr f_stmt stmt =
85  let (sub_es, sub_stmts) = statement_subs stmt in
86  let sub_es_res = List.map (expression f_expr) sub_es in
87  let sub_stmts_res = List.map (statement f_expr f_stmt) sub_stmts in
88  f_stmt stmt sub_es_res sub_stmts_res
Note: See TracBrowser for help on using the repository browser.