Optionally clock generated code

dot2lus.ml

@@ -9,6 +9,8 @@ let action_type = "action"
 let action_number = "actions_number"
 let action_of_int = "action_of_int"
 
+let clock = ref false
+
 
 let algo_name (node : Topology.node) = Filename.chop_suffix node.file ".ml"
 
@@ -39,11 +41,13 @@ function _first_set<<const N:int>>(s : bool^N) returns (x : int);
 var
 	found : int;
 let
-	found = with (N = 1) then (if s[0] then 0 else -1)
-	        else _first_set<<N-1>>(s[1 .. N-1]);
-	x = if s[0] then 0
-	    else if found < 0 then -1
-	    else found + 1;
+	found =
+		with (N = 1) then (if s[0] then 0 else -1)
+		else _first_set<<N-1>>(s[1 .. N-1]);
+	x =
+		if s[0] then 0
+		else if found < 0 then -1
+		else found + 1;
 tel;\n";
 
 	Printf.fprintf output "
@@ -62,16 +66,16 @@ let output_topology output (graph : Topology.t) name =
 		|> List.iteri (fun index node_id -> Hashtbl.add index_map node_id index);
 		Hashtbl.find index_map (* returns the partially applied find *) in
 
-	let sprint_neighbor_list neighbor_ids : string =
+	let index_of_id = make_index graph in
+
+	let sprint_neighbor_list neighbor_ids list : string =
 		match neighbor_ids with
 		| [] -> "[]"
 		| n :: ns ->
-			let prefix, sufix = Printf.sprintf "[ nodes[%d]" n, " ]" in
-			let concat acc n = acc ^ (Printf.sprintf ", nodes[%d]" n) in
+			let prefix, sufix = Printf.sprintf "[ %s[%d]" list n, " ]" in
+			let concat acc n = acc ^ (Printf.sprintf ", %s[%d]" list n) in
 			(List.fold_left concat prefix ns) ^ sufix in
 
-	let index_of_id = make_index graph in
-
 	Printf.fprintf output
 		"\nnode %s(activations : bool^%s^card; initials : %s^card)\n"
 		name action_number state_type;
@@ -82,11 +86,13 @@ let output_topology output (graph : Topology.t) name =
 
 	output_string output "var\n";
 
+	Printf.fprintf output "\tprev_nodes : %s^card;\n\n" state_type;
 	graph.nodes
 	|> List.iteri (fun i _ -> Printf.fprintf output "\tsel_%d : bool;\n" i);
 
 	output_string output "let\n";
 
+	output_string output "\tprev_nodes = initials -> pre(nodes);\n\n";
 	graph.nodes
 	|> List.iteri (fun i _ ->
 		Printf.fprintf output
@@ -98,32 +104,54 @@ let output_topology output (graph : Topology.t) name =
 		let algo = algo_name n in
 		let neighbors = graph.succ n.id |> List.map (fun (_, id) -> index_of_id id) in
 		let deg = List.length neighbors in
-		let nl = sprint_neighbor_list neighbors in
-		Printf.fprintf output "
-	nodes[%d] = initials[%d] ->
-		if sel_%d
-		then %s_step<<%d>>(pre(nodes[%d]), pre(%s), _action_of_activation(activations[%d]))
-		else pre(nodes[%d]);
-	enables[%d] = %s_enable<<%d>>(nodes[%d], %s);\n"
-			i i i algo deg i nl i i i algo deg i nl);
+		let nl = sprint_neighbor_list neighbors "nodes" in
+		let pnl = sprint_neighbor_list neighbors "prev_nodes" in
+		Printf.fprintf output
+			"\tnodes[%d] =\n\t\tif not sel_%d then prev_nodes[%d]\n\t\telse "
+			i i i;
+		if !clock then Printf.fprintf output
+			"current(%s_step<<%d>>(prev_nodes[%d], %s, _action_of_activation(activations[%d])) when sel_%d);\n"
+			algo deg i pnl i i
+		else Printf.fprintf output
+			"%s_step<<%d>>(prev_nodes[%d], %s, _action_of_activation(activations[%d]));\n"
+			algo deg i pnl i;
+		Printf.fprintf output
+			"\tenables[%d] = %s_enable<<%d>>(nodes[%d], %s);\n"
+			i algo deg i nl);
 
 	output_string output "tel;\n"
 
 
-let graph2lus graph name =
-	let output = open_out (name ^ ".lus") in
+let dot2lus dotfile lusfile =
+	let graph = Topology.read dotfile in
+	let name = dotfile |> Filename.basename |> Filename.chop_extension in
+	let output =
+		match lusfile with
+		| None -> open_out (name ^ ".lus")
+		| Some lus -> open_out lus in
 	output_prelude output graph;
 	output_topology output graph name;
 	close_out output
 
 
-let dot2lus dotfile =
-	let graph = Topology.read dotfile in
-	let name = dotfile |> Filename.basename |> Filename.chop_extension in
-	graph2lus graph name
-
-
 let _ =
-	match Array.length Sys.argv with
-	| 2 -> dot2lus Sys.argv.(1)
-	| _ -> print_string "usage: dot2lus <dotfile>\n"; exit 1
+	let usage = "dot2lus <dotfile> [-o lusfile] [--clock] [--help]" in
+	let dotfile = ref "" in
+	let lusfile = ref "" in
+
+	let anon_parse arg =
+		match !dotfile with
+		| "" -> dotfile := arg
+		| _ -> raise (Arg.Bad "multiple input topologies not supported") in
+
+	let speclist =
+		[ ("-o", Arg.Set_string lusfile, "Set output file");
+		  ("--clock", Arg.Set clock, "Generate clocked code (default is unclocked)") ] in
+
+	Arg.parse speclist anon_parse usage;
+	match !dotfile with
+	| "" -> print_string (Arg.usage_string speclist usage); exit 1
+	| dot ->
+		match !lusfile with
+		| "" -> dot2lus dot None
+		| lus -> dot2lus dot (Some lus)