summaryrefslogtreecommitdiff
path: root/simul/compil.ml
diff options
context:
space:
mode:
Diffstat (limited to 'simul/compil.ml')
-rw-r--r--simul/compil.ml133
1 files changed, 1 insertions, 132 deletions
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
***********************************************************)