Commit d47599e6 authored by Aliaume Lopez's avatar Aliaume Lopez

Lots of comments

parent 72b83b99
......@@ -11,16 +11,29 @@ open Ptg ;;
(******* DOT OUTPUT ... *******)
(*
* Gives the first index at which the element
* x is found inside the list l
*
* Throws error if x is not inside l
*)
let rec list_index x = function
| [] -> failwith "(circuits.ml) [list_index] : error, no such thing"
| t :: q when t = x -> 0
| t :: q -> 1 + list_index x q;;
open Dot;;
(* conversion from ptg to a dot graph *)
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
(* all the output ports have the same maximum rank *)
let fin_rank = rank_group "max" ptg.oports in
(* How to draw a main node *)
let main_node nid =
let n = List.length (pre_nodes ~node:nid ptg) in
let m = List.length (post_nodes ~node:nid ptg) in
......@@ -38,9 +51,10 @@ let dot_of_ptg ptg =
mkNode nid (baseMod |> inputsOutputs (string_of_label l) n m)
in
(* How to get the port number for a node's edge *)
let node_port_from_edge nid l eid =
match id_find nid ptg.labels with
| None
| None (* if it has no label or is a special node -> no port ! *)
| Some (Gate Join)
| Some (Gate Fork)
| Some Disconnect
......@@ -49,9 +63,10 @@ let dot_of_ptg ptg =
if List.mem nid ptg.delays then
None
else
Some (1 + list_index eid l)
Some (1 + list_index eid l) (* otherwise it is the index of the edge *)
in
(* How to drow an edge between two nodes *)
let draw_edge eid (a,b) =
let l1 = edges_from ~node:a ptg in
let l2 = edges_towards ~node:b ptg in
......@@ -97,7 +112,8 @@ let dot_of_ptg ptg =
|> List.map (fun x -> mkNode x (emptyMod |> mod_shape "point" |> mod_width 0.1 |> mod_color "grey"))
|> String.concat "\n"
in
(* The actual construction *)
[ init_rank; fin_rank; main_nodes; inputs; outputs; delays; traced;edges ]
|> String.concat "\n"
|> addPrelude;;
......@@ -249,6 +265,13 @@ let ptg_to_file fname ptg =
let fc = ref 0;;
(**
* Report a graph.
*
* Outputs the graph to the standard output
* and writes the dot conversion into the
* according testXXX file
*)
let report txt ptg =
incr fc;
let base = Printf.sprintf "test%03d" !fc in
......@@ -257,6 +280,8 @@ let report txt ptg =
ptg_to_file (base ^ ".dot") ptg;
Sys.command ("dot -Tpdf " ^ base ^ ".dot" ^ " -o " ^ base ^ ".pdf");;
(* Some utility functions for the local rules application *)
let apply_local_rule rule ptg =
List.fold_left (fun t n -> rule ~node:n t) ptg ptg.nodes;;
......@@ -273,7 +298,11 @@ let rewrite_local rules ptg =
done;
!inter;;
(*
* The set of rules that will be applied
* by the local reduction algorithm
*)
let rules = [ Rewriting.remove_identity ;
Rewriting.propagate_constant ;
Rewriting.propagate_fork ;
......@@ -281,7 +310,9 @@ let rules = [ Rewriting.remove_identity ;
Rewriting.disconnect_fork ;
Rewriting.reduce_gate ]
(*
* Do a single step of reduction
*)
let looping_reduction_step x =
let x = Rewriting.garbage_collect_dual x in
report "GARBAGE COLLECT" x;
......@@ -289,10 +320,16 @@ let looping_reduction_step x =
report "LOCAL REWRITE" x;
let x = Rewriting.unfold_trace x in
report "TRACE UNFOLDING" x;
let x = Rewriting.garbage_collect_dual x in
report "GARBAGE COLLECT" x;
x;;
(***
*
* The program's entry point
*
*)
let () =
print_string "CIRCUITS - \n";
let file = if Array.length Sys.argv > 1 then
......
link a:b for
(:b | 1) . JOIN . F . WAIT . (1 | HIGH) . JOIN . FORK . (a: | 1)
(HIGH | (HIGH . WAIT) | (HIGH . WAIT)) . (JOIN | 1) . JOIN
......@@ -4,12 +4,12 @@ open Ptg;;
(****
*
* FIXME utiliser des SET de nodes
* quand l'appartenance est souvent
* de mise.
* FIXME
*
* - Use sets instead of lists for better performance in garbage collection
* - Use non-persistent datastructures like hash because they have better
* performace (and we are not using the persistence anyway)
*
* Par exemple quand on fait le garbage
* collection
*)
(**
......@@ -109,25 +109,53 @@ let disconnect_fork ~node:n t =
with
Match_failure _ -> t;;
(**
* A small function that gets the gate
* out of a node if possible, and otherwise
* fails
*)
let gate_of_node ~node:n t =
match id_find n t.labels with
| Some (Gate g) -> g
| _ -> failwith "(gate_of_node) try to get a gate from a non-gate node";;
(**
* A small function that tells if a node
* is a gate
*)
let is_gate ~node:n t =
match id_find n t.labels with
| Some (Gate g) -> true
| _ -> false;;
(**
* GATE REDUCTION PROCESS
*
* The gate reduction is made into several phases
*
* 0) check if the node is a gate
* 1) get the inputs as regular nodes
* 2) get the reduction function corresponding
* to the gate
* 3) calculate the output having given the input nodes
* 4) rewrite the graph according to the output
*
*
* For this to be easy and non-redundant the gate function
* is going to output a `gate_func_outpt` sum type that
* tells how to rewrite the circuit
*)
type gate_func_outpt =
| Result of value
| Wire of int
| NoOP;;
| Result of value (* the result is the value given *)
| Wire of int (* the result is given by the Nth wire *)
| NoOP;; (* there should be no rewriting *)
(* The gate function for multiplexer *)
let reduce_mux inputs =
try
let [a;b;c] = inputs in
let [a;b;c] = inputs in (* first get the inputs *)
(* Then determine the function by matching only the first value *)
match a with
| Some (Value Bottom) -> Result Bottom
| Some (Value Top) -> Result Top
......@@ -138,13 +166,7 @@ let reduce_mux inputs =
with
Match_failure _ -> NoOP;;
(**
*
* TODO:
* join
* nmos
* pmos
*)
(* The gate function for the nmos transistor *)
let reduce_nmos inputs =
try
let [a;b] = inputs in
......@@ -160,6 +182,7 @@ let reduce_nmos inputs =
Match_failure _ -> NoOP;;
(* The gate function for the pmos transistor *)
let reduce_pmos inputs =
try
let [a;b] = inputs in
......@@ -174,7 +197,9 @@ let reduce_pmos inputs =
with
Match_failure _ -> NoOP;;
(* A small function that gives the lowest common
* ancestor for two values of the lattice
*)
let combine_values v1 v2 = match (v1,v2) with
| Low, Low -> Low
| High,High -> High
......@@ -185,11 +210,15 @@ let combine_values v1 v2 = match (v1,v2) with
| Top,x -> Top
| x,Top -> Top;;
(* The previous function extended to whole lists of
* values
*)
let rec combine_values_list w1 w2 = match (w1,w2) with
| [],_ -> w2
| _,[] -> w1
| a::b,c::d -> (combine_values a c) :: combine_values_list b d;;
(* The gate reduction function for join *)
let reduce_join inputs =
try
let [a;b] = inputs in
......@@ -204,7 +233,9 @@ let reduce_join inputs =
with
Match_failure _ -> NoOP;;
(* The function that tells which reduction fonction
* a gate should use
*)
let fun_of_gate = function
| Mux -> reduce_mux
| Nmos -> reduce_nmos
......
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