Changeset 1546 for Deliverables/D2.2/8051

Timestamp:

Nov 23, 2011, 6:39:13 PM (10 years ago)

Author:

tranquil

Message:

added an option to prevent reindexing transformations from taking place, regardless of optimization options

Location:

Deliverables/D2.2/8051/src

Files:

• acc.ml (modified) (1 diff)
• options.ml (modified) (5 diffs)
• options.mli (modified) (1 diff)

Deliverables/D2.2/8051/src/acc.ml

@@ -43 +43 @@
     (** If debugging is enabled, the compilation function returns all
         the intermediate programs. *)
-    Languages.compile (Options.is_debug_enabled ()) 
-      (Options.get_transformations ()) src_language tgt_language input_ast
+    Languages.compile
+      (Options.is_debug_enabled ()) 
+      (Options.get_transformations ())
+      src_language tgt_language input_ast
   in
   let final_ast, intermediate_asts = Misc.ListExt.cut_last target_asts in

Deliverables/D2.2/8051/src/options.ml

@@ -48 +48 @@
 let is_debug_enabled ()         = !debug_flag
 
+let reindex_flag                = ref true
+
 let transformations = ref []
-let add_transformation t () = transformations := !transformations @ [t]
-let add_transformations ts () = transformations := !transformations @ ts
-let get_transformations () = !transformations
+let reindexing_transformations = ref []
+let add_transformation, add_reindexing_transformation =
+  let add_to l t () = l := !l @ [t] in
+  add_to transformations, add_to reindexing_transformations
+let add_transformations (safe, reindexing) () =
+  transformations := !transformations @ safe ;
+  reindexing_transformations := !reindexing_transformations @ reindexing
+let get_transformations () =
+  if !reindex_flag then !transformations else
+  !transformations @ !reindexing_transformations
 
 let cost_ternary_flag           = ref true
@@ -100 +109 @@
 let is_dev_test_enabled ()      = !dev_test
 
-let help_specify_opt_stage (trans : Languages.transformation) =
-        Printf.sprintf "(done at the %s stage)." (Languages.to_string (fst trans)) 
+let help_specify_opt_stage ?(reind = false) (trans : Languages.transformation) =
+  extra_doc (Printf.sprintf " [%sdone in %s]"
+               (if reind then "reindexing transformation, " else "")
+               (Languages.to_string (fst trans)))
 
 let basic_optimizations =
-  [
-    LoopPeeling.trans;
+  ([
     ConstPropagation.trans;
     CopyPropagation.trans;
@@ -111 +121 @@
     CopyPropagation.trans;
     RedundancyElimination.trans
-  ]
- 
+  ],[
+    LoopPeeling.trans
+  ])
 
 let options = OptionsParsing.register [
@@ -172 +183 @@
   extra_doc " [default is 1000]";
 
-  "-peel", Arg.Unit (add_transformation LoopPeeling.trans),
-  " Apply loop peeling " ^
-    help_specify_opt_stage LoopPeeling.trans;
+  "-peel", Arg.Unit (add_reindexing_transformation LoopPeeling.trans),
+  " Apply loop peeling.";
+    help_specify_opt_stage ~reind:true LoopPeeling.trans;
 
   "-cst-prop", Arg.Unit (add_transformation ConstPropagation.trans),
-  " Apply constant propagation " ^
-    help_specify_opt_stage ConstPropagation.trans;
+  " Apply constant propagation.";
+  help_specify_opt_stage ConstPropagation.trans;
 
   "-cpy-prop", Arg.Unit (add_transformation CopyPropagation.trans),
-  " Apply copy propagation " ^
+  " Apply copy propagation.";
     help_specify_opt_stage CopyPropagation.trans;
 
   "-pre", Arg.Unit (add_transformation RedundancyElimination.trans),
-  " Apply partial redundancy elimination " ^
+  " Apply partial redundancy elimination.";
     help_specify_opt_stage RedundancyElimination.trans;
 
   "-unroll-for",
-  Arg.Int (fun i -> add_transformation (LoopUnrolling.trans ~factor:i ()) ()),
-  " Apply loop unrolling, specifying factor " ^
-  help_specify_opt_stage (LoopUnrolling.trans ());
-
-  "-unroll", Arg.Unit (add_transformation (LoopUnrolling.trans ())),
-  " Apply loop unrolling " ^
-  help_specify_opt_stage (LoopUnrolling.trans ());
+  Arg.Int (fun i -> add_reindexing_transformation (
+    LoopUnrolling.trans ~factor:i ()) ()),
+  " Apply loop unrolling, specifying factor.";
+  help_specify_opt_stage ~reind:true (LoopUnrolling.trans ());
+
+  "-unroll", Arg.Unit (add_reindexing_transformation (LoopUnrolling.trans ())),
+  " Apply loop unrolling.";
+  help_specify_opt_stage ~reind:true (LoopUnrolling.trans ());
 
   "-O", Arg.Unit (add_transformations basic_optimizations),
@@ -201 +213 @@
 
   "-no-cost-tern",  Arg.Clear cost_ternary_flag,
-  " Replace cost ternary expressions with equivalent branch statements.";
-  
+  " Replace cost ternary expressions with equivalent";
+  extra_doc " branch statements.";
+
+  "-no-reindex", Arg.Clear reindex_flag,
+  " Prevent optimizations that reindex labels.";
 (*
   "-res", Arg.Set print_result_flag,

Deliverables/D2.2/8051/src/options.mli

@@ -67 +67 @@
 val get_lustre_test_max_int : unit -> int
 
-
 (** {2 Intermediate transformations } *)
 val get_transformations : unit -> Languages.transformation list