More simplifcation passes...

7 files changed, 137 insertions, 55 deletions

diff --git a/README b/README
index 40734fa..43a4ebb 100644
--- a/README
+++ b/README
@@ -52,3 +52,12 @@ When represented in binary, we write the bits in the order :
 
 /!\ BINARY NUMBERS ARE WRITTEN REVERSE !
 
+
+REFERENCES
+----------
+
+  -	Computer organization and design : the hardware/software interface
+	4th ed
+	Chapters 2 to 4
+
+
diff --git a/sched/graph.ml b/sched/graph.ml
index 54128ff..ad4fded 100644
--- a/sched/graph.ml
+++ b/sched/graph.ml
@@ -44,7 +44,7 @@ let has_cycle g =
 			ret
 	in
 	let ret = List.fold_left (fun x n -> x || (if n.n_mark = Visited then false else visit n)) false g.g_nodes
-	in clear_marks g; ret;;
+	in clear_marks g; ret
 
 let topological g =
 	clear_marks g;
@@ -57,5 +57,28 @@ let topological g =
 			end
 	in
 	let ret = List.fold_left (fun x n -> aux x n) [] g.g_nodes
-	in clear_marks g; List.rev ret;;
+	in clear_marks g; List.rev ret
 
+let topological_from_roots g roots =
+	clear_marks g;
+	let rec aux acc n =
+		if n.n_mark = Visited
+			then acc
+			else begin
+				n.n_mark <- Visited;
+				n.n_label :: (List.fold_left (fun x n -> aux x n) acc n.n_linked_by)
+			end
+	in
+	let ret = List.fold_left
+		(fun x n -> aux x (node_for_label g n)) [] roots
+	in
+	let used = List.fold_left
+		(fun s n ->
+			if n.n_mark = Visited then
+				n.n_label::s
+			else
+				s)
+		[]
+		g.g_nodes in
+	clear_marks g;
+	List.rev ret, used
diff --git a/sched/main.ml b/sched/main.ml
index a2a4d3b..1b4b9d8 100644
--- a/sched/main.ml
+++ b/sched/main.ml
@@ -8,10 +8,13 @@ let compile filename =
     let p = Netlist.read_file filename in
     let out_name = (Filename.chop_suffix filename ".net") ^ "_sch.net" in
 	let dumb_out_name = (Filename.chop_suffix filename ".net") ^ ".dumb" in
-	let q = ref p in
+    let out_opt_name = (Filename.chop_suffix filename ".net") ^ "_sch_opt.net" in
+	let dumb_opt_out_name = (Filename.chop_suffix filename ".net") ^ "_opt.dumb" in
+	let q, q_opt = ref p, ref p in
 
     begin try
-		q := (Simplify.simplify (Scheduler.schedule p))
+		q := Scheduler.schedule p;
+		q_opt := Simplify.simplify p
       with
         | Scheduler.Combinational_cycle ->
             Format.eprintf "The netlist has a combinatory cycle.@.";
@@ -25,6 +28,13 @@ let compile filename =
 	Netlist_printer.print_dumb_program dumb_out !q;
 	close_out dumb_out;
 
+	let out_opt = open_out out_opt_name in
+	Netlist_printer.print_program out_opt !q_opt;
+	close_out out_opt;
+	let dumb_opt_out = open_out dumb_opt_out_name in
+	Netlist_printer.print_dumb_program dumb_opt_out !q_opt;
+	close_out dumb_opt_out;
+
     if !simulate then (
       let simulator =
         if !number_steps = -1 then
diff --git a/sched/scheduler.ml b/sched/scheduler.ml
index 130164b..34ce3aa 100644
--- a/sched/scheduler.ml
+++ b/sched/scheduler.ml
@@ -21,11 +21,15 @@ let read_exp eq =
 	| Eslice(_, _, a) -> add_arg a []
 	| Eselect(_, a) -> add_arg a []
 	in
-		aux eq;;
+		aux eq
 
-let schedule p =
+let prog_eq_map p =
+	List.fold_left
+		(fun x (vn, eqn) -> Smap.add vn eqn x)
+		Smap.empty p.p_eqs
+
+let prog_graph p eq_map =
 	let graph = Graph.mk_graph() in
-	let eq_map = List.fold_left (fun x (vn, eqn) -> Smap.add vn eqn x) Smap.empty p.p_eqs in
 	(* Add variables as graph nodes *)
 	List.iter (fun (k, _) -> Graph.add_node graph k) p.p_eqs;
 	(* Add dependencies as graph edges *)
@@ -36,17 +40,26 @@ let schedule p =
 		p.p_eqs;
 	(* Verify there are no cycles *)
 	if Graph.has_cycle graph then raise Combinational_cycle;
+	graph
+
+let schedule p =
+	let eq_map = prog_eq_map p in
+	let graph = prog_graph p eq_map in
+
 	(* Topological sort of graph nodes *)
 	let topo_vars = Graph.topological graph in
 	(* Construct new program with sorted expression list *)
 	{
 		p_eqs = List.fold_right
-			(fun n x -> if Smap.mem n eq_map then (n, Smap.find n eq_map)::x else x) topo_vars [];
+			(fun n x ->
+				if Smap.mem n eq_map then
+					(n, Smap.find n eq_map)::x
+				else x)
+			topo_vars [];
 		p_inputs = p.p_inputs;
 		p_outputs = p.p_outputs;
 		p_vars = p.p_vars;
 	}
-	;;
 
 
 
diff --git a/sched/simplify.ml b/sched/simplify.ml
index 01f7c84..ae5ec65 100644
--- a/sched/simplify.ml
+++ b/sched/simplify.ml
@@ -8,14 +8,15 @@
 	- transform k = SELECT 0 var into k = var when var is also one bit
 	- look for variables with same equation, put the second to identity
 	- eliminate k' for each equation k' = k
-	- eliminate dead equations
+	- topological sort
 
-	These simplifications are run on a topologically sorted list of equations (see main.ml)
+	TODO : eliminate unused variables. problem : they are hard to identify
 *)
 
 open Netlist_ast
 
 module Sset = Set.Make(String)
+module Smap = Map.Make(String)
 
 (* Simplify cascade slicing/selecting *)
 let cascade_slices p =
@@ -23,15 +24,14 @@ let cascade_slices p =
 	let eqs_new = List.map
 		(fun (n, eq) -> (n, match eq with
 			| Eslice(u, v, Avar(x)) ->
-				let nu, nx =
+				let dec, nx =
 					if Hashtbl.mem slices x then begin
-						let ku, kx = Hashtbl.find slices x in
-						(ku + u, kx)
+						Hashtbl.find slices x
 					end else 
-						 (u, x)
+						 (0, x)
 				in
-				Hashtbl.add slices n (nu, nx);
-				Eslice(nu, v, Avar(nx))
+				Hashtbl.add slices n (u + dec, nx);
+				Eslice(u + dec, v + dec, Avar(nx))
 			| Eselect(u, Avar(x)) ->
 				begin try
 					let ku, kx = Hashtbl.find slices x in
@@ -46,7 +46,7 @@ let cascade_slices p =
 		p_inputs = p.p_inputs;
 		p_outputs = p.p_outputs;
 		p_vars = p.p_vars;
-	}
+	}, false
 
 (* Simplifies some trivial arithmetic possibilites :
 	a and 1 = a
@@ -55,6 +55,9 @@ let cascade_slices p =
 	a or 0 = a
 	a xor 0 = a
 	slice i i x = select i x
+	concat const const = const.const
+	slice i j const = const.[i..j]
+	select i const = const.[i]
 *)
 let arith_simplify p =
 	{
@@ -75,13 +78,30 @@ let arith_simplify p =
 
 			| Eslice(i, j, k) when i = j ->
 				(n, Eselect(i, k))
+
+			| Econcat(Aconst(a), Aconst(b)) ->
+				let aa = match a with
+					| VBit(a) -> [| a |]
+					| VBitArray(a) -> a
+				in
+				let ba = match b with
+					| VBit(a) -> [| a |]
+					| VBitArray(a) -> a
+				in
+				(n, Earg(Aconst(VBitArray(Array.append aa ba))))
+			
+			| Eslice(i, j, Aconst(VBitArray(a))) ->
+				(n, Earg(Aconst(VBitArray(Array.sub a i (j - i + 1)))))
+			
+			| Eselect(i, Aconst(VBitArray(a))) ->
+				(n, Earg(Aconst(VBit(a.(i)))))
 			
 			| _ -> (n, eq))
 			p.p_eqs;
 		p_inputs = p.p_inputs;
 		p_outputs = p.p_outputs;
 		p_vars = p.p_vars;
-	}
+	}, false
 
 (* if x is one bit, then :
 	select 0 x = x
@@ -98,7 +118,7 @@ let select_to_id p =
 		p_inputs = p.p_inputs;
 		p_outputs = p.p_outputs;
 		p_vars = p.p_vars;
-	}
+	}, false
 
 (*
 	If a = eqn(v1, v2, ...) and b = eqn(v1, v2, ...)   <- the same equation
@@ -128,7 +148,7 @@ let same_eq_simplify p =
 		p_inputs = p.p_inputs;
 		p_outputs = p.p_outputs;
 		p_vars = p.p_vars;
-	}
+	}, false
 
 
 (*	Replace one specific variable by another argument in the arguments of all equations
@@ -192,23 +212,31 @@ let rec eliminate_id p =
 	| None -> p, false
 	| Some(n, rep) -> fst (eliminate_id (eliminate_var n rep p)), true
 
-
-(* Eliminate dead equations *)
-let eliminate_dead p =
-	p, false (* TODO *)
-	(* a bit like a topological sort... *)
-
+(* Topological sort *)
+let topo_sort p =
+	(Scheduler.schedule p, false)
 
 (* Apply all the simplification passes,
 	in the order given in the header of this file
 *)
+let dump_varlist p =
+	print_string "Eq list:\n";
+	List.iter (fun (n, _) -> print_string ("- "^n^"\n")) p.p_eqs
+
 let rec simplify p =
-	let p1 = cascade_slices p in
-	let p2 = arith_simplify p1 in
-	let p3 = select_to_id p2 in
-	let p4 = same_eq_simplify p3 in
-	let p5, use5 = eliminate_id p4 in
-	let p6, use6 = eliminate_dead p5 in
-	let pp = p6 in
-	if use5 || use6 then simplify pp else pp
+	let steps = [
+		cascade_slices;
+		arith_simplify;
+		select_to_id;
+		same_eq_simplify; 
+		eliminate_id;
+		topo_sort;
+	] in
+	let pp, use = List.fold_left
+		(fun (x, u) f ->
+			let xx, uu = f x in 
+			dump_varlist xx;
+			(xx, u || uu))
+		(p, false) steps in
+	if use then simplify pp else pp
 
diff --git a/tests/Makefile b/tests/Makefile
index 443e86a..0721dab 100644
--- a/tests/Makefile
+++ b/tests/Makefile
@@ -7,7 +7,7 @@ SIM=../csim/csim
 %.sim: %.dumb
 	$(SIM) $<
 
-%.dumb %_sch.net: %.net
+%.dumb %_sch.net %_opt.dumb %_sch_opt.net: %.net
 	$(SCHED) $<
 
 %.net: %.mj
diff --git a/tests/clockHMS.mj b/tests/clockHMS.mj
index 27f96ea..a25a85c 100644
--- a/tests/clockHMS.mj
+++ b/tests/clockHMS.mj
@@ -13,19 +13,18 @@ repeat<n>(a) = (x:[n]) where
 end where
 
 fulladder(a,b,c) = (s, r) where
-  s = (a ^ b) ^ c;
-  r = (a & b) + ((a ^ b) & c);
+	s = (a ^ b) ^ c;
+	r = (a & b) + ((a ^ b) & c);
 end where
 
 adder<n>(a:[n], b:[n], c_in) = (o:[n], c_out) where
-  if n = 0 then
-    o = [];
-    c_out = 0
-  else
-    (s_n, c_n1) = fulladder(a[0], b[0], c_in);
-    (s_n1, c_out) = adder<n-1>(a[1..], b[1..], c_n1);
-    o = s_n . s_n1
-  end if
+	if n = 1 then
+		(o, c_out) = fulladder(a[0], b[0], c_in)
+	else
+		(s_n, c_n1) = fulladder(a[0], b[0], c_in);
+		(s_n1, c_out) = adder<n-1>(a[1..], b[1..], c_n1);
+		o = s_n . s_n1
+	end if
 end where
 
 equal<n, m>(a:[n]) = (eq) where
@@ -41,29 +40,29 @@ equal<n, m>(a:[n]) = (eq) where
 end where
 
 reg_n<n>(a:[n]) = (r:[n]) where
-	if n = 0 then
-		r = []
+	if n = 1 then
+		r = reg a[0]
 	else
-		r = (reg a[0]) . (reg_n<n-1>(r[1..]))
+		r = (reg a[0]) . (reg_n<n-1>(a[1..]))
 	end if
 end where
 
 and_each<n>(a, b:[n]) = (o:[n]) where
-	if n = 0 then
-		o = []
+	if n = 1 then
+		o = b[0] and a
 	else
 		o = (b[0] and a) . and_each<n-1>(a, b[1..])
 	end if
 end where
 
 count_mod<n, m>(in:[n]) = (out:[n]) where
-	neq = not (equal<n, m>(in));
 	(incr, carry) = adder<n>(in, 1 . repeat<n-1>(0), 0);
+	neq = not (equal<n, m>(incr));
 	out = and_each<n>(neq, incr)
 end where
 
-main() = (ret:[2],out:[2]) where
-	out = count_mod<2, 3>(ret);
-	ret = reg_n<2>(out)
+main() = (out:[4],next:[4]) where
+	next = count_mod<4, 12>(out);
+	out = reg_n<4>(next)
 end where