Commit 5255a789 authored by Aliaume Lopez's avatar Aliaume Lopez

Progression sur les petits détails

parent a5cf5260
......@@ -129,6 +129,8 @@ let convert_label = function
| "PMOS" -> Gate Pmos
| "WAIT" -> Gate Wait
| "DISC" -> Disconnect
| "FORK" -> Gate Fork
| "JOIN" -> Gate Join
| x -> Gate (Box x)
end;;
......@@ -275,7 +277,7 @@ let rules = [ Rewriting.remove_identity ;
let looping_reduction_step x =
let x = Rewriting.mark_and_sweep x in
let x = Rewriting.garbage_collect_dual x in
report "GARBAGE COLLECT" x;
let x = rewrite_local rules x in
report "LOCAL REWRITE" x;
......
......@@ -152,16 +152,20 @@ let parse_sstring c s i = (ign_space <*>> parse_string c <<*> ign_space) s i;;
* containing the mappings ...
*)
let circuit_of_name = function
| "F" -> const "F" 1 1
| "G" -> const "G" 1 1
| "H" -> const "H" 2 2
| "F" -> const "F" 1 1
| "G" -> const "G" 1 1
| "H" -> const "H" 2 2
| "P" -> const "PMOS" 2 1
| "N" -> const "NMOS" 2 1
| "HIGH" -> const "HIGH" 0 1
| "LOW" -> const "LOW" 0 1
| "MUX" -> const "MUX" 3 1
| "BOT" -> const "BOT" 0 1
| "WAIT" -> const "WAIT" 1 1
| "DISC" -> const "DISC" 1 0
| x -> const x 1 1;;
| "FORK" -> const "FORK" 1 2
| "JOIN" -> const "JOIN" 2 1
| x -> const x 1 1;;
(**** THE GRAMMAR
*
......
......@@ -105,7 +105,8 @@ type value =
| High
| Low
| Top
| Bottom;;
| Bottom
| Wave of value list ;;
type label =
......@@ -191,11 +192,12 @@ let string_of_gate = function
| Wait -> "W"
| Mux -> "M";;
let string_of_value = function
let rec string_of_value = function
| High -> "H"
| Low -> "L"
| Top -> "T"
| Bottom -> "Z";;
| Bottom -> "Z"
| Wave w -> w |> List.map string_of_value |> String.concat "::";;
let string_of_label = function
| Disconnect -> "D"
......
......@@ -82,6 +82,8 @@ let propagate_fork ~node:n t =
* Propagating bottoms
* through joins and disconnect trough
* forks
*
* NOTE useless because of join reducing gate ...
*)
let bottom_join ~node:n t =
try (* pattern matching failure means no modification *)
......@@ -142,10 +144,30 @@ let reduce_mux inputs =
* nmos
* pmos
*)
let reduce_nmos = fun _ -> NoOP;;
let reduce_pmos = fun _ -> NoOP;;
let reduce_join inputs =
try
let [a;b] = inputs in
match (a,b) with
| Some (Value High), Some (Value Low) -> Result Top
| Some (Value Low), Some (Value High) -> Result Top
| Some (Value High), Some (Value High) -> Result High
| Some (Value Low), Some (Value Low) -> Result Low
| Some (Value Top), _ -> Result Top
| _, Some (Value Top) -> Result Top
| Some (Value Bottom),_ -> Wire 1
| _, Some (Value Bottom) -> Wire 0
| _ -> NoOP
with
Match_failure _ -> NoOP;;
let fun_of_gate = function
| Mux -> reduce_mux
| Mux -> reduce_mux
| Nmos -> reduce_nmos
| Pmos -> reduce_pmos
| Join -> reduce_join
| _ -> (fun _ -> NoOP);;
(**
......@@ -201,8 +223,8 @@ let reduce_gate ~node:n t =
*)
let m = newid () in
let e = neweid () in
t |> main_add ~node:n
|> label_set ~node:n ~label:(Value l)
t |> main_add ~node:m
|> label_set ~node:m ~label:(Value l)
|> edge_insert_node ~edge:o ~node:m ~using:e
(* remove the edge between the inserted node
* and the gate
......@@ -246,6 +268,21 @@ let normalize_delay ~node:n ptg =
with
Match_failure _ -> ptg;;
(**
* Put a graph into the normal timed form
*)
let normal_timed_form ptg =
let is_delay n =
match id_find n ptg.labels with
| Some (Gate Wait) -> true
| _ -> false
in
let delayed_nodes =
ptg.nodes |> List.filter is_delay
in
ptg |> batch ~f:normalize_delay ~nodes:delayed_nodes;;
(*
* TODO
* convince that it does the right thing
......@@ -366,7 +403,24 @@ let unfold_trace g1 =
;;
(**
* Mark nodes
* Mark nodes to calculate
* the accessible nodes in the DUAL graph
*)
let rec mark_nodes_dual ~seen ~nexts ptg =
match nexts with
| [] -> seen
| t :: q ->
if List.mem t seen then
mark_nodes_dual ~seen:seen ~nexts:q ptg
else
let pre_nodes = pre_nodes ~node:t ptg in
mark_nodes_dual ~seen:(t :: seen)
~nexts:(pre_nodes @ q)
ptg;;
(**
* Mark nodes to calculate
* the accessible nodes in the graph
*)
let rec mark_nodes ~seen ~nexts ptg =
match nexts with
......@@ -375,9 +429,9 @@ let rec mark_nodes ~seen ~nexts ptg =
if List.mem t seen then
mark_nodes ~seen:seen ~nexts:q ptg
else
let pre_nodes = pre_nodes ~node:t ptg in
let post_nodes = post_nodes ~node:t ptg in
mark_nodes ~seen:(t :: seen)
~nexts:(pre_nodes @ q)
~nexts:(post_nodes @ q)
ptg;;
(**
......@@ -405,8 +459,8 @@ let rec mark_nodes ~seen ~nexts ptg =
* code is better than optimized one)
*
*)
let mark_and_sweep t =
let reachable = mark_nodes ~seen:t.iports ~nexts:t.oports t in
let garbage_collect_dual t =
let reachable = mark_nodes_dual ~seen:t.iports ~nexts:t.oports t in
let filter_func x = not (List.mem x reachable) in
let is_reachable f e =
List.mem (f (edge_get_nodes ~edge:e t)) reachable
......@@ -483,4 +537,3 @@ let example_ptg_4 =
|> main_add ~node:t
|> edge_add ~from:i ~towards:t
|> edge_add ~from:t ~towards:o;;
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