Commit ffb7f762 authored by bguillaum's avatar bguillaum
Browse files

cosmetic changes

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8337 7838e531-6607-4d57-9587-6c381814729c
parent 5d3bf2f2
...@@ -83,17 +83,17 @@ module P_graph = struct ...@@ -83,17 +83,17 @@ module P_graph = struct
let (map : t) = let (map : t) =
List.fold_left List.fold_left
(fun acc (ast_edge, loc) -> (fun acc (ast_edge, loc) ->
let i1 = Id.build ~loc ast_edge.Ast.src pos_table in let i1 = Id.build ~loc ast_edge.Ast.src pos_table in
let i2 = Id.build ~loc ast_edge.Ast.tar pos_table in let i2 = Id.build ~loc ast_edge.Ast.tar pos_table in
let edge = P_edge.build ~locals (ast_edge, loc) in let edge = P_edge.build ~locals (ast_edge, loc) in
(match map_add_edge acc (Pid.Pos i1) edge (Pid.Pos i2) with (match map_add_edge acc (Pid.Pos i1) edge (Pid.Pos i2) with
| Some g -> g | Some g -> g
| None -> Error.build "[GRS] [Graph.build] try to build a graph with twice the same edge %s %s" | None -> Error.build "[GRS] [Graph.build] try to build a graph with twice the same edge %s %s"
(P_edge.to_string edge) (P_edge.to_string edge)
(Loc.to_string loc) (Loc.to_string loc)
) )
) map_without_edges full_edge_list in ) map_without_edges full_edge_list in
(map, pos_table) (map, pos_table)
...@@ -125,34 +125,34 @@ module P_graph = struct ...@@ -125,34 +125,34 @@ module P_graph = struct
(* the nodes, in the same order stored with index -1, -2, ... -N *) (* the nodes, in the same order stored with index -1, -2, ... -N *)
let ext_map_without_edges = let ext_map_without_edges =
List_.foldi_left List_.foldi_left
(fun i acc elt -> Pid_map.add (Pid.Neg i) elt acc) (fun i acc elt -> Pid_map.add (Pid.Neg i) elt acc)
Pid_map.empty Pid_map.empty
new_node_list in new_node_list in
let old_map_without_edges = let old_map_without_edges =
List.fold_left List.fold_left
(fun acc (id,node) -> Pid_map.add (Pid.Pos (Array_.dicho_find id pos_table)) node acc) (fun acc (id,node) -> Pid_map.add (Pid.Pos (Array_.dicho_find id pos_table)) node acc)
Pid_map.empty Pid_map.empty
old_nodes in old_nodes in
let ext_map_with_all_edges = let ext_map_with_all_edges =
List.fold_left List.fold_left
(fun acc (ast_edge, loc) -> (fun acc (ast_edge, loc) ->
let src = ast_edge.Ast.src let src = ast_edge.Ast.src
and tar = ast_edge.Ast.tar in and tar = ast_edge.Ast.tar in
let i1 = let i1 =
match Id.build_opt src pos_table with match Id.build_opt src pos_table with
| Some i -> Pid.Pos i | Some i -> Pid.Pos i
| None -> Pid.Neg (Id.build ~loc src new_table) in | None -> Pid.Neg (Id.build ~loc src new_table) in
let i2 = let i2 =
match Id.build_opt tar pos_table with match Id.build_opt tar pos_table with
| Some i -> Pid.Pos i | Some i -> Pid.Pos i
| None -> Pid.Neg (Id.build ~loc tar new_table) in | None -> Pid.Neg (Id.build ~loc tar new_table) in
let edge = P_edge.build ~locals (ast_edge, loc) in let edge = P_edge.build ~locals (ast_edge, loc) in
match map_add_edge acc i1 edge i2 with match map_add_edge acc i1 edge i2 with
| Some map -> map | Some map -> map
| None -> Log.fbug "[GRS] [Graph.build_extension] add_edge cannot fail in pattern extension (1)"; exit 2 | None -> Log.fbug "[GRS] [Graph.build_extension] add_edge cannot fail in pattern extension (1)"; exit 2
) ext_map_without_edges full_edge_list in ) ext_map_without_edges full_edge_list in
({ext_map = ext_map_with_all_edges; old_map = old_map_without_edges}, new_table) ({ext_map = ext_map_with_all_edges; old_map = old_map_without_edges}, new_table)
(* [tree_and_roots t] returns: (* [tree_and_roots t] returns:
...@@ -162,25 +162,25 @@ module P_graph = struct ...@@ -162,25 +162,25 @@ module P_graph = struct
let tree_prop = ref true in let tree_prop = ref true in
let not_root = let not_root =
Pid_map.fold Pid_map.fold
(fun _ node acc -> (fun _ node acc ->
Massoc_pid.fold Massoc_pid.fold
(fun acc2 tar _ -> (fun acc2 tar _ ->
if !tree_prop if !tree_prop
then then
if Pid_set.mem tar acc2 if Pid_set.mem tar acc2
then (tree_prop := false; acc2) then (tree_prop := false; acc2)
else Pid_set.add tar acc2 else Pid_set.add tar acc2
else Pid_set.add tar acc2 else Pid_set.add tar acc2
) acc (P_node.get_next node) ) acc (P_node.get_next node)
) graph Pid_set.empty in ) graph Pid_set.empty in
let roots = let roots =
Pid_map.fold Pid_map.fold
(fun id _ acc -> (fun id _ acc ->
if Pid_set.mem id not_root if Pid_set.mem id not_root
then acc then acc
else id::acc else id::acc
) graph [] in ) graph [] in
(!tree_prop, roots) (!tree_prop, roots)
...@@ -213,7 +213,6 @@ module G_deco = struct ...@@ -213,7 +213,6 @@ module G_deco = struct
(G_edge.to_string edge) (G_edge.to_string edge)
(Gid.to_string tar) (Gid.to_string tar)
) t.edges ) t.edges
end (* module G_deco *) end (* module G_deco *)
(* ==================================================================================================== *) (* ==================================================================================================== *)
...@@ -320,17 +319,17 @@ module G_graph = struct ...@@ -320,17 +319,17 @@ module G_graph = struct
let map = let map =
List.fold_left List.fold_left
(fun acc (ast_edge, loc) -> (fun acc (ast_edge, loc) ->
let i1 = Id.build ~loc ast_edge.Ast.src table in let i1 = Id.build ~loc ast_edge.Ast.src table in
let i2 = Id.build ~loc ast_edge.Ast.tar table in let i2 = Id.build ~loc ast_edge.Ast.tar table in
let edge = G_edge.build ~locals (ast_edge, loc) in let edge = G_edge.build ~locals (ast_edge, loc) in
(match map_add_edge acc (Gid.Old i1) edge (Gid.Old i2) with (match map_add_edge acc (Gid.Old i1) edge (Gid.Old i2) with
| Some g -> g | Some g -> g
| None -> Error.build "[GRS] [Graph.build] try to build a graph with twice the same edge %s %s" | None -> Error.build "[GRS] [Graph.build] try to build a graph with twice the same edge %s %s"
(G_edge.to_string edge) (G_edge.to_string edge)
(Loc.to_string loc) (Loc.to_string loc)
) )
) map_without_edges full_edge_list in ) map_without_edges full_edge_list in
{meta=gr_ast.Ast.meta; map=map} {meta=gr_ast.Ast.meta; map=map}
...@@ -357,11 +356,11 @@ module G_graph = struct ...@@ -357,11 +356,11 @@ module G_graph = struct
let gov_id = Id.build ?loc gov table in let gov_id = Id.build ?loc gov table in
let edge = G_edge.make ?loc dep_lab in let edge = G_edge.make ?loc dep_lab in
(match map_add_edge acc2 (Gid.Old gov_id) edge (Gid.Old dep_id) with (match map_add_edge acc2 (Gid.Old gov_id) edge (Gid.Old dep_id) with
| Some g -> g | Some g -> g
| None -> Error.build "[GRS] [Graph.of_conll] try to build a graph with twice the same edge %s %s" | None -> Error.build "[GRS] [Graph.of_conll] try to build a graph with twice the same edge %s %s"
(G_edge.to_string edge) (G_edge.to_string edge)
(match loc with Some l -> Loc.to_string l | None -> "") (match loc with Some l -> Loc.to_string l | None -> "")
) )
) acc line.Conll.deps ) acc line.Conll.deps
) map_without_edges lines in ) map_without_edges lines in
{meta=[]; map=map_with_edges} {meta=[]; map=map_with_edges}
...@@ -444,9 +443,9 @@ module G_graph = struct ...@@ -444,9 +443,9 @@ module G_graph = struct
{graph with map = {graph with map =
Gid_map.fold Gid_map.fold
(fun id value acc -> (fun id value acc ->
if id = node_id if id = node_id
then acc then acc
else Gid_map.add id (G_node.remove_key node_id value) acc else Gid_map.add id (G_node.remove_key node_id value) acc
) graph.map Gid_map.empty ) graph.map Gid_map.empty
} }
...@@ -499,15 +498,15 @@ module G_graph = struct ...@@ -499,15 +498,15 @@ module G_graph = struct
{graph with map = {graph with map =
Gid_map.mapi Gid_map.mapi
(fun node_id node -> (fun node_id node ->
if node_id = src_gid if node_id = src_gid
then (* [src_id] becomes without out-edges *) then (* [src_id] becomes without out-edges *)
G_node.rm_out_edges node G_node.rm_out_edges node
else if node_id = tar_gid else if node_id = tar_gid
then then
match G_node.shift_out src_node tar_node with match G_node.shift_out src_node tar_node with
| Some n -> n | Some n -> n
| None -> Error.run ~loc "[Graph.shift_out] common successor" | None -> Error.run ~loc "[Graph.shift_out] common successor"
else node (* other nodes don't change *) else node (* other nodes don't change *)
) graph.map ) graph.map
} }
...@@ -527,15 +526,15 @@ module G_graph = struct ...@@ -527,15 +526,15 @@ module G_graph = struct
let new_map = let new_map =
Gid_map.mapi Gid_map.mapi
(fun node_id node -> (fun node_id node ->
if node_id = src_gid if node_id = src_gid
then (* [src_id] becomes an isolated node *) then (* [src_id] becomes an isolated node *)
G_node.rm_out_edges node G_node.rm_out_edges node
else if node_id = tar_gid else if node_id = tar_gid
then then
match G_node.shift_out src_node tar_node with match G_node.shift_out src_node tar_node with
| Some n -> n | Some n -> n
| None -> Error.run ~loc "[Graph.shift_edges] common successor" | None -> Error.run ~loc "[Graph.shift_edges] common successor"
else else
match G_node.merge_key src_gid tar_gid node with match G_node.merge_key src_gid tar_gid node with
| Some n -> n | Some n -> n
| None -> Error.run ~loc "[Graph.shift_edges] create duplicate edge" | None -> Error.run ~loc "[Graph.shift_edges] create duplicate edge"
...@@ -553,9 +552,9 @@ module G_graph = struct ...@@ -553,9 +552,9 @@ module G_graph = struct
| Some new_fs -> | Some new_fs ->
Some {graph with map = Some {graph with map =
(Gid_map.add (Gid_map.add
tar_gid tar_gid
(G_node.set_fs tar_node new_fs) (G_node.set_fs tar_node new_fs)
(Gid_map.remove src_gid se_graph.map) (Gid_map.remove src_gid se_graph.map)
) )
} }
| None -> None | None -> None
...@@ -626,10 +625,10 @@ module G_graph = struct ...@@ -626,10 +625,10 @@ module G_graph = struct
(* edges *) (* edges *)
List.iter List.iter
(fun (id,node) -> (fun (id,node) ->
Massoc_gid.iter Massoc_gid.iter
(fun tar edge -> (fun tar edge ->
bprintf buff " N_%s -[%s]-> N_%s;\n" (Gid.to_string id) (G_edge.to_string edge) (Gid.to_string tar) bprintf buff " N_%s -[%s]-> N_%s;\n" (Gid.to_string id) (G_edge.to_string edge) (Gid.to_string tar)
) (G_node.get_next node) ) (G_node.get_next node)
) sorted_nodes; ) sorted_nodes;
bprintf buff "}\n"; bprintf buff "}\n";
...@@ -679,7 +678,7 @@ module G_graph = struct ...@@ -679,7 +678,7 @@ module G_graph = struct
let style = match G_fs.get_string_atom "void" fs with let style = match G_fs.get_string_atom "void" fs with
| Some "y" -> "; forecolor=red; subcolor=red; " | Some "y" -> "; forecolor=red; subcolor=red; "
| _ -> "" in | _ -> "" in
bprintf buff "N_%s { %s%s }\n" (Gid.to_string id) dep_fs style bprintf buff "N_%s { %s%s }\n" (Gid.to_string id) dep_fs style
) snodes; ) snodes;
bprintf buff "} \n"; bprintf buff "} \n";
...@@ -687,11 +686,11 @@ module G_graph = struct ...@@ -687,11 +686,11 @@ module G_graph = struct
bprintf buff "[EDGES] { \n"; bprintf buff "[EDGES] { \n";
Gid_map.iter Gid_map.iter
(fun gid elt -> (fun gid elt ->
Massoc_gid.iter Massoc_gid.iter
(fun tar g_edge -> (fun tar g_edge ->
let deco = List.mem (gid,g_edge,tar) deco.G_deco.edges in let deco = List.mem (gid,g_edge,tar) deco.G_deco.edges in
bprintf buff "N_%s -> N_%s %s\n" (Gid.to_string gid) (Gid.to_string tar) (G_edge.to_dep ~deco g_edge) bprintf buff "N_%s -> N_%s %s\n" (Gid.to_string gid) (Gid.to_string tar) (G_edge.to_dep ~deco g_edge)
) (G_node.get_next elt) ) (G_node.get_next elt)
) graph.map; ) graph.map;
bprintf buff "} \n"; bprintf buff "} \n";
...@@ -712,11 +711,11 @@ module G_graph = struct ...@@ -712,11 +711,11 @@ module G_graph = struct
(* nodes *) (* nodes *)
Gid_map.iter Gid_map.iter
(fun id node -> (fun id node ->
let decorated_feat = let decorated_feat =
try List.assoc id deco.G_deco.nodes try List.assoc id deco.G_deco.nodes
with Not_found -> ("",[]) in with Not_found -> ("",[]) in
bprintf buff " N_%s [label=<%s>, color=%s]\n" bprintf buff " N_%s [label=<%s>, color=%s]\n"
(Gid.to_string id) (Gid.to_string id)
(G_fs.to_dot ~decorated_feat ?main_feat (G_node.get_fs node)) (G_fs.to_dot ~decorated_feat ?main_feat (G_node.get_fs node))
(* TODO: add bgcolor in dot output *) (* TODO: add bgcolor in dot output *)
(if List.mem_assoc id deco.G_deco.nodes then "red" else "black") (if List.mem_assoc id deco.G_deco.nodes then "red" else "black")
...@@ -725,11 +724,11 @@ module G_graph = struct ...@@ -725,11 +724,11 @@ module G_graph = struct
(* edges *) (* edges *)
Gid_map.iter Gid_map.iter
(fun id node -> (fun id node ->
Massoc_gid.iter Massoc_gid.iter
(fun tar g_edge -> (fun tar g_edge ->
let deco = List.mem (id,g_edge,tar) deco.G_deco.edges in let deco = List.mem (id,g_edge,tar) deco.G_deco.edges in
bprintf buff " N_%s -> N_%s%s\n" (Gid.to_string id) (Gid.to_string tar) (G_edge.to_dot ~deco g_edge) bprintf buff " N_%s -> N_%s%s\n" (Gid.to_string id) (Gid.to_string tar) (G_edge.to_dot ~deco g_edge)
) (G_node.get_next node) ) (G_node.get_next node)
) graph.map; ) graph.map;
bprintf buff "}\n"; bprintf buff "}\n";
...@@ -813,6 +812,4 @@ module G_graph = struct ...@@ -813,6 +812,4 @@ module G_graph = struct
) )
snodes; snodes;
Buffer.contents buff Buffer.contents buff
end (* module G_graph *) end (* module G_graph *)
(* ================================================================================ *)
...@@ -56,7 +56,7 @@ module Instance = struct ...@@ -56,7 +56,7 @@ module Instance = struct
{ empty with graph = G_graph.rename mapping t.graph; free_index = new_free } { empty with graph = G_graph.rename mapping t.graph; free_index = new_free }
(* comparison is done on the list of commands *) (* comparison is done on the list of commands *)
(* only graph rewrited from the same init graph can be "compared" *) (* only graph rewritten from the same init graph can be "compared" *)
let compare t1 t2 = Pervasives.compare t1.history t2.history let compare t1 t2 = Pervasives.compare t1.history t2.history
let to_gr t = G_graph.to_gr t.graph let to_gr t = G_graph.to_gr t.graph
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment