summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichael Mathieu <michael@michael-laptop.(none)>2009-01-10 02:05:11 +0100
committerMichael Mathieu <michael@michael-laptop.(none)>2009-01-10 02:05:11 +0100
commit325e33f951b34dd2c68e114024447f4ad9f098d3 (patch)
tree4bb96bea8c177fac1ed62ae788c20ac2e7d4c158
parentb452426ed9f14c244c88ebcbd86e3fb4d7d16ef4 (diff)
downloadsysdigit-325e33f951b34dd2c68e114024447f4ad9f098d3.tar.gz
sysdigit-325e33f951b34dd2c68e114024447f4ad9f098d3.tar.bz2
[simul] Added bus support
-rw-r--r--simul/Makefile2
-rw-r--r--simul/bus.ml35
-rw-r--r--simul/compil.ml133
-rw-r--r--simul/graph.ml170
-rw-r--r--simul/main.ml60
-rw-r--r--simul/paths2
6 files changed, 237 insertions, 165 deletions
diff --git a/simul/Makefile b/simul/Makefile
index 47b8628..833d19f 100644
--- a/simul/Makefile
+++ b/simul/Makefile
@@ -1,4 +1,4 @@
-CMO=loggenerator.cmo scheme.cmo compil.cmo reader.cmo lexerPaths.cmo main.cmo
+CMO=loggenerator.cmo scheme.cmo graph.cmo bus.cmo compil.cmo reader.cmo lexerPaths.cmo main.cmo
CC=ocamlfind ocamlc -package libxml2 -linkpkg
LEX=ocamllex
GENERATED=lexerPaths.ml
diff --git a/simul/bus.ml b/simul/bus.ml
new file mode 100644
index 0000000..24cff0a
--- /dev/null
+++ b/simul/bus.ml
@@ -0,0 +1,35 @@
+open Loggenerator
+open Scheme
+open Graph
+
+let extract_singleton m =
+ Imap.fold (fun _ s _ -> fst (List.hd s)) m ""
+
+let match_bus g =
+ List.fold_left
+ (fun prev x ->
+ if (snd x) = "BusIn" then
+ let y = extract_singleton (gfils g (fst x)) in
+ let p = gparents g (fst x) in
+ let s = gfils g y in
+ let la =
+ Imap.fold
+ (fun i x0 prev2 ->
+ let sons = Imap.find i s in
+ List.fold_left
+ (fun prev3 y0 -> (x0, y0)::prev3)
+ prev2
+ sons
+ )
+ p
+ []
+ in
+ let ret = gajoutela prev la in
+ let ret = gdelete ret y in
+ let ret = gdelete ret (fst x) in
+ ret
+ else
+ prev
+ )
+ g
+ g.sommets
diff --git a/simul/compil.ml b/simul/compil.ml
index 992a3af..48e07a7 100644
--- a/simul/compil.ml
+++ b/simul/compil.ml
@@ -6,30 +6,7 @@
*)
open Loggenerator
open Scheme
-(************************************************************
- fonctions de graphe
-************************************************************)
-
-type ('a, 'b) graphe = {sommets : ('a * 'b) list; arretes : (('a * int) * ('a * int)) list}
-
-let gajoutes g s = {sommets = s::(g.sommets); arretes = g.arretes}
-
-let gajoutela g la = {sommets = g.sommets; arretes = la @ g.arretes}
-
-let gVide () = {sommets = []; arretes = []}
-
-let gEstVide g = g.sommets = []
-
-let gunion g h = {sommets = g.sommets @ h.sommets; arretes = g.arretes @ h.arretes} (*peut etre virer les arretes en dble*)
-
-let sprint_graphe_ss g =
- let ret = ref "Sommets (id, kind) :\n" in
- List.iter (fun x -> ret := !ret ^ (Printf.sprintf "%s %s\n" (fst x) (snd x))) g.sommets;
- ret := !ret ^ "Arretes (id1, n1), (id2, n2) :\n";
- List.iter (fun x -> ret := !ret ^ (Printf.sprintf "(%s, %d), (%s, %d)\n" (fst (fst x))) (snd (fst x)) (fst (snd x)) (snd (snd x))) g.arretes;
- !ret ^ "\n"
-let print_graphe_ss g =
- Printf.printf "%s" (sprint_graphe_ss g)
+open Graph
(*************************************************************
fonctions de circuit
@@ -48,114 +25,6 @@ let findSchema kind =
let estCircuit kind = Hashtbl.mem circuitsRegistred kind
-
-(****************************************************************
- fonctions de graphe (string, int)
-****************************************************************)
-
-(*une entrée n'est pas sensée se boucler dessus. idem pour une sortie*)
-(* fonction spécifique : pas propre aux graphes *)
-let gsubs g idA idN nN = (*FIXME : améliorable grace à des listes de trucs à remplacer*)
- let rec auxA acc = function
- |[] -> acc
- |(((i1, n1), (i2, n2))::t) when (i1 = idA) ->
- print_log_debug (Printf.sprintf "substitution avant : (%s %d) (%s %d) -> (%s %d) (%s %d)" i1 n1 i2 n2 idN nN i2 n2);
- auxA (((idN, nN), (i2, n2))::acc) t
- |(((i1, n1), (i2, n2))::t) when (i2 = idA) ->
- print_log_debug (Printf.sprintf "substitution arriere : (%s %d) (%s %d) -> (%s %d) (%s %d)" i1 n1 i2 n2 i1 n1 idN nN);
- auxA (((i1, n1), (idN, nN))::acc) t
- |(h::t) -> auxA (h::acc) t
- in
- {sommets = g.sommets; arretes = auxA [] g.arretes}
-
-let gadd g idA idN nN = (*comme gsubs, mais n'enleve pas*)
- let rec auxA acc = function
- |[] -> acc
- |(((i1, n1), (i2, n2))::t) when (i1 = idA) ->
- print_log_debug (Printf.sprintf "add avant : (%s %d) (%s %d) -> (%s %d) (%s %d)" i1 n1 i2 n2 idN nN i2 n2);
- auxA (((idN, nN), (i2, n2))::((i1, n1), (i2, n2))::acc) t
- |(((i1, n1), (i2, n2))::t) when (i2 = idA) ->
- print_log_debug (Printf.sprintf "add arriere : (%s %d) (%s %d) -> (%s %d) (%s %d)" i1 n1 i2 n2 i1 n1 idN nN);
- auxA (((i1, n1), (idN, nN))::((i1, n1), (i2, n2))::acc) t
- |(h::t) -> auxA (h::acc) t
- in
- {sommets = g.sommets; arretes = auxA [] g.arretes}
-
-let gremsom g iadel =
- let rec auxA acc = function
- |[] -> acc
- |((x, _)::t) when x = iadel ->
- print_log_debug (Printf.sprintf "supression du sommet %s" x);
- auxA acc t
- |(h::t) -> auxA (h::acc) t
- in
- {sommets = auxA [] g.sommets; arretes = g.arretes}
-
-let gdelete g iadel =
- let rec auxS acc = function
- |[] -> acc
- |(((i1, n1), (i2, n2))::t) when i1 = iadel ->
- print_log_debug (Printf.sprintf "suppression par pere : (%s %d) (%s %d)" i1 n1 i2 n2);
- auxS acc t
- |(((i1, n1), (i2, n2))::t) when i2 = iadel ->
- print_log_debug (Printf.sprintf "suppression par fils : (%s %d) (%s %d)" i1 n1 i2 n2);
- auxS acc t
- |(h::t) -> auxS (h::acc) t
- in
- let g = gremsom g iadel in
- {sommets = g.sommets; arretes = auxS [] g.arretes}
-
-let gpremsom g =
- let (s, t) = List.hd g.sommets in
- let rec aux arr acc = function
- |[] -> (arr, acc)
- |(((a, b), (c, d))::t) when (a = s) or (c = s)-> aux (((a, b), (c, d))::arr) acc t
- |(h::t) -> aux arr (h::acc) t
- in
- let (arEnlevees, arRestantes) = aux [] [] g.arretes in
- ((s, t), arEnlevees, {sommets = List.tl g.sommets; arretes = arRestantes})
-
-let gparents g p =
- let rec aux acc = function
- |[] -> acc
- |(((a, np), (b, nf))::t) when b = p -> aux (Imap.add nf (a, np) acc) t
- |(_::t) -> aux acc t
- in
- aux Imap.empty g.arretes
-
-let gfils g p =
- let rec aux acc = function
- |[] -> acc
- |(((i1, n1), (i2, n2))::t) when (i1 = p) && (Imap.mem n1 acc) -> aux (Imap.add n1 ((i2, n2)::(Imap.find n1 acc)) acc) t
- |(((i1, n1), (i2, n2))::t) when i1 = p -> aux (Imap.add n1 [(i2, n2)] acc) t
- |(a::t) -> aux acc t
- in
- aux Imap.empty g.arretes
-
-let gfilslist g a =
- let rec aux = function
- |[] -> []
- |(((i1, n1), (i2, n2))::t) when i1 = a -> (n1, (i2, n2))::(aux t)
- |(_::t) -> aux t
- in
- aux g.arretes
-
-let gparentslist g a =
- List.rev (Imap.fold (fun n2 (i1, n1) ret -> (i1, n1)::ret) (gparents g a) [])
-
-let gprefixe g pref =
- let rec auxS acc = function
- |[] -> acc
- |((i, k)::t) -> auxS ((pref^i, k)::acc) t
- in
- let rec auxA acc = function
- |[] -> acc
- |(((a, b), (c, d))::t) -> auxA ((((pref^a), b), ((pref^c), d))::acc) t
- in
- {sommets = auxS [] g.sommets; arretes = auxA [] g.arretes}
-
-
-
(***********************************************************
fonction de creation du graphe
***********************************************************)
diff --git a/simul/graph.ml b/simul/graph.ml
new file mode 100644
index 0000000..6c832b3
--- /dev/null
+++ b/simul/graph.ml
@@ -0,0 +1,170 @@
+open Loggenerator
+open Scheme
+
+(************************************************************
+ fonctions de graphe generique
+************************************************************)
+
+type ('a, 'b) graphe = {sommets : ('a * 'b) list; arretes : (('a * int) * ('a * int)) list}
+
+let gajoutes g s = {sommets = s::(g.sommets); arretes = g.arretes}
+
+let gajoutela g la = {sommets = g.sommets; arretes = la @ g.arretes}
+
+let gVide () = {sommets = []; arretes = []}
+
+let gEstVide g = g.sommets = []
+
+let gunion g h = {sommets = g.sommets @ h.sommets; arretes = g.arretes @ h.arretes} (*peut etre virer les arretes en dble*)
+
+let sprint_graphe_ss g =
+ let ret = ref "Sommets (id, kind) :\n" in
+ List.iter
+ (fun x -> ret := !ret ^ (Printf.sprintf "%s %s\n" (fst x) (snd x)))
+ g.sommets;
+ ret := !ret ^ "Arretes (id1, n1), (id2, n2) :\n";
+ List.iter
+ (fun x ->
+ ret := !ret ^
+ (Printf.sprintf
+ "(%s, %d), (%s, %d)\n"
+ (fst (fst x))
+ (snd (fst x))
+ (fst (snd x))
+ (snd (snd x)))
+ )
+ g.arretes;
+ !ret ^ "\n"
+let print_graphe_ss g =
+ Printf.printf "%s" (sprint_graphe_ss g)
+
+(****************************************************************
+ fonctions de graphe (string, int)
+****************************************************************)
+
+(*une entrée n'est pas sensée se boucler dessus. idem pour une sortie*)
+(* fonction spécifique : pas propre aux graphes *)
+let gsubs g idA idN nN = (*FIXME : améliorable grace à des listes de trucs à remplacer*)
+ let rec auxA acc = function
+ |[] -> acc
+ |(((i1, n1), (i2, n2))::t) when (i1 = idA) ->
+ print_log_debug
+ (Printf.sprintf
+ "substitution avant : (%s %d) (%s %d) -> (%s %d) (%s %d)"
+ i1 n1 i2 n2 idN nN i2 n2
+ );
+ auxA (((idN, nN), (i2, n2))::acc) t
+ |(((i1, n1), (i2, n2))::t) when (i2 = idA) ->
+ print_log_debug
+ (Printf.sprintf
+ "substitution arriere : (%s %d) (%s %d) -> (%s %d) (%s %d)"
+ i1 n1 i2 n2 i1 n1 idN nN
+ );
+ auxA (((i1, n1), (idN, nN))::acc) t
+ |(h::t) -> auxA (h::acc) t
+ in
+ {sommets = g.sommets; arretes = auxA [] g.arretes}
+
+let gadd g idA idN nN = (*comme gsubs, mais n'enleve pas*)
+ let rec auxA acc = function
+ |[] -> acc
+ |(((i1, n1), (i2, n2))::t) when (i1 = idA) ->
+ print_log_debug
+ (Printf.sprintf
+ "add avant : (%s %d) (%s %d) -> (%s %d) (%s %d)"
+ i1 n1 i2 n2 idN nN i2 n2
+ );
+ auxA (((idN, nN), (i2, n2))::((i1, n1), (i2, n2))::acc) t
+ |(((i1, n1), (i2, n2))::t) when (i2 = idA) ->
+ print_log_debug
+ (Printf.sprintf
+ "add arriere : (%s %d) (%s %d) -> (%s %d) (%s %d)"
+ i1 n1 i2 n2 i1 n1 idN nN
+ );
+ auxA (((i1, n1), (idN, nN))::((i1, n1), (i2, n2))::acc) t
+ |(h::t) -> auxA (h::acc) t
+ in
+ {sommets = g.sommets; arretes = auxA [] g.arretes}
+
+let gremsom g iadel =
+ let rec auxA acc = function
+ |[] -> acc
+ |((x, _)::t) when x = iadel ->
+ print_log_debug (Printf.sprintf "supression du sommet %s" x);
+ auxA acc t
+ |(h::t) -> auxA (h::acc) t
+ in
+ {sommets = auxA [] g.sommets; arretes = g.arretes}
+
+let gdelete g iadel =
+ let rec auxS acc = function
+ |[] -> acc
+ |(((i1, n1), (i2, n2))::t) when i1 = iadel ->
+ print_log_debug
+ (Printf.sprintf "suppression par pere : (%s %d) (%s %d)" i1 n1 i2 n2);
+ auxS acc t
+ |(((i1, n1), (i2, n2))::t) when i2 = iadel ->
+ print_log_debug
+ (Printf.sprintf "suppression par fils : (%s %d) (%s %d)" i1 n1 i2 n2);
+ auxS acc t
+ |(h::t) -> auxS (h::acc) t
+ in
+ let g = gremsom g iadel in
+ {sommets = g.sommets; arretes = auxS [] g.arretes}
+
+let gpremsom g =
+ let (s, t) = List.hd g.sommets in
+ let rec aux arr acc = function
+ |[] ->
+ (arr, acc)
+ |(((a, b), (c, d))::t) when (a = s) or (c = s)->
+ aux (((a, b), (c, d))::arr) acc t
+ |(h::t) ->
+ aux arr (h::acc) t
+ in
+ let (arEnlevees, arRestantes) = aux [] [] g.arretes in
+ ((s, t), arEnlevees, {sommets = List.tl g.sommets; arretes = arRestantes})
+
+let gparents g p =
+ let rec aux acc = function
+ |[] -> acc
+ |(((a, np), (b, nf))::t) when b = p -> aux (Imap.add nf (a, np) acc) t
+ |(_::t) -> aux acc t
+ in
+ aux Imap.empty g.arretes
+
+let gfils g p =
+ let rec aux acc = function
+ |[] ->
+ acc
+ |(((i1, n1), (i2, n2))::t) when (i1 = p) && (Imap.mem n1 acc) ->
+ aux (Imap.add n1 ((i2, n2)::(Imap.find n1 acc)) acc) t
+ |(((i1, n1), (i2, n2))::t) when i1 = p ->
+ aux (Imap.add n1 [(i2, n2)] acc) t
+ |(a::t) -> aux acc t
+ in
+ aux Imap.empty g.arretes
+
+let gfilslist g a =
+ let rec aux = function
+ |[] -> []
+ |(((i1, n1), (i2, n2))::t) when i1 = a -> (n1, (i2, n2))::(aux t)
+ |(_::t) -> aux t
+ in
+ aux g.arretes
+
+let gparentslist g a =
+ List.rev (Imap.fold (fun n2 (i1, n1) ret -> (i1, n1)::ret) (gparents g a) [])
+
+let gprefixe g pref =
+ let rec auxS acc = function
+ |[] -> acc
+ |((i, k)::t) -> auxS ((pref^i, k)::acc) t
+ in
+ let rec auxA acc = function
+ |[] -> acc
+ |(((a, b), (c, d))::t) -> auxA ((((pref^a), b), ((pref^c), d))::acc) t
+ in
+ {sommets = auxS [] g.sommets; arretes = auxA [] g.arretes}
+
+
diff --git a/simul/main.ml b/simul/main.ml
index 4c9a243..a772c69 100644
--- a/simul/main.ml
+++ b/simul/main.ml
@@ -27,37 +27,35 @@ let _ =
try
let pathfile = open_in pathfilename in
let paths = LexerPaths.read pathfile in
-
- Hashtbl.iter (fun path _ ->
- print_log ("Path : " ^ path);
- let files = Sys.readdir path in
- for i = 0 to Array.length files - 1 do
- if estXNL files.(i) then begin
- Compil.regCircuit (Reader.parse_file (path ^ files.(i)));
- print_log ("Loaded : " ^ path ^ files.(i))
- end
- done
- ) paths;
- let nameCircuit = ref "" in
- Arg.parse opts (fun str -> nameCircuit := str) "";
- if !nameCircuit = "" then
- failwith "Argument manquant : nom du circuit à compiler.";
- let schMain = Compil.findSchema (!nameCircuit) in
- let schMain2 = delesscheme schMain in
- Printf.fprintf stderr "Compilation : %f\n" (Sys.time());
- let t = Compil.completeGraphe
- schMain2 ""
- Imap.empty
- Imap.empty in
- Printf.fprintf stderr "Tritopo %f\n" (Sys.time());
- let t = Compil.triTopo t in
- Printf.fprintf stderr "Fin %f\n" (Sys.time());
- Compil.cbGenereCode
- t
- (simap_to_ismap schMain.entrees)
- (simap_to_ismap schMain.sorties)
- !nameGen
- !audit;
+
+ Hashtbl.iter (fun path _ ->
+ print_log ("Path : " ^ path);
+ let files = Sys.readdir path in
+ for i = 0 to Array.length files - 1 do
+ if estXNL files.(i) then begin
+ Compil.regCircuit (Reader.parse_file (path ^ files.(i)));
+ print_log ("Loaded : " ^ path ^ files.(i))
+ end
+ done
+ ) paths;
+ let nameCircuit = ref "" in
+ Arg.parse opts (fun str -> nameCircuit := str) "";
+ if !nameCircuit = "" then
+ failwith "Argument manquant : nom du circuit à compiler.";
+ let schMain = Compil.findSchema (!nameCircuit) in
+ let schMain2 = delesscheme schMain in
+ Printf.fprintf stderr "Compilation : %f\n" (Sys.time());
+ let t = Compil.completeGraphe schMain2 "" Imap.empty Imap.empty in
+ let t = Bus.match_bus t in
+ Printf.fprintf stderr "Tritopo %f\n" (Sys.time());
+ let t = Compil.triTopo t in
+ Printf.fprintf stderr "Fin %f\n" (Sys.time());
+ Compil.cbGenereCode
+ t
+ (simap_to_ismap schMain.entrees)
+ (simap_to_ismap schMain.sorties)
+ !nameGen
+ !audit;
with
|a -> print_logs (); raise a
diff --git a/simul/paths b/simul/paths
index a5b5d11..6812ee0 100644
--- a/simul/paths
+++ b/simul/paths
@@ -1,2 +1,2 @@
./
-../components/
+../components/ \ No newline at end of file