summaryrefslogtreecommitdiff
path: root/tp1/graph.ml
diff options
context:
space:
mode:
authorAlex AUVOLAT <alex.auvolat@ens.fr>2013-10-31 15:35:11 +0100
committerAlex AUVOLAT <alex.auvolat@ens.fr>2013-10-31 15:35:11 +0100
commit0b269f32dd9b8d349f94793dad44e728473e9f0a (patch)
tree066a30fee1efe19d897f5e153d7ea9aa3d7448af /tp1/graph.ml
downloadSystDigit-Projet-0b269f32dd9b8d349f94793dad44e728473e9f0a.tar.gz
SystDigit-Projet-0b269f32dd9b8d349f94793dad44e728473e9f0a.zip
First commit ; includes first TP and minijazz compiler
Diffstat (limited to 'tp1/graph.ml')
-rw-r--r--tp1/graph.ml61
1 files changed, 61 insertions, 0 deletions
diff --git a/tp1/graph.ml b/tp1/graph.ml
new file mode 100644
index 0000000..54128ff
--- /dev/null
+++ b/tp1/graph.ml
@@ -0,0 +1,61 @@
+exception Cycle
+type mark = NotVisited | InProgress | Visited
+
+type 'a graph =
+ { mutable g_nodes : 'a node list }
+and 'a node = {
+ n_label : 'a;
+ mutable n_mark : mark;
+ mutable n_link_to : 'a node list;
+ mutable n_linked_by : 'a node list;
+}
+
+let mk_graph () = { g_nodes = [] }
+
+let add_node g x =
+ let n = { n_label = x; n_mark = NotVisited; n_link_to = []; n_linked_by = [] } in
+ g.g_nodes <- n::g.g_nodes
+
+let node_for_label g x =
+ List.find (fun n -> n.n_label = x) g.g_nodes
+
+let add_edge g id1 id2 =
+ let n1 = node_for_label g id1 in
+ let n2 = node_for_label g id2 in
+ n1.n_link_to <- n2::n1.n_link_to;
+ n2.n_linked_by <- n1::n2.n_linked_by
+
+let clear_marks g =
+ List.iter (fun n -> n.n_mark <- NotVisited) g.g_nodes
+
+let find_roots g =
+ List.filter (fun n -> n.n_linked_by = []) g.g_nodes
+
+let has_cycle g =
+ clear_marks g;
+ let rec visit n =
+ match n.n_mark with
+ | InProgress -> true
+ | Visited -> false
+ | NotVisited ->
+ n.n_mark <- InProgress;
+ let ret = List.fold_left (fun x n -> x || (visit n)) false n.n_link_to in
+ n.n_mark <- Visited;
+ 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;;
+
+let topological g =
+ 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 n) [] g.g_nodes
+ in clear_marks g; List.rev ret;;
+