2010-06-15 10:49:03 +02:00
|
|
|
(**************************************************************************)
|
|
|
|
(* *)
|
|
|
|
(* Heptagon *)
|
|
|
|
(* *)
|
|
|
|
(* Author : Marc Pouzet *)
|
|
|
|
(* Organization : Demons, LRI, University of Paris-Sud, Orsay *)
|
|
|
|
(* *)
|
|
|
|
(**************************************************************************)
|
|
|
|
(* scheduling of equations *)
|
|
|
|
|
|
|
|
|
|
|
|
open Misc
|
|
|
|
open Minils
|
2010-06-27 17:24:31 +02:00
|
|
|
open Mls_utils
|
2011-04-20 14:10:10 +02:00
|
|
|
open Sgraph
|
2010-06-15 10:49:03 +02:00
|
|
|
open Dep
|
|
|
|
|
|
|
|
(* possible overlapping between clocks *)
|
|
|
|
let join ck1 ck2 =
|
|
|
|
let n1 = Vars.head ck1
|
|
|
|
and n2 = Vars.head ck2 in
|
|
|
|
(* C1(x1) on ... on Cn(xn) with C'1(x'1) on ... on C'k(x'k) *)
|
|
|
|
match n1, n2 with
|
|
|
|
[], [] -> true
|
|
|
|
| x1 ::_, x2 ::_ when x1 = x2 -> true
|
|
|
|
| _ -> false
|
|
|
|
|
|
|
|
let join eq1 eq2 = join (Vars.clock eq1) (Vars.clock eq2)
|
|
|
|
|
2010-07-14 03:45:38 +02:00
|
|
|
(* TODO *)
|
2010-06-15 10:49:03 +02:00
|
|
|
(* possible overlapping between nodes *)
|
|
|
|
(*let head e =
|
|
|
|
match e with
|
|
|
|
| Emerge(_, c_e_list) -> List.fold (fun acc e -> Vars.head (clock e) :: acc)
|
|
|
|
| e -> [Vars.head (clock e)]
|
|
|
|
|
|
|
|
(* e1 define a pieces of control structures with *)
|
|
|
|
(* paths on clock C1(x1) on ... on Cn(xn) ... *)
|
|
|
|
(* e1 can be merged if *)
|
|
|
|
let n1_list = head e1 in
|
|
|
|
let n2_list = head e2 in
|
|
|
|
*)
|
|
|
|
|
|
|
|
(* clever scheduling *)
|
|
|
|
let schedule eq_list =
|
|
|
|
let rec recook = function
|
|
|
|
| [] -> []
|
|
|
|
| node :: node_list -> node >> (recook node_list)
|
2010-06-26 16:53:25 +02:00
|
|
|
|
2010-06-15 10:49:03 +02:00
|
|
|
and (>>) node node_list =
|
|
|
|
try
|
|
|
|
insert node node_list
|
|
|
|
with
|
2010-06-26 16:53:25 +02:00
|
|
|
Not_found -> node :: node_list
|
|
|
|
|
2010-06-15 10:49:03 +02:00
|
|
|
and insert node = function
|
|
|
|
| [] -> raise Not_found
|
|
|
|
| node1 :: node_list ->
|
2010-06-26 16:53:25 +02:00
|
|
|
if linked node node1 then raise Not_found
|
|
|
|
else
|
|
|
|
try
|
|
|
|
node1 :: (insert node node_list)
|
|
|
|
with
|
|
|
|
| Not_found ->
|
|
|
|
if join (containt node) (containt node1)
|
|
|
|
then node :: node1 :: node_list
|
|
|
|
else raise Not_found in
|
|
|
|
|
2010-06-15 10:49:03 +02:00
|
|
|
let node_list, _ = DataFlowDep.build eq_list in
|
|
|
|
let node_list = recook (topological node_list) in
|
|
|
|
let node_list = List.rev node_list in
|
|
|
|
let node_list = recook node_list in
|
|
|
|
let node_list = List.rev node_list in
|
2010-06-26 16:53:25 +02:00
|
|
|
List.map containt node_list
|
2010-06-15 10:49:03 +02:00
|
|
|
|
2010-07-21 16:00:06 +02:00
|
|
|
let eqs funs () eq_list =
|
|
|
|
let eqs, () = Mls_mapfold.eqs funs () eq_list in
|
|
|
|
schedule eqs, ()
|
|
|
|
|
2010-07-14 03:45:38 +02:00
|
|
|
let program p =
|
2011-04-18 15:38:42 +02:00
|
|
|
let funs = { Mls_mapfold.defaults with Mls_mapfold.eqs = eqs } in
|
|
|
|
let p, () = Mls_mapfold.program_it funs () p in
|
|
|
|
p
|