source: Deliverables/D2.2/8051-indexed-labels-branch/src/cminor/cminorFold.ml @ 1334

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

work on Cminor completed

File size: 3.5 KB
RevLine 
[486]1
2(** This module provides folding functions over the constructors of the
3    [Cminor]'s AST. *)
4
5
[818]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]
[486]11
[818]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)
[486]22
23
[818]24(* In [expression f e], [f]'s second argument is the list of
25   [expression]'s results on [e]'s sub-expressions. *)
[486]26
[818]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
[486]30
31
[818]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
[1334]46  | Cminor.St_label (_, stmt) | Cminor.St_cost (_, stmt)
47        | Cminor.St_ind_0 (_, stmt) | Cminor.St_ind_inc (stmt, _) ->
48                ([], [stmt])
[486]49
[818]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    | _ -> assert false (* do not use on these arguments *)
[486]79
[818]80(* In [statement f_expr f_stmt stmt], [f_stmt]'s second argument is the
81   list of [expression f_expr]'s results on [stmt]'s sub-expressions, and
82   [f_stmt]'s third argument is the list of [statement]'s results
83   on [stmt]'s sub-statements. *)
[486]84
[818]85let rec statement f_expr f_stmt stmt =
86  let (sub_es, sub_stmts) = statement_subs stmt in
87  let sub_es_res = List.map (expression f_expr) sub_es in
88  let sub_stmts_res = List.map (statement f_expr f_stmt) sub_stmts in
89  f_stmt stmt sub_es_res sub_stmts_res
Note: See TracBrowser for help on using the repository browser.