Changeset 1542 for Deliverables/D2.2/8051/src/languages.ml
- Timestamp:
- Nov 23, 2011, 5:43:24 PM (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
Deliverables/D2.2/8051/src/languages.ml
r1462 r1542 35 35 | AstLIN of LIN.program 36 36 | AstASM of ASM.program 37 38 type transformation = name * (ast -> ast) 37 39 38 40 let language_of_ast = function … … 136 138 ] 137 139 138 let compile debug src tgt = 139 (* Find the maximal suffix of the chain that starts with the 140 language [src]. *) 141 let rec subchain = function 142 | [] -> 143 (* The chain is assumed to be well-formed: such a suffix 144 exists. *) 145 assert false 146 | ((l, _, _) :: _) as chain when l = src -> chain 147 | _ :: chain -> subchain chain 148 in 140 let insert_transformations ts chain = 141 (* turn transformation into elements of the compilation chain *) 142 let trans_to_comp (n, t) = (n, n, t) in 143 let ts = List.map trans_to_comp ts in 144 (* ts and chain are merged, and then sorted so that the resulting list is *) 145 (* still a well formed compilation chain. Stable sort preserves order *) 146 (* between transformations on the same language as appearing in ts *) 147 let compare (n1, n2, s) (m1, m2, t) = compare (n1, n2) (m1, m2) in 148 List.stable_sort compare (ts @ chain) 149 150 let compile debug ts src tgt = 151 (* insert intermediate transformations *) 152 let chain = insert_transformations ts compilation_chain in 153 (* erase transformations whose source is strictly before src *) 154 let chain = List.filter (function (l1, _, _) -> l1 >= src) chain in 155 (* erase transformations whose target is strictly after tgt *) 156 let chain = List.filter (function (_, l2, _) -> l2 <= tgt) chain in 149 157 (* Compose the atomic translations to build a compilation function 150 158 from [src] to [tgt]. Again, we assume that the compilation chain … … 153 161 translation from [src] to [tgt]. *) 154 162 let rec compose iprogs src tgt chains ast = 155 if src = tgt then List.rev (ast :: iprogs) 156 else 157 match chains with 158 | [] -> 163 match chains with 164 | [] when src = tgt -> List.rev (ast :: iprogs) 165 | [] -> 159 166 Error.global_error "During compilation configuration" 160 167 (Printf.sprintf "It is not possible to compile from `%s' to `%s'." … … 168 175 ast :: l2_to_tgt iprog 169 176 in 170 compose [] src tgt (subchain compilation_chain)177 compose [] src tgt chain 171 178 172 179 … … 210 217 211 218 (* FIXME *) 212 let instrument cost s_mapping = function219 let instrument cost_tern costs_mapping = function 213 220 | AstClight p -> 214 221 let (p', cost_id, cost_incr, extern_cost_variables) = 215 ClightAnnotator.instrument p costs_mapping in222 ClightAnnotator.instrument cost_tern p costs_mapping in 216 223 (AstClight p', cost_id, cost_incr, extern_cost_variables) 217 224 (* … … 227 234 (p, "", "", StringTools.Map.empty) 228 235 229 let annotate input_ast final =236 let annotate cost_tern input_ast final = 230 237 let costs_mapping = compute_costs final in 231 instrument cost s_mapping input_ast238 instrument cost_tern costs_mapping input_ast 232 239 233 240 let string_output asm_pretty = function
Note: See TracChangeset
for help on using the changeset viewer.