Changeset 624 for Deliverables/D2.2/8051/src/clight/clightFold.ml
 Timestamp:
 Mar 2, 2011, 11:06:58 PM (9 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

Deliverables/D2.2/8051/src/clight/clightFold.ml
r619 r624 33 33 34 34 let expr_subs = function 35  Clight.Expr (expr_descr, ctype) > ([ expr_descr], [ctype])35  Clight.Expr (expr_descr, ctype) > ([ctype], [expr_descr]) 36 36 37 37 let expr_descr_subs = function … … 47 47  Clight.Ecall (_, e1, e2) > ([], [e1 ; e2]) 48 48 49 let expr_fill_subs e sub_ expr_descrs sub_ctypes =50 match e, sub_ expr_descrs, sub_ctypes with51  Clight.Expr _, expr_descr :: _, ctype:: _ >49 let expr_fill_subs e sub_ctypes sub_expr_descrs = 50 match e, sub_ctypes, sub_expr_descrs with 51  Clight.Expr _, ctype :: _, expr_descr :: _ > 52 52 Clight.Expr (expr_descr, ctype) 53 53  _ > assert false (* wrong arguments, do not use on these values *) … … 65 65  Clight.Econdition _, _, e1 :: e2 :: e3 :: _ > 66 66 Clight.Econdition (e1, e2, e3) 67  Clight.Eandbool (_, _), _, e1 :: e2 :: _ > 68 Clight.Eandbool (e1, e2) 69  Clight.Eorbool (_, _), _, e1 :: e2 :: _ > 70 Clight.Eorbool (e1, e2) 71  Clight.Esizeof _, ctype :: _, _ > Clight.Esizeof ctype 67 72  Clight.Efield (_, field_name), _, e :: _ > Clight.Efield (e, field_name) 68  _ > assert false (* TODO *)69 (* 73  Clight.Ecost (lbl, _), _, e :: _ > Clight.Ecost (lbl, e) 74  Clight.Ecall (id, _, _), _, e1 :: e2 :: _ > Clight.Ecall (id, e1, e2) 70 75  _ > assert false (* wrong arguments, do not use on these values *) 71  Clight.Ebinop (_, e1, e2)  Clight.Eandbool (e1, e2)72  Clight.Eorbool (e1, e2) > ([], [e1 ; e2])73  Clight.Ecast (ctype, e) > ([ctype], [e])74  Clight.Econdition (e1, e2, e3) > ([], [e1 ; e2 ; e3])75  Clight.Esizeof ctype > ([ctype], [])76  Clight.Ecost (_, e) > ([], [e])77  Clight.Ecall (_, e1, e2) > ([], [e1 ; e2])78 *)79 76 80 let rec expr f_ expr_descr f_ctype f_expr e =81 let (sub_ expr_descrs, sub_ctypes) = expr_subs e in77 let rec expr f_ctype f_expr f_expr_descr e = 78 let (sub_ctypes, sub_expr_descrs) = expr_subs e in 82 79 let sub_expr_descrs_res = 83 80 List.map (expr_descr f_ctype f_expr f_expr_descr) sub_expr_descrs in 84 81 let sub_ctypes_res = List.map (ctype f_ctype) sub_ctypes in 85 f_expr e sub_ expr_descrs_res sub_ctypes_res82 f_expr e sub_ctypes_res sub_expr_descrs_res 86 83 87 84 and expr_descr f_ctype f_expr f_expr_descr e = 88 85 let (sub_ctypes, sub_exprs) = expr_descr_subs e in 89 86 let sub_exprs_res = 90 List.map (expr f_ expr_descr f_ctype f_expr) sub_exprs in87 List.map (expr f_ctype f_expr f_expr_descr) sub_exprs in 91 88 let sub_ctypes_res = List.map (ctype f_ctype) sub_ctypes in 92 89 f_expr_descr e sub_ctypes_res sub_exprs_res 90 91 92 let rec labeled_statements_subs = function 93  Clight.LSdefault stmt > [stmt] 94  Clight.LScase (_, stmt, lbl_stmts) > 95 stmt :: (labeled_statements_subs lbl_stmts) 96 97 let statement_subs = function 98  Clight.Sskip  Clight.Sbreak  Clight.Scontinue  Clight.Sreturn None 99  Clight.Sgoto _ > ([], []) 100  Clight.Sassign (e1, e2) > ([e1 ; e2], []) 101  Clight.Scall (None, e, args) > (e :: args, []) 102  Clight.Scall (Some e1, e2, args) > (e1 :: e2 :: args, []) 103  Clight.Ssequence (stmt1, stmt2) > ([], [stmt1 ; stmt2]) 104  Clight.Sifthenelse (e, stmt1, stmt2) > ([e], [stmt1 ; stmt2]) 105  Clight.Swhile (e, stmt)  Clight.Sdowhile (e, stmt) > ([e], [stmt]) 106  Clight.Sfor (stmt1, e, stmt2, stmt3) > ([e], [stmt1 ; stmt2 ; stmt3]) 107  Clight.Sreturn (Some e) > ([e], []) 108  Clight.Sswitch (e, lbl_stmts) > ([e], labeled_statements_subs lbl_stmts) 109  Clight.Slabel (_, stmt)  Clight.Scost (_, stmt) > ([], [stmt]) 110 111 let rec labeled_statements_fill_subs lbl_stmts sub_statements = 112 match lbl_stmts, sub_statements with 113  Clight.LSdefault _, stmt :: _ > Clight.LSdefault stmt 114  Clight.LScase (i, _, lbl_stmts), stmt :: sub_statements > 115 Clight.LScase (i, stmt, 116 labeled_statements_fill_subs lbl_stmts sub_statements) 117  _ > assert false (* wrong arguments, do not use on these values *) 118 119 let statement_fill_subs statement sub_exprs sub_statements = 120 match statement, sub_exprs, sub_statements with 121  Clight.Sskip, _, _  Clight.Sbreak, _, _  Clight.Scontinue, _, _ 122  Clight.Sreturn None, _, _  Clight.Sgoto _, _, _ > statement 123  Clight.Sassign _, e1 :: e2 :: _, _ > Clight.Sassign (e1, e2) 124  Clight.Scall (None, _, _), e :: args, _ > 125 Clight.Scall (None, e, args) 126  Clight.Scall (Some _, _, _), e1 :: e2 :: args, _ > 127 Clight.Scall (Some e1, e2, args) 128  Clight.Ssequence _, _, stmt1 :: stmt2 :: _ > 129 Clight.Ssequence (stmt1, stmt2) 130  Clight.Sifthenelse _, e :: _, stmt1 :: stmt2 :: _ > 131 Clight.Sifthenelse (e, stmt1, stmt2) 132  Clight.Swhile _, e :: _, stmt :: _ > 133 Clight.Swhile (e, stmt) 134  Clight.Sdowhile _, e :: _, stmt :: _ > 135 Clight.Sdowhile (e, stmt) 136  Clight.Sfor _, e :: _, stmt1 :: stmt2 :: stmt3 :: _ > 137 Clight.Sfor (stmt1, e, stmt2, stmt3) 138  Clight.Sreturn (Some _), e :: _, _ > Clight.Sreturn (Some e) 139  Clight.Sswitch (_, lbl_stmts), e :: _, _ > 140 Clight.Sswitch (e, labeled_statements_fill_subs lbl_stmts sub_statements) 141  Clight.Slabel (lbl, _), _, stmt :: _ > Clight.Slabel (lbl, stmt) 142  Clight.Scost (lbl, _), _, stmt :: _ > Clight.Scost (lbl, stmt) 143  _ > assert false (* wrong arguments, do not use on these values *) 144 145 let rec statement f_ctype f_expr f_expr_descr f_statement stmt = 146 let (sub_exprs, sub_stmts) = statement_subs stmt in 147 let sub_exprs_res = List.map (expr f_ctype f_expr f_expr_descr) sub_exprs in 148 let sub_stmts_res = 149 List.map (statement f_ctype f_expr f_expr_descr f_statement) sub_stmts in 150 f_statement stmt sub_exprs_res sub_stmts_res
Note: See TracChangeset
for help on using the changeset viewer.