2 (** This module provides folding functions over the constructors of the
6 let 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]
12 let 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
24 (* In [expression f e], [f]'s second argument is the list of
25 [expression]'s results on [e]'s sub-expressions. *)
27 let rec expression f_expr e =
28 let sub_es_res = List.map (expression f_expr) (expression_subs e) in
32 let 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) ->
39 | Cminor.St_call (_, f, args, _) | Cminor.St_tailcall (f, args, _) ->
41 | Cminor.St_seq (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) ->
49 let 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 :: _ ->
71 | 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 *)
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. *)
84 let 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