Changeset 818 for Deliverables/D2.2/8051/src/cminor/cminorFold.ml
 Timestamp:
 May 19, 2011, 4:03:04 PM (8 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

Deliverables/D2.2/8051/src/cminor/cminorFold.ml
r486 r818 4 4 5 5 6 (* Left operators *) 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] 7 11 8 (* In [expression_left f e], [f]'s second argument is the list of 9 [expression_left]'s results on [e]'s subexpressions. The results are 10 computed from left to right following their appearance order in the 11 [Cminor.expression] type. *) 12 13 let 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 30 let 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 subexpressions, and 39 [f_stmt]'s third argument is the list of [statement_left]'s results 40 on [stmt]'s substatements. The results are computed from left to right 41 following their appearance order in the [Cminor.statement] type. *) 42 43 let 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 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 21 Cminor.Expr (ed, t) 71 22 72 23 73 (* Right operators *) 24 (* In [expression f e], [f]'s second argument is the list of 25 [expression]'s results on [e]'s subexpressions. *) 74 26 75 (* In [expression_right f e], [f]'s second argument is the list of 76 [expression_right]'s results on [e]'s subexpressions. The results are 77 computed from right to left following their appearance order in the 78 [Cminor.expression] type. *) 27 let 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 79 30 80 let rec expression_right f_expr e =81 let subexpr_res = match e with82  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 in87 let res1 = expression_right f_expr e1 in88 [res2 ; res1]89  Cminor.Cond (e1, e2, e3) >90 let res3 = expression_right f_expr e3 in91 let res2 = expression_right f_expr e2 in92 let res1 = expression_right f_expr e1 in93 [res3 ; res2 ; res1]94 in95 f_expr subexpr_res e96 31 97 let map_right f = 98 let rec aux = function 99  [] > [] 100  e :: l > let res = (aux l) in (f e) :: res 101 in 102 aux 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) > 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]) 103 48 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 subexpressions, and 106 [f_stmt]'s third argument is the list of [statement_left]'s results 107 on [stmt]'s substatements. The results are computed from right to left 108 following their appearance order in the [Cminor.statement] type. *) 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 :: _ > 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 *) 109 78 110 let 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 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 subexpressions, and 81 [f_stmt]'s third argument is the list of [statement]'s results 82 on [stmt]'s substatements. *) 83 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
Note: See TracChangeset
for help on using the changeset viewer.