Commit 8ec56b79 authored by Aliaume Lopez's avatar Aliaume Lopez

Tentative de correction du code

parent ebcd8f00
......@@ -28,7 +28,7 @@ open Dot;;
let dot_of_ptg ptg =
(* all the input ports, traced nodes and delays have the same init rank *)
let init_rank = rank_group "min" (ptg.iports @ ptg.traced @ ptg.delays) in
let init_rank = rank_group "min" (ptg.iports @ ptg.traced ) in
(* all the output ports have the same maximum rank *)
let fin_rank = rank_group "max" ptg.oports in
......@@ -275,7 +275,7 @@ let fc = ref 0;;
let report txt ptg =
incr fc;
let base = Printf.sprintf "test%03d" !fc in
print_string (txt ^ ": " ^ base ^ "\n");
(*print_string (txt ^ ": " ^ base ^ "\n");*)
(*ptg |> string_of_ptg |> print_string ;*)
ptg_to_file (base ^ ".dot") ptg;
Sys.command ("dot -Tpdf " ^ base ^ ".dot" ^ " -o " ^ base ^ ".pdf");;
......@@ -304,7 +304,7 @@ let rewrite_local rules ptg =
* by the local reduction algorithm
*)
let rules = [ Rewriting.remove_identity ;
Rewriting.propagate_constant ;
Rewriting.propagate_constant ;
Rewriting.propagate_fork ;
Rewriting.bottom_join ;
Rewriting.disconnect_fork ;
......@@ -320,6 +320,9 @@ let looping_reduction_step x =
let x = rewrite_local rules x in
report "LOCAL REWRITE" x;
(*let x = Rewriting.garbage_collect_dual x in*)
(*report "GARBAGE COLLECT" x;*)
try
let (v, x1) = Rewriting.first_output x in
print_string "OUTPUT DETECTED : ";
......@@ -331,8 +334,8 @@ let looping_reduction_step x =
let x = Rewriting.unfold_trace x in
report "TRACE UNFOLDING" x;
let x = Rewriting.garbage_collect_dual x in
report "GARBAGE COLLECT" x;
(*let x = Rewriting.garbage_collect_dual x in*)
(*report "GARBAGE COLLECT" x;*)
x;;
......@@ -353,12 +356,14 @@ let () =
report "INIT" !x;
x := Rewriting.normal_timed_form !x;
report "INIT" !x;
report "INIT" (Rewriting.unfold_trace !x);
let n = 6 in
let n = 10 in
for i = 1 to n do
x := looping_reduction_step !x
done;;
done;
x := Rewriting.garbage_collect_dual !x;
report "GARBAGE COLLECT" !x;
();;
......@@ -225,8 +225,8 @@ let link ~vars ~dag:g =
let di = List.length d in
(** adding the bottoms *)
let disc = c |> List.mapi (fun k (_,v) -> (k + m + ci + di + 1, v)) in
let bots = d |> List.mapi (fun k (_,v) -> (k + m + ci + ci + di + 1, v)) in
let disc = c |> List.mapi (fun k (_,v) -> (k + m + ci + di + 2, v)) in
let bots = d |> List.mapi (fun k (_,v) -> (k + m + ci + ci + di + 3, v)) in
(* The edges for each instance of a variable to
......
(HIGH | (LOW . WAIT) | (TOP . WAIT . WAIT)) . (JOIN | 1) . JOIN
((LOW . WAIT) | (HIGH . WAIT . WAIT)) . JOIN
......@@ -20,7 +20,7 @@ let propagate_constant ~node:n t =
try (* pattern matching failure means no modification *)
let Some (Value v) = id_find n t.labels in
let [traced_node] = post_nodes ~node:n t in
let [next_node ] = post_nodes ~node:traced_node t in
let [next_node] = post_nodes ~node:traced_node t in
if not (List.mem traced_node t.traced) || List.mem next_node t.delays then
t
else
......@@ -338,6 +338,8 @@ let normalize_delay ~node:n ptg =
let trace_node = newid () in
let trace_edge = neweid () in
print_string "Normalize delay\n";
ptg |> edge_insert_node ~edge:e ~node:trace_node ~using:trace_edge
|> trace_add ~node:trace_node
......@@ -378,7 +380,6 @@ let rewrite_delays g1 =
(* Creating new special nodes *)
let new_trace = newids (List.length post1) in (* trace dispatch *)
let new_inputs = newids (List.length g1.iports) in (* input dispatch *)
let new_delays = newids (List.length g1.oports) in (* delays at the end *)
let new_outputs = newids (List.length g1.oports) in (* outputs merge *)
......@@ -405,7 +406,7 @@ let rewrite_delays g1 =
(** adding nodes in reverse order to keep the same order
* in the end ...
*)
|> batch ~f:iport_add ~nodes:(List.rev new_inputs)
|> batch ~f:iport_add ~nodes:(List.rev g2.iports)
|> batch ~f:oport_add ~nodes:(List.rev new_outputs)
(* Dispatching the trace *)
......@@ -415,13 +416,6 @@ let rewrite_delays g1 =
~fst:pre1
~snd:pre2
(* Dispatching the inputs *)
|> dispatch_with ~f:is_delayed
~from1:new_inputs
~from2:bottoms_ipts
~fst:g1.iports
~snd:g2.iports
(* Disconnecting the trace output for the second graph *)
|> batch ~f:(label_set ~label:Disconnect) ~nodes:post1
|> batch ~f:(label_set ~label:Disconnect) ~nodes:post2
......@@ -432,6 +426,8 @@ let rewrite_delays g1 =
|> connect ~from:g1.oports
~towards:new_delays
|> connect ~from:bottoms_ipts
~towards:g1.iports
|> mk_join ~fst:new_delays
~snd:g2.oports
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment