Loop unrolling.

compiler/main/heptc.ml

@@ -129,6 +129,7 @@ let main () =
         "-only-memalloc", Arg.Set do_mem_alloc, doc_memalloc_only;
         "-only-linear", Arg.Set do_linear_typing, doc_linear_only;
         "-old-scheduler", Arg.Set use_old_scheduler, doc_interf_scheduler;
+        "-unroll", Arg.Set unroll_loops, doc_unroll;
         "-O", Arg.Unit do_optim, doc_optim;
         "-mall", Arg.Set interf_all, doc_interf_all;
       ]

compiler/main/mls2obc.ml

@@ -446,7 +446,7 @@ let rec translate_eq map call_context
         let x = var_from_name map n in
         let si = (match opt_c with
                     | None -> si
-                    | Some c -> (Aassgn (x, mk_ext_value_static x.pat_ty c)) :: si) in
+                    | Some c -> (Aassgn (x, mk_ext_value_exp_static x.pat_ty c)) :: si) in
         let action = Aassgn (var_from_name map n, translate_extvalue_to_exp map e) in
         v, si, j, (control map ck action) :: s
 (* should be unnecessary

compiler/obc/main/obc_compiler.ml

@@ -32,4 +32,7 @@ let compile_program p =
   (*Control optimization*)
   let p = pass "Control optimization" true Control.program p pp in
 
+  (*Loop unrolling*)
+  let p = pass "Loop unrolling" !Compiler_options.unroll_loops Unroll.program p pp in
+
   p

compiler/obc/obc_utils.ml

@@ -59,7 +59,9 @@ let mk_ext_value_exp_int desc = mk_ext_value_exp Initial.tint desc
 
 let mk_ext_value_exp_bool desc = mk_ext_value_exp Initial.tbool desc
 
-let mk_ext_value_static ty sed = mk_ext_value_exp ty (Wconst sed)
+let mk_ext_value_exp_static ty sed = mk_ext_value_exp ty (Wconst sed)
+
+let mk_ext_value_const_int i = mk_ext_value Initial.tint (Wconst (Initial.mk_static_int i))
 
 let mk_evar ty id =
   mk_ext_value_exp ty (Wvar id)
@@ -155,7 +157,7 @@ struct
     | Module _ | QualModule _ -> ModulSet.add qn.qual deps
     | _ -> deps
 
-  let deps_ty funs deps ty = match ty with
+  let deps_ty _ deps ty = match ty with
     | Tid ln -> ty, deps_longname deps ln
     | _ -> raise Errors.Fallback
 

compiler/obc/transformations/unroll.ml

@@ -0,0 +1,56 @@
+(**************************************************************************)
+(*                                                                        *)
+(*  Heptagon                                                              *)
+(*                                                                        *)
+(*  Author : Marc Pouzet                                                  *)
+(*  Organization : Demons, LRI, University of Paris-Sud, Orsay            *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Temporary hack to unroll for loops *)
+
+open Misc
+open Obc
+open Types
+open Obc_utils
+open Obc_mapfold
+
+
+let fresh_for = fresh_for "scalarize"
+
+let is_static e = match e.e_desc with
+  | Eextvalue { w_desc = Wconst { se_desc = Sint i; }; } -> Some i
+  | _ -> None
+
+let unroll vd start stop b =
+  let rec add c l =
+    let ext_value funs () w = match w.w_desc with
+      | Wvar vi ->
+        (if Idents.ident_compare vi vd.v_ident = 0 then mk_ext_value_const_int c else w), ()
+      | _ -> Obc_mapfold.extvalue funs () w
+    in
+
+    if c = stop
+    then l
+    else
+      let funs = { Obc_mapfold.defaults with extvalue = ext_value; } in
+      let new_b, () = Obc_mapfold.block funs () b in
+      add (c + 1) (new_b.b_body @ l)
+  in
+  let l = add start [] in
+  { b with b_body = List.rev l; }
+
+let act funs () a =
+  let a, () = Obc_mapfold.act funs () a in
+  match a with
+    | Afor (vd, start, stop, b) ->
+      (match is_static start, is_static stop with
+        | Some z, Some n -> Ablock (unroll vd z n b), ()
+        | _ -> a, ())
+    | _ -> a, ()
+
+let program p =
+  let p, _ = program_it { defaults with act = act } () p in
+  p
+
+

compiler/utilities/global/compiler_options.ml

@@ -117,6 +117,7 @@ let use_old_scheduler = ref false
 
 let strict_ssa = ref false
 
+let unroll_loops = ref false
 
 let optim = ref false
 let do_optim () =
@@ -151,7 +152,7 @@ and doc_target =
   "<lang>\tGenerate code in language <lang>\n\t\t\t(with <lang>=c,"
   ^ " java or z3z)"
 and doc_full_type_info = "\t\t\tPrint full type information"
-and doc_stateful_info = "\t\t\tPrint stateful information"
+and doc_stateful_info = "\t\tPrint stateful information"
 and doc_full_name = "\t\tPrint full variable name information"
 and doc_target_path =
   "<path>\tGenerated files will be placed in <path>\n\t\t\t(the directory is"
@@ -171,3 +172,4 @@ and doc_linear_only = "\t\tEnable linear annotations"
 and doc_interf_scheduler = "\tUse the old scheduler"
 and doc_optim = "\t\t\tOptimize with deadcode, tomato, itfusion and memalloc"
 and doc_interf_all = "\t\tPerform memory allocation on all types"
+and doc_unroll = "\t\tUnroll all loops"