Commit 971d5500 authored by bguillaum's avatar bguillaum

move from 'int' to 'Gid.t'/'Pid.t'... it compiles

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@7419 7838e531-6607-4d57-9587-6c381814729c
parent c00c6e36
*.cmo
*.cmi
*.o
*.cmx
*.annot
*.a
*.cma
*.cmxa
Makefile
confdefs.h
config.log
config.status
# file generated by the Makefile !
libgrew.mli
...@@ -7,8 +7,8 @@ open Grew_edge ...@@ -7,8 +7,8 @@ open Grew_edge
open Grew_fs open Grew_fs
module Command = struct module Command = struct
type pid = int (* the int in the pattern *) type pid = Pid.t
type gid = int (* the int in the graph *) type gid = Gid.t
type cnode = (* a command node is either: *) type cnode = (* a command node is either: *)
| Pid of pid (* a node identified in the pattern *) | Pid of pid (* a node identified in the pattern *)
......
...@@ -3,8 +3,8 @@ open Grew_utils ...@@ -3,8 +3,8 @@ open Grew_utils
open Grew_edge open Grew_edge
module Command : sig module Command : sig
type pid = int (* the int in the pattern *) type pid = Pid.t
type gid = int (* the int in the graph *) type gid = Gid.t
type cnode = (* a command node is either: *) type cnode = (* a command node is either: *)
| Pid of pid (* a node identified in the pattern *) | Pid of pid (* a node identified in the pattern *)
......
...@@ -10,16 +10,26 @@ open Grew_command ...@@ -10,16 +10,26 @@ open Grew_command
(* ================================================================================ *) (* ================================================================================ *)
module Deco = struct module P_deco = struct
type t = type t =
{ nodes: int list; { nodes: Pid.t list;
edges: (int * G_edge.t * int) list; edges: (Pid.t * P_edge.t * Pid.t) list;
} }
let empty = {nodes=[]; edges=[]} let empty = {nodes=[]; edges=[]}
end end
(* ================================================================================ *) (* ================================================================================ *)
(* ================================================================================ *)
module G_deco = struct
type t =
{ nodes: Gid.t list;
edges: (Gid.t * G_edge.t * Gid.t) list;
}
let empty = {nodes=[]; edges=[]}
end
(* ================================================================================ *)
(* ================================================================================ *) (* ================================================================================ *)
module P_graph = struct module P_graph = struct
...@@ -29,19 +39,19 @@ module P_graph = struct ...@@ -29,19 +39,19 @@ module P_graph = struct
let find = Pid_map.find let find = Pid_map.find
let map_add_edge map id_src label id_tar = let map_add_edge map id_src label id_tar =
let node_src = let node_src =
(* Not found can be raised when adding an edge from pos to neg *) (* Not found can be raised when adding an edge from pos to neg *)
try Pid_map.find id_src map with Not_found -> P_node.empty in try Pid_map.find id_src map with Not_found -> P_node.empty in
match P_node.add_edge label id_tar node_src with match P_node.add_edge label id_tar node_src with
| None -> None | None -> None
| Some new_node -> Some (Pid_map.add id_src new_node map) | Some new_node -> Some (Pid_map.add id_src new_node map)
let build_filter table (ast_node, loc) = let build_filter table (ast_node, loc) =
let pid = Id.build ~loc ast_node.Ast.node_id table in let pid = Id.build ~loc ast_node.Ast.node_id table in
let fs = P_fs.build ast_node.Ast.fs in let fs = P_fs.build ast_node.Ast.fs in
(pid, fs) (pid, fs)
let build ?pat_vars ?(locals=[||]) (full_node_list : Ast.node list) full_edge_list = let build ?pat_vars ?(locals=[||]) (full_node_list : Ast.node list) full_edge_list =
(* let (named_nodes, constraints) = *) (* let (named_nodes, constraints) = *)
(* let rec loop already_bound = function *) (* let rec loop already_bound = function *)
(* | [] -> ([],[]) *) (* | [] -> ([],[]) *)
...@@ -58,7 +68,7 @@ module P_graph = struct ...@@ -58,7 +68,7 @@ module P_graph = struct
(n, P_node.unif_fs (P_fs.build ?pat_vars ast_node.Ast.fs) h) :: t (n, P_node.unif_fs (P_fs.build ?pat_vars ast_node.Ast.fs) h) :: t
| h::t -> h :: (insert (ast_node, loc) t) in | h::t -> h :: (insert (ast_node, loc) t) in
let (named_nodes : (Id.name * P_node.t) list) = let (named_nodes : (Id.name * P_node.t) list) =
let rec loop = function let rec loop = function
| [] -> [] | [] -> []
| ast_node :: tail -> | ast_node :: tail ->
...@@ -75,10 +85,10 @@ module P_graph = struct ...@@ -75,10 +85,10 @@ module P_graph = struct
(* table contains the sorted list of node ids *) (* table contains the sorted list of node ids *)
let table = Array.of_list sorted_ids in let table = Array.of_list sorted_ids in
(* the nodes, in the same order *) (* the nodes, in the same order *)
let map_without_edges = List_.foldi_left (fun i acc elt -> Pid_map.add i elt acc) Pid_map.empty node_list in let map_without_edges = List_.foldi_left (fun i acc elt -> Pid_map.add i elt acc) Pid_map.empty node_list in
let (map : t) = let (map : t) =
List.fold_left List.fold_left
(fun acc (ast_edge, loc) -> (fun acc (ast_edge, loc) ->
...@@ -87,7 +97,7 @@ module P_graph = struct ...@@ -87,7 +97,7 @@ module P_graph = struct
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 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)
) )
...@@ -96,19 +106,19 @@ module P_graph = struct ...@@ -96,19 +106,19 @@ module P_graph = struct
(* a type for extension of graph: a former graph exists: (* a type for extension of graph: a former graph exists:
in grew the former is a positive pattern and an extension is a "without" *) in grew the former is a positive pattern and an extension is a "without" *)
type extension = { type extension = {
ext_map: P_node.t Pid_map.t; (* node description for new nodes and for edge "Old -> New" *) ext_map: P_node.t Pid_map.t; (* node description for new nodes and for edge "Old -> New" *)
old_map: P_node.t Pid_map.t; (* a partial map for new constraints on old nodes "Old [...]" *) old_map: P_node.t Pid_map.t; (* a partial map for new constraints on old nodes "Old [...]" *)
} }
let build_extension ?(locals=[||]) old_table full_node_list full_edge_list = let build_extension ?(locals=[||]) old_table full_node_list full_edge_list =
let built_nodes = List.map P_node.build full_node_list in let built_nodes = List.map P_node.build full_node_list in
let (old_nodes, new_nodes) = let (old_nodes, new_nodes) =
List.partition List.partition
(function (id,_) when Array_.dicho_mem id old_table -> true | _ -> false) (function (id,_) when Array_.dicho_mem id old_table -> true | _ -> false)
built_nodes in built_nodes in
...@@ -118,53 +128,53 @@ module P_graph = struct ...@@ -118,53 +128,53 @@ module P_graph = struct
(* table contains the sorted list of node ids *) (* table contains the sorted list of node ids *)
let new_table = Array.of_list new_sorted_ids in let new_table = Array.of_list new_sorted_ids in
(* 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 (-i-1) elt acc) (fun i acc elt -> Pid_map.add (-i-1) 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 (Array_.dicho_find id old_table) node acc) (fun acc (id,node) -> Pid_map.add (Array_.dicho_find id old_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 i1 = let i1 =
match Id.build_opt ast_edge.Ast.src old_table match Id.build_opt ast_edge.Ast.src old_table
with Some i -> i | None -> -1-(Id.build ~loc ast_edge.Ast.src new_table) in with Some i -> i | None -> -1-(Id.build ~loc ast_edge.Ast.src new_table) in
let i2 = let i2 =
match Id.build_opt ast_edge.Ast.tar old_table match Id.build_opt ast_edge.Ast.tar old_table
with Some i -> i | None -> -1-(Id.build ~loc ast_edge.Ast.tar new_table) in with Some i -> i | None -> -1-(Id.build ~loc ast_edge.Ast.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)
(* ---------------------------------------------------------------------------------------------------- *) (* ---------------------------------------------------------------------------------------------------- *)
(* Topology functions *) (* Topology functions *)
(* ---------------------------------------------------------------------------------------------------- *) (* ---------------------------------------------------------------------------------------------------- *)
(* [tree_and_roots t] returns: (* [tree_and_roots t] returns:
- a boolean which is true iff the each node has at most one in-edge - a boolean which is true iff the each node has at most one in-edge
- the list of "roots" (i.e. nodes without in-edge *) - the list of "roots" (i.e. nodes without in-edge *)
let tree_and_roots graph = let tree_and_roots graph =
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.fold_left Massoc.fold_left
(fun acc2 tar _ -> (fun acc2 tar _ ->
if !tree_prop if !tree_prop
then then
if IntSet.mem tar acc2 if IntSet.mem tar acc2
then (tree_prop := false; acc2) then (tree_prop := false; acc2)
else IntSet.add tar acc2 else IntSet.add tar acc2
...@@ -173,13 +183,13 @@ module P_graph = struct ...@@ -173,13 +183,13 @@ module P_graph = struct
) graph IntSet.empty in ) graph IntSet.empty in
let roots = let roots =
Pid_map.fold Pid_map.fold
(fun id _ acc -> (fun id _ acc ->
if IntSet.mem id not_root if IntSet.mem id not_root
then acc then acc
else id::acc else id::acc
) graph [] in ) graph [] in
(!tree_prop, roots) (!tree_prop, roots)
let roots graph = snd (tree_and_roots graph) let roots graph = snd (tree_and_roots graph)
...@@ -204,16 +214,16 @@ module G_graph = struct ...@@ -204,16 +214,16 @@ module G_graph = struct
| String of string | String of string
let map_add_edge map id_src label id_tar = let map_add_edge map id_src label id_tar =
let node_src = let node_src =
(* Not found can be raised when adding an edge from pos to neg *) (* Not found can be raised when adding an edge from pos to neg *)
try Gid_map.find id_src map with Not_found -> G_node.empty in try Gid_map.find id_src map with Not_found -> G_node.empty in
match G_node.add_edge label id_tar node_src with match G_node.add_edge label id_tar node_src with
| None -> None | None -> None
| Some new_node -> Some (Gid_map.add id_src new_node map) | Some new_node -> Some (Gid_map.add id_src new_node map)
let build ?(locals=[||]) full_node_list full_edge_list = let build ?(locals=[||]) full_node_list full_edge_list =
let named_nodes = let named_nodes =
let rec loop already_bound = function let rec loop already_bound = function
| [] -> [] | [] -> []
| (ast_node, loc) :: tail -> | (ast_node, loc) :: tail ->
...@@ -228,53 +238,53 @@ module G_graph = struct ...@@ -228,53 +238,53 @@ module G_graph = struct
(* table contains the sorted list of node ids *) (* table contains the sorted list of node ids *)
let table = Array.of_list sorted_ids in let table = Array.of_list sorted_ids in
(* the nodes, in the same order *) (* the nodes, in the same order *)
let map_without_edges = List_.foldi_left (fun i acc elt -> Gid_map.add i elt acc) Gid_map.empty node_list in let map_without_edges = List_.foldi_left (fun i acc elt -> Gid_map.add (Gid.Old i) elt acc) Gid_map.empty node_list in
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 i1 edge 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
{map=map;lub=Array.length table} {map=map;lub=Array.length table}
let of_conll ?loc lines = let of_conll ?loc lines =
let nodes = let nodes =
List.fold_left List.fold_left
(fun acc line -> (fun acc line ->
Gid_map.add line.Conll.num (G_node.of_conll line) acc) Gid_map.add (Gid.Old line.Conll.num) (G_node.of_conll line) acc)
Gid_map.empty lines in Gid_map.empty lines in
let nodes_with_edges = let nodes_with_edges =
List.fold_left List.fold_left
(fun acc line -> (fun acc line ->
(* add line number information in loc *) (* add line number information in loc *)
let loc = Loc.opt_set_line line.Conll.line_num loc in let loc = Loc.opt_set_line line.Conll.line_num loc in
if line.Conll.gov=0 if line.Conll.gov=0
then acc then acc
else else
let gov_node = let gov_node =
try Gid_map.find line.Conll.gov acc try Gid_map.find (Gid.Old line.Conll.gov) acc
with Not_found -> with Not_found ->
Error.build ?loc "[G_graph.of_conll] the line refers to unknown gov %d" line.Conll.gov in Error.build ?loc "[G_graph.of_conll] the line refers to unknown gov %d" line.Conll.gov in
match G_node.add_edge (G_edge.make ?loc line.Conll.dep_lab) line.Conll.num gov_node with match G_node.add_edge (G_edge.make ?loc line.Conll.dep_lab) (Gid.Old line.Conll.num) gov_node with
| None -> acc | None -> acc
| Some new_node -> Gid_map.add line.Conll.gov new_node acc | Some new_node -> Gid_map.add (Gid.Old line.Conll.gov) new_node acc
) nodes lines in ) nodes lines in
{map = nodes_with_edges; lub=1+(Gid_map.fold (fun _ _ acc -> acc+1) nodes_with_edges 0)} {map = nodes_with_edges; lub=1+(Gid_map.fold (fun _ _ acc -> acc+1) nodes_with_edges 0)}
...@@ -287,7 +297,7 @@ module G_graph = struct ...@@ -287,7 +297,7 @@ module G_graph = struct
(* [add_edge graph id_src label id_tar] tries to add an edge grom [id_src] to [id_tar] with [label] to [graph]. (* [add_edge graph id_src label id_tar] tries to add an edge grom [id_src] to [id_tar] with [label] to [graph].
if it succeeds, [Some new_graph] is returned if it succeeds, [Some new_graph] is returned
if it fails (the edge already exists), [None] is returned if it fails (the edge already exists), [None] is returned
*) *)
let add_edge graph id_src label id_tar = let add_edge graph id_src label id_tar =
match map_add_edge graph.map id_src label id_tar with match map_add_edge graph.map id_src label id_tar with
| Some new_map -> Some {graph with map = new_map} | Some new_map -> Some {graph with map = new_map}
...@@ -296,59 +306,62 @@ module G_graph = struct ...@@ -296,59 +306,62 @@ module G_graph = struct
(* remove (id_src -[label]-> id_tar) from graph. (* remove (id_src -[label]-> id_tar) from graph.
Log.critical if the edge is not in graph *) Log.critical if the edge is not in graph *)
let del_edge ?edge_ident loc graph id_src label id_tar = let del_edge ?edge_ident loc graph id_src label id_tar =
let node_src = let node_src =
try Gid_map.find id_src graph.map try Gid_map.find id_src graph.map
with Not_found -> with Not_found ->
match edge_ident with match edge_ident with
| None -> Log.fcritical "[RUN] Some edge refers to a dead node, please report" | None -> Log.fcritical "[RUN] Some edge refers to a dead node, please report"
| Some id -> Error.run ~loc "[Graph.del_edge] cannot find source node of edge \"%s\"" id in | Some id -> Error.run ~loc "[Graph.del_edge] cannot find source node of edge \"%s\"" id in
try {graph with map = try {graph with map =
(* Gid_map.add id_src {node_src with Node.next = Massoc.remove id_tar label node_src.Node.next} graph.map *) (* Gid_map.add id_src {node_src with Node.next = Massoc.remove id_tar label node_src.Node.next} graph.map *)
Gid_map.add id_src (G_node.remove id_tar label node_src) graph.map Gid_map.add id_src (G_node.remove id_tar label node_src) graph.map
} }
with Not_found -> Error.run ~loc "[Graph.del_edge] cannot find edge '%s'" (G_edge.to_string label) with Not_found -> Error.run ~loc "[Graph.del_edge] cannot find edge '%s'" (G_edge.to_string label)
(* remove node i from graph, with all its incoming and outcoming edges *) (* remove node i from graph, with all its incoming and outcoming edges *)
(* [graph] is unchanged if the node is not in it *) (* [graph] is unchanged if the node is not in it *)
let del_node graph node_id = let del_node graph node_id =
let new_map = let new_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 {value with Node.next = try Massoc.remove_key node_id value.Node.next with Not_found -> value.Node.next} acc *) (* else Gid_map.add id {value with Node.next = try Massoc.remove_key node_id value.Node.next with Not_found -> value.Node.next} 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 in ) graph.map Gid_map.empty in
{graph with map = new_map} {graph with map = new_map}
let add_neighbour loc graph node_id label = let add_neighbour loc graph node_id label =
(* index is a new number (higher then lub and uniquely defined by (node_id,label) *) (* index is a new number (higher then lub and uniquely defined by (node_id,label) *)
let index = graph.lub + ((Label.to_int label) * graph.lub) + node_id in (* let index = graph.lub + ((Label.to_int label) * graph.lub) + node_id in *)
let index = match node_id with
| Gid.Old id -> Gid.New (id, Label.to_int label)
| Gid.New _ -> Error.run ~loc "[Graph.add_neighbour] try to add neighbour node to a neighbour node" in
if Gid_map.mem index graph.map if Gid_map.mem index graph.map
then Error.run ~loc "[Graph.add_neighbour] try to build twice the \"same\" neighbour node (with label '%s')" (Label.to_string label); then Error.run ~loc "[Graph.add_neighbour] try to build twice the \"same\" neighbour node (with label '%s')" (Label.to_string label);
let node = Gid_map.find node_id graph.map in let node = Gid_map.find node_id graph.map in
(* put the new node on the right of its "parent" *) (* put the new node on the right of its "parent" *)
let new_graph = {graph with map = Gid_map.add index (G_node.build_neighbour node) graph.map} in let new_graph = {graph with map = Gid_map.add index (G_node.build_neighbour node) graph.map} in
match add_edge new_graph node_id label index with match add_edge new_graph node_id label index with
| Some g -> (index, g) | Some g -> (index, g)
| None -> Log.bug "[Graph.add_neighbour] add_edge must not fail"; exit 1 | None -> Log.bug "[Graph.add_neighbour] add_edge must not fail"; exit 1
(* move all in arcs to id_src are moved to in arcs on node id_tar from graph, with all its incoming edges *) (* move all in arcs to id_src are moved to in arcs on node id_tar from graph, with all its incoming edges *)
let shift_in loc graph src_gid tar_gid = let shift_in loc graph src_gid tar_gid =
let tar_node = Gid_map.find tar_gid graph.map in let tar_node = Gid_map.find tar_gid graph.map in
if Massoc.mem_key src_gid (G_node.get_next tar_node) if Massoc_gid.mem_key src_gid (G_node.get_next tar_node)
then Error.run ~loc "[Graph.shift_in] dependency from tar to src"; then Error.run ~loc "[Graph.shift_in] dependency from tar to src";
let new_map = let new_map =
Gid_map.mapi Gid_map.mapi
(fun node_id node -> (fun node_id node ->
match G_node.merge_key src_gid tar_gid node with match G_node.merge_key src_gid tar_gid node with
...@@ -358,21 +371,21 @@ module G_graph = struct ...@@ -358,21 +371,21 @@ module G_graph = struct
in {graph with map = new_map} in {graph with map = new_map}
(* move all out-edges from id_src are moved to out-edges out off node id_tar *) (* move all out-edges from id_src are moved to out-edges out off node id_tar *)
let shift_out loc graph src_gid tar_gid = let shift_out loc graph src_gid tar_gid =
let src_node = Gid_map.find src_gid graph.map in let src_node = Gid_map.find src_gid graph.map in
let tar_node = Gid_map.find tar_gid graph.map in let tar_node = Gid_map.find tar_gid graph.map in
if Massoc.mem_key tar_gid (G_node.get_next src_node) if Massoc_gid.mem_key tar_gid (G_node.get_next src_node)
then Error.run ~loc "[Graph.shift_out] dependency from src to tar"; then Error.run ~loc "[Graph.shift_out] dependency from src to tar";
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 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
...@@ -381,24 +394,24 @@ module G_graph = struct ...@@ -381,24 +394,24 @@ module G_graph = struct
) graph.map ) graph.map
in {graph with map = new_map} in {graph with map = new_map}
(* move all incident arcs from/to id_src are moved to incident arcs on node id_tar from graph, with all its incoming and outcoming edges *) (* move all incident arcs from/to id_src are moved to incident arcs on node id_tar from graph, with all its incoming and outcoming edges *)
let shift_edges loc graph src_gid tar_gid = let shift_edges loc graph src_gid tar_gid =
let src_node = Gid_map.find src_gid graph.map in let src_node = Gid_map.find src_gid graph.map in
let tar_node = Gid_map.find tar_gid graph.map in let tar_node = Gid_map.find tar_gid graph.map in
if Massoc.mem_key tar_gid (G_node.get_next src_node) if Massoc_gid.mem_key tar_gid (G_node.get_next src_node)
then Error.run ~loc "[Graph.shift_edges] dependency from src to tar"; then Error.run ~loc "[Graph.shift_edges] dependency from src to tar";
if Massoc.mem_key src_gid (G_node.get_next tar_node) if Massoc_gid.mem_key src_gid (G_node.get_next tar_node)
then Error.run ~loc "[Graph.shift_edges] dependency from tar to src"; then Error.run ~loc "[Graph.shift_edges] dependency from tar to src";
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
...@@ -416,16 +429,16 @@ module G_graph = struct ...@@ -416,16 +429,16 @@ module G_graph = struct
let src_node = Gid_map.find src_gid se_graph.map in let src_node = Gid_map.find src_gid se_graph.map in
let tar_node = Gid_map.find tar_gid se_graph.map in let tar_node = Gid_map.find tar_gid se_graph.map in
match G_fs.unif (G_node.get_fs src_node) (G_node.get_fs tar_node) with match G_fs.unif (G_node.get_fs src_node) (G_node.get_fs tar_node) with
| Some new_fs -> | Some new_fs ->
let new_map = let new_map =
Gid_map.add Gid_map.add
tar_gid tar_gid