Commit 72b83b99 authored by Aliaume Lopez's avatar Aliaume Lopez

Delays ... now « working »

parent 09dd7a0e
......@@ -62,6 +62,7 @@ The constant circuits are in capital letters. The following circuits are availab
* HIGH (value high)
* LOW (value low)
* DISC (disconnect gate)
* WAIT (delay node)
* Any other capital letter circuit is considered as a « box » with type 1->1, except `F`, `G` and `H` (for debugging purpose)
The symmetry is not a circuit yet.
......@@ -105,3 +106,9 @@ val bindo : string -> circ -> circ
val empty : circ
val print_ast : circ -> string
```
The other circuits (constant circuits) are constructed
using the `const` operator and setting the string parameter
with the name of the circuit you want. The list of
reserved circuit names and their meaning is described in
the constant circuit section of the syntax.
......@@ -45,7 +45,11 @@ let dot_of_ptg ptg =
| Some (Gate Fork)
| Some Disconnect
| Some (Value _) -> None
| _ -> Some (1 + list_index eid l)
| _ ->
if List.mem nid ptg.delays then
None
else
Some (1 + list_index eid l)
in
let draw_edge eid (a,b) =
......@@ -82,12 +86,14 @@ let dot_of_ptg ptg =
let traced =
ptg.traced
(*|> List.map (fun x -> mkNode x (emptyMod |> mod_color "red" |> mod_shape "diamond"))*)
|> List.map (fun x -> mkNode x (emptyMod |> mod_shape "point" |> mod_width 0.1 |> mod_color "red"))
|> String.concat "\n"
in
let delays =
ptg.delays
(*|> List.map (fun x -> mkNode x (emptyMod |> mod_color "grey" |> mod_shape "diamond"))*)
|> List.map (fun x -> mkNode x (emptyMod |> mod_shape "point" |> mod_width 0.1 |> mod_color "grey"))
|> String.concat "\n"
in
......@@ -245,7 +251,7 @@ let fc = ref 0;;
let report txt ptg =
incr fc;
let base = "test" ^ string_of_int !fc in
let base = Printf.sprintf "test%03d" !fc in
print_string (txt ^ ": " ^ base ^ "\n");
ptg |> string_of_ptg |> print_string ;
ptg_to_file (base ^ ".dot") ptg;
......@@ -268,7 +274,7 @@ let rewrite_local rules ptg =
!inter;;
let rules = [ Rewriting.remove_identity ;
let rules = [ Rewriting.remove_identity ;
Rewriting.propagate_constant ;
Rewriting.propagate_fork ;
Rewriting.bottom_join ;
......@@ -295,9 +301,10 @@ let () =
"lines.txt"
in
let x = ref (get_ptg_of_file file) in
report "INIT" !x;
x := Rewriting.normal_timed_form !x;
report "INIT" !x;
report "INIT" (snd (Rewriting.rewrite_delays !x));
report "INIT" (Rewriting.unfold_trace !x);
let n = 6 in
......
(HIGH | BOT) . JOIN
link a:b for
(:b | 1) . JOIN . F . WAIT . (1 | HIGH) . JOIN . FORK . (a: | 1)
......@@ -89,7 +89,7 @@ let merger_v k a b = match a, b with
| Some a, None -> Some a
| None , Some b -> Some b
| Some a, Some b when a = b -> Some a
| Some a, Some b -> Some a ;; (** default value ... Careful !!!*)
| Some a, Some b -> failwith "MERGE ERROR CONFLICTING VALUES";; (* Some a ;; (** default value ... Careful !!!*)*)
type gate =
......@@ -110,7 +110,7 @@ type value =
type label =
| Disconnect (* dangling node *)
| Value of value
| Wave of value list
(*| Wave of value list*)
| Gate of gate;;
......@@ -214,6 +214,10 @@ let string_of_ptg ptg =
ptg.traced |> List.map (fun x -> string_of_int x) |> String.concat ", ";
"\tDELAYS : ";
ptg.delays |> List.map (fun x -> string_of_int x) |> String.concat ", ";
"\tLABELS : ";
ptg.labels |> id_bindings
|> List.map (fun (a,b) -> "node " ^ string_of_int a ^ " = " ^ string_of_label b)
|> String.concat ", ";
"\tEDGES";
ptg.arrows |> id_bindings
|> List.map (fun (e,(x,y)) ->
......
......@@ -18,9 +18,10 @@ open Ptg;;
*)
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
if not (List.mem traced_node t.traced) then
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
if not (List.mem traced_node t.traced) || List.mem next_node t.delays then
t
else
t |> trace_rem ~node:traced_node
......@@ -306,6 +307,7 @@ let normalize_delay ~node:n ptg =
|> trace_add ~node:trace_node
|> main_rem ~node:n
|> delay_add ~node:n
|> label_set ~node:n ~label:(Gate Wait)
with
Match_failure _ -> ptg;;
......@@ -363,10 +365,6 @@ let rewrite_delays g1 =
(* Starting by merging the two copies *)
let new_ptg = ptg_merge g1 g2
(** adding trace nodes in reverse order to keep the same order
* in the end ...
*)
(*|> batch ~f:trace_add ~nodes:(List.rev new_trace)*)
|> batch ~f:main_add ~nodes:(bottoms_pre @ bottoms_ipts @ new_delays @ new_trace)
(** adding nodes in reverse order to keep the same order
* in the end ...
......@@ -396,23 +394,14 @@ let rewrite_delays g1 =
~nodes:(bottoms_pre @ bottoms_ipts)
|> batch ~f:label_rem ~nodes:(g1.delays @ g2.delays)
(* Reconnect the trace *)
(*|> connect ~from:post1 ~towards:new_trace*)
|> connect ~from:g1.oports
~towards:new_delays
|> mk_join ~fst:new_delays
~snd:g2.oports
~towards:new_outputs
(* TODO do it more efficiently !!!
* We already know the delay nodes
* that are added !
*)
|> normal_timed_form
in
(new_trace, new_ptg);;
(new_trace, new_delays, new_ptg);;
(**
......@@ -423,12 +412,20 @@ let rewrite_delays g1 =
*)
let unfold_trace g1 =
if g1.traced <> [] then
let (pre2,g2) = rewrite_delays (snd (replicate g1)) in
(* Construct a new graph with the
* right dispatching of inputs - trace nodes,
* the disconnects in the right places,
* and gives :
* the pre nodes to connect to
* the new delays that were created
* the graph itself
*)
let (pre2,new_delays,g2) = rewrite_delays (snd (replicate g1)) in
let (pre1,post1,g1) = trace_split g1 in
let new_inputs = newids (List.length g1.iports) in
ptg_merge g1 g2
|> batch ~f:(label_set ~label:Disconnect) ~nodes:g1.oports
......@@ -441,6 +438,9 @@ let unfold_trace g1 =
|> batch ~f:trace_add ~nodes:(List.rev pre1)
|> batch ~f:iport_add ~nodes:(List.rev new_inputs)
|> batch ~f:oport_add ~nodes:(List.rev g2.oports)
|> batch ~f:normalize_delay ~nodes:new_delays
|> batch ~f:delay_add ~nodes:g1.delays
else
g1
......
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