Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
L
libcaml-grew
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
3
Issues
3
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
Operations
Operations
Incidents
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
grew
libcaml-grew
Commits
1d57deed
Commit
1d57deed
authored
Feb 19, 2018
by
Bruno Guillaume
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
safe_commands
parent
1bd378e0
Changes
7
Hide whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
38 additions
and
65 deletions
+38
-65
src/grew_base.ml
src/grew_base.ml
+1
-14
src/grew_base.mli
src/grew_base.mli
+1
-4
src/grew_graph.ml
src/grew_graph.ml
+7
-7
src/grew_graph.mli
src/grew_graph.mli
+0
-3
src/grew_node.ml
src/grew_node.ml
+0
-8
src/grew_node.mli
src/grew_node.mli
+0
-2
src/grew_rule.ml
src/grew_rule.ml
+29
-27
No files found.
src/grew_base.ml
View file @
1d57deed
...
...
@@ -442,8 +442,6 @@ module type S = sig
exception
Not_disjoint
val
disjoint_union
:
'
a
t
->
'
a
t
->
'
a
t
exception
Duplicate
val
merge_key
:
key
->
key
->
'
a
t
->
'
a
t
val
exists
:
(
key
->
'
a
->
bool
)
->
'
a
t
->
bool
...
...
@@ -523,17 +521,6 @@ module Massoc_make (Ord: OrderedType) = struct
|
List_
.
Not_disjoint
->
raise
Not_disjoint
)
t1
t2
exception
Duplicate
let
merge_key
i
j
t
=
try
let
old_i
=
M
.
find
i
t
in
let
old_j
=
try
M
.
find
j
t
with
Not_found
->
[]
in
M
.
add
j
(
List_
.
sort_disjoint_union
old_i
old_j
)
(
M
.
remove
i
t
)
with
|
Not_found
->
(* no key i *)
t
|
List_
.
Not_disjoint
->
raise
Duplicate
exception
True
let
exists
fct
t
=
try
...
...
@@ -631,5 +618,5 @@ module Global = struct
|
(
fo
,
Some
l
)
->
current_loc
:=
(
fo
,
Some
(
l
+
1
))
let
debug
=
ref
false
let
s
trict
=
ref
false
let
s
afe_commands
=
ref
false
end
src/grew_base.mli
View file @
1d57deed
...
...
@@ -225,9 +225,6 @@ module type S =
exception
Not_disjoint
val
disjoint_union
:
'
a
t
->
'
a
t
->
'
a
t
exception
Duplicate
val
merge_key
:
key
->
key
->
'
a
t
->
'
a
t
val
exists
:
(
key
->
'
a
->
bool
)
->
'
a
t
->
bool
val
rename
:
(
key
*
key
)
list
->
'
a
t
->
'
a
t
...
...
@@ -294,5 +291,5 @@ module Global: sig
val
label_flag
:
bool
ref
val
debug
:
bool
ref
val
s
trict
:
bool
ref
val
s
afe_commands
:
bool
ref
end
src/grew_graph.ml
View file @
1d57deed
...
...
@@ -560,7 +560,7 @@ module G_graph = struct
(* -------------------------------------------------------------------------------- *)
(* move out-edges (which respect cst [labels,neg]) from id_src are moved to out-edges out off node id_tar *)
let
shift_out
loc
s
trict
s
rc_gid
tar_gid
is_gid_local
label_cst
graph
=
let
shift_out
loc
src_gid
tar_gid
is_gid_local
label_cst
graph
=
let
domain
=
get_domain
graph
in
let
del_edges
=
ref
[]
and
add_edges
=
ref
[]
in
...
...
@@ -576,7 +576,7 @@ module G_graph = struct
if
Label_cst
.
match_
?
domain
label_cst
edge
&&
not
(
is_gid_local
next_gid
)
then
match
Massoc_gid
.
add_opt
next_gid
edge
acc_tar_next
with
|
None
when
strict
->
Error
.
run
~
loc
"The [shift_out] command tries to build a duplicate edge (with label
\"
%s
\"
)"
(
Label
.
to_string
?
domain
edge
)
|
None
when
!
Global
.
safe_commands
->
Error
.
run
~
loc
"The [shift_out] command tries to build a duplicate edge (with label
\"
%s
\"
)"
(
Label
.
to_string
?
domain
edge
)
|
None
->
del_edges
:=
(
src_gid
,
edge
,
next_gid
)
::
!
del_edges
;
(
Massoc_gid
.
remove
next_gid
edge
acc_src_next
,
acc_tar_next
)
...
...
@@ -597,7 +597,7 @@ module G_graph = struct
)
(* -------------------------------------------------------------------------------- *)
let
shift_in
loc
s
trict
s
rc_gid
tar_gid
is_gid_local
label_cst
graph
=
let
shift_in
loc
src_gid
tar_gid
is_gid_local
label_cst
graph
=
let
domain
=
get_domain
graph
in
let
del_edges
=
ref
[]
and
add_edges
=
ref
[]
in
let
new_map
=
...
...
@@ -617,7 +617,7 @@ module G_graph = struct
if
Label_cst
.
match_
?
domain
label_cst
edge
then
match
List_
.
usort_insert
edge
acc_node_tar_edges
with
|
None
when
strict
->
|
None
when
!
Global
.
safe_commands
->
Error
.
run
~
loc
"The [shift_in] command tries to build a duplicate edge (with label
\"
%s
\"
)"
(
Label
.
to_string
?
domain
edge
)
|
None
->
del_edges
:=
(
node_id
,
edge
,
src_gid
)
::
!
del_edges
;
...
...
@@ -641,9 +641,9 @@ module G_graph = struct
)
(* -------------------------------------------------------------------------------- *)
let
shift_edges
loc
s
trict
s
rc_gid
tar_gid
is_gid_local
label_cst
graph
=
let
(
g1
,
de1
,
ae1
)
=
shift_out
loc
s
trict
s
rc_gid
tar_gid
is_gid_local
label_cst
graph
in
let
(
g2
,
de2
,
ae2
)
=
shift_in
loc
s
trict
s
rc_gid
tar_gid
is_gid_local
label_cst
g1
in
let
shift_edges
loc
src_gid
tar_gid
is_gid_local
label_cst
graph
=
let
(
g1
,
de1
,
ae1
)
=
shift_out
loc
src_gid
tar_gid
is_gid_local
label_cst
graph
in
let
(
g2
,
de2
,
ae2
)
=
shift_in
loc
src_gid
tar_gid
is_gid_local
label_cst
g1
in
(
g2
,
de1
@
de2
,
ae1
@
ae2
)
(* -------------------------------------------------------------------------------- *)
...
...
src/grew_graph.mli
View file @
1d57deed
...
...
@@ -136,7 +136,6 @@ module G_graph: sig
(** shift all crown-edges ending in [src_gid] to edges ending in [tar_gid] *)
val
shift_in
:
Loc
.
t
->
(* localization of the command *)
bool
->
(* true iff strict rewriting *)
Gid
.
t
->
(* [src_gid] the source gid of the "shift_in" *)
Gid
.
t
->
(* [tar_gid] the target gid of the "shift_in" *)
(
Gid
.
t
->
bool
)
->
(* a locality test: true iff the node is a pattern node *)
...
...
@@ -150,7 +149,6 @@ module G_graph: sig
(** shift all crown-edges starting from [src_gid] to edges starting from [tar_gid] *)
val
shift_out
:
Loc
.
t
->
(* localization of the command *)
bool
->
(* true iff strict rewriting *)
Gid
.
t
->
(* [src_gid] the source gid of the "shift_out" *)
Gid
.
t
->
(* [tar_gid] the target gid of the "shift_out" *)
(
Gid
.
t
->
bool
)
->
(* a locality test: true iff the node is a pattern node *)
...
...
@@ -164,7 +162,6 @@ module G_graph: sig
(** move all incident crown-edges from/to [src_gid] are moved to incident edges on node [tar_gid] from graph *)
val
shift_edges
:
Loc
.
t
->
(* localization of the command *)
bool
->
(* true iff strict rewriting *)
Gid
.
t
->
(* [src_gid] the source gid of the "shift_edges" *)
Gid
.
t
->
(* [tar_gid] the target gid of the "shift_edges" *)
(
Gid
.
t
->
bool
)
->
(* a locality test: true iff the node is a pattern node *)
...
...
src/grew_node.ml
View file @
1d57deed
...
...
@@ -115,14 +115,6 @@ module G_node = struct
let
remove_key
node_id
t
=
try
{
t
with
next
=
Massoc_gid
.
remove_key
node_id
t
.
next
}
with
Not_found
->
t
let
merge_key
?
(
strict
=
false
)
src_id
tar_id
t
=
try
Some
{
t
with
next
=
Massoc_gid
.
merge_key
src_id
tar_id
t
.
next
}
with
Massoc_gid
.
Duplicate
->
if
strict
then
None
else
Some
t
let
shift_out
?
(
strict
=
false
)
src_t
tar_t
=
try
Some
{
tar_t
with
next
=
Massoc_gid
.
disjoint_union
src_t
.
next
tar_t
.
next
}
with
Massoc_gid
.
Not_disjoint
->
if
strict
then
None
else
Some
tar_t
let
rm_out_edges
t
=
{
t
with
next
=
Massoc_gid
.
empty
}
(* let build_neighbour t = { empty with position = (get_position t) +. 0.01 }
...
...
src/grew_node.mli
View file @
1d57deed
...
...
@@ -61,8 +61,6 @@ module G_node: sig
val
remove_key
:
Gid
.
t
->
t
->
t
val
merge_key
:
?
strict
:
bool
->
Gid
.
t
->
Gid
.
t
->
t
->
t
option
val
shift_out
:
?
strict
:
bool
->
t
->
t
->
t
option
val
rm_out_edges
:
t
->
t
...
...
src/grew_rule.ml
View file @
1d57deed
...
...
@@ -907,7 +907,7 @@ module Rule = struct
}
,
created_nodes
)
|
None
when
!
Global
.
s
trict
->
|
None
when
!
Global
.
s
afe_commands
->
Error
.
run
"ADD_EDGE: the edge '%s' already exists %s"
(
G_edge
.
to_string
?
domain
edge
)
(
Loc
.
to_string
loc
)
|
None
->
(
instance
,
created_nodes
)
end
...
...
@@ -929,7 +929,7 @@ module Rule = struct
}
,
created_nodes
)
|
None
when
!
Global
.
s
trict
->
|
None
when
!
Global
.
s
afe_commands
->
Error
.
run
"ADD_EDGE_EXPL: the edge '%s' already exists %s"
(
G_edge
.
to_string
?
domain
edge
)
(
Loc
.
to_string
loc
)
|
None
->
(
instance
,
created_nodes
)
...
...
@@ -939,7 +939,7 @@ module Rule = struct
let
src_gid
=
node_find
src_cn
in
let
tar_gid
=
node_find
tar_cn
in
(
match
G_graph
.
del_edge
loc
instance
.
Instance
.
graph
src_gid
edge
tar_gid
with
|
None
when
!
Global
.
s
trict
->
Error
.
run
"DEL_EDGE_EXPL: the edge '%s' does not exist %s"
(
G_edge
.
to_string
?
domain
edge
)
(
Loc
.
to_string
loc
)
|
None
when
!
Global
.
s
afe_commands
->
Error
.
run
"DEL_EDGE_EXPL: the edge '%s' does not exist %s"
(
G_edge
.
to_string
?
domain
edge
)
(
Loc
.
to_string
loc
)
|
None
->
(
instance
,
created_nodes
)
|
Some
new_graph
->
(
...
...
@@ -969,7 +969,7 @@ module Rule = struct
|
Command
.
DEL_NODE
node_cn
->
let
node_gid
=
node_find
node_cn
in
(
match
G_graph
.
del_node
instance
.
Instance
.
graph
node_gid
with
|
None
when
!
Global
.
s
trict
->
Error
.
run
"DEL_NODE: the node does not exist %s"
(
Loc
.
to_string
loc
)
|
None
when
!
Global
.
s
afe_commands
->
Error
.
run
"DEL_NODE: the node does not exist %s"
(
Loc
.
to_string
loc
)
|
None
->
(
instance
,
created_nodes
)
|
Some
new_graph
->
(
...
...
@@ -1009,7 +1009,7 @@ module Rule = struct
|
Command
.
DEL_FEAT
(
tar_cn
,
feat_name
)
->
let
tar_gid
=
node_find
tar_cn
in
(
match
G_graph
.
del_feat
instance
.
Instance
.
graph
tar_gid
feat_name
with
|
None
when
!
Global
.
s
trict
->
Error
.
run
"DEL_FEAT: the feat does not exist %s"
(
Loc
.
to_string
loc
)
|
None
when
!
Global
.
s
afe_commands
->
Error
.
run
"DEL_FEAT: the feat does not exist %s"
(
Loc
.
to_string
loc
)
|
None
->
Log
.
fwarning
"DEL_FEAT: the feat does not exist %s"
(
Loc
.
to_string
loc
);
(
instance
,
created_nodes
)
...
...
@@ -1057,7 +1057,7 @@ module Rule = struct
|
Command
.
SHIFT_IN
(
src_cn
,
tar_cn
,
label_cst
)
->
let
src_gid
=
node_find
src_cn
in
let
tar_gid
=
node_find
tar_cn
in
let
(
new_graph
,
_
,
_
)
=
G_graph
.
shift_in
loc
true
src_gid
tar_gid
(
test_locality
matching
created_nodes
)
label_cst
instance
.
Instance
.
graph
in
let
(
new_graph
,
_
,
_
)
=
G_graph
.
shift_in
loc
src_gid
tar_gid
(
test_locality
matching
created_nodes
)
label_cst
instance
.
Instance
.
graph
in
(
{
instance
with
Instance
.
graph
=
new_graph
;
...
...
@@ -1069,7 +1069,7 @@ module Rule = struct
|
Command
.
SHIFT_OUT
(
src_cn
,
tar_cn
,
label_cst
)
->
let
src_gid
=
node_find
src_cn
in
let
tar_gid
=
node_find
tar_cn
in
let
(
new_graph
,
_
,
_
)
=
G_graph
.
shift_out
loc
true
src_gid
tar_gid
(
test_locality
matching
created_nodes
)
label_cst
instance
.
Instance
.
graph
in
let
(
new_graph
,
_
,
_
)
=
G_graph
.
shift_out
loc
src_gid
tar_gid
(
test_locality
matching
created_nodes
)
label_cst
instance
.
Instance
.
graph
in
(
{
instance
with
Instance
.
graph
=
new_graph
;
...
...
@@ -1081,7 +1081,7 @@ module Rule = struct
|
Command
.
SHIFT_EDGE
(
src_cn
,
tar_cn
,
label_cst
)
->
let
src_gid
=
node_find
src_cn
in
let
tar_gid
=
node_find
tar_cn
in
let
(
new_graph
,
_
,
_
)
=
G_graph
.
shift_edges
loc
true
src_gid
tar_gid
(
test_locality
matching
created_nodes
)
label_cst
instance
.
Instance
.
graph
in
let
(
new_graph
,
_
,
_
)
=
G_graph
.
shift_edges
loc
src_gid
tar_gid
(
test_locality
matching
created_nodes
)
label_cst
instance
.
Instance
.
graph
in
(
{
instance
with
Instance
.
graph
=
new_graph
;
...
...
@@ -1391,7 +1391,7 @@ module Rule = struct
let
tar_gid
=
node_find
tar_cn
in
begin
match
G_graph
.
add_edge
graph
src_gid
edge
tar_gid
with
|
None
when
!
Global
.
s
trict
->
|
None
when
!
Global
.
s
afe_commands
->
Error
.
run
"ADD_EDGE: the edge '%s' already exists %s"
(
G_edge
.
to_string
?
domain
edge
)
(
Loc
.
to_string
loc
)
|
None
->
(
graph
,
created_nodes
,
eff
)
|
Some
new_graph
->
(
new_graph
,
created_nodes
,
true
)
...
...
@@ -1405,7 +1405,7 @@ module Rule = struct
with
Not_found
->
Error
.
bug
"The edge identifier '%s' is undefined %s"
edge_ident
(
Loc
.
to_string
loc
)
in
begin
match
G_graph
.
add_edge
graph
src_gid
edge
tar_gid
with
|
None
when
!
Global
.
s
trict
->
|
None
when
!
Global
.
s
afe_commands
->
Error
.
run
"ADD_EDGE_EXPL: the edge '%s' already exists %s"
(
G_edge
.
to_string
?
domain
edge
)
(
Loc
.
to_string
loc
)
|
None
->
(
graph
,
created_nodes
,
eff
)
|
Some
new_graph
->
(
new_graph
,
created_nodes
,
true
)
...
...
@@ -1415,8 +1415,7 @@ module Rule = struct
let
src_gid
=
node_find
src_cn
in
let
tar_gid
=
node_find
tar_cn
in
(
match
G_graph
.
del_edge
loc
graph
src_gid
edge
tar_gid
with
|
None
when
!
Global
.
strict
->
Error
.
run
"DEL_EDGE_EXPL: the edge '%s' does not exist %s"
(
G_edge
.
to_string
?
domain
edge
)
(
Loc
.
to_string
loc
)
|
None
when
!
Global
.
safe_commands
->
Error
.
run
"DEL_EDGE_EXPL: the edge '%s' does not exist %s"
(
G_edge
.
to_string
?
domain
edge
)
(
Loc
.
to_string
loc
)
|
None
->
(
graph
,
created_nodes
,
eff
)
|
Some
new_graph
->
(
new_graph
,
created_nodes
,
true
)
)
...
...
@@ -1426,13 +1425,16 @@ module Rule = struct
try
List
.
assoc
edge_ident
matching
.
e_match
with
Not_found
->
Error
.
bug
"The edge identifier '%s' is undefined %s"
edge_ident
(
Loc
.
to_string
loc
)
in
(
match
G_graph
.
del_edge
~
edge_ident
loc
graph
src_gid
edge
tar_gid
with
|
None
->
Error
.
bug
"DEL_EDGE_NAME"
|
None
when
!
Global
.
safe_commands
->
Error
.
run
"DEL_EDGE_NAME: the edge '%s' does not exist %s"
edge_ident
(
Loc
.
to_string
loc
)
|
None
->
(
graph
,
created_nodes
,
eff
)
|
Some
new_graph
->
(
new_graph
,
created_nodes
,
true
)
)
|
Command
.
DEL_NODE
node_cn
->
let
node_gid
=
node_find
node_cn
in
(
match
G_graph
.
del_node
graph
node_gid
with
|
None
->
Error
.
run
"DEL_NODE: the node does not exist %s"
(
Loc
.
to_string
loc
)
|
None
when
!
Global
.
safe_commands
->
Error
.
run
"DEL_NODE: the node does not exist %s"
(
Loc
.
to_string
loc
)
|
None
->
(
graph
,
created_nodes
,
eff
)
|
Some
new_graph
->
(
new_graph
,
created_nodes
,
true
)
)
...
...
@@ -1459,7 +1461,7 @@ module Rule = struct
|
Command
.
DEL_FEAT
(
tar_cn
,
feat_name
)
->
let
tar_gid
=
node_find
tar_cn
in
(
match
G_graph
.
del_feat
graph
tar_gid
feat_name
with
|
None
when
!
Global
.
s
trict
->
Error
.
run
"XXX"
|
None
when
!
Global
.
s
afe_commands
->
Error
.
run
"XXX"
|
None
->
(
graph
,
created_nodes
,
eff
)
|
Some
new_graph
->
(
new_graph
,
created_nodes
,
true
)
)
...
...
@@ -1467,19 +1469,19 @@ module Rule = struct
|
Command
.
SHIFT_IN
(
src_cn
,
tar_cn
,
label_cst
)
->
let
src_gid
=
node_find
src_cn
in
let
tar_gid
=
node_find
tar_cn
in
let
(
new_graph
,
de
,
ae
)
=
G_graph
.
shift_in
loc
true
src_gid
tar_gid
(
test_locality
matching
created_nodes
)
label_cst
graph
in
let
(
new_graph
,
de
,
ae
)
=
G_graph
.
shift_in
loc
src_gid
tar_gid
(
test_locality
matching
created_nodes
)
label_cst
graph
in
(
new_graph
,
created_nodes
,
eff
||
de
<>
[]
||
ae
<>
[]
)
|
Command
.
SHIFT_OUT
(
src_cn
,
tar_cn
,
label_cst
)
->
let
src_gid
=
node_find
src_cn
in
let
tar_gid
=
node_find
tar_cn
in
let
(
new_graph
,
de
,
ae
)
=
G_graph
.
shift_out
loc
true
src_gid
tar_gid
(
test_locality
matching
created_nodes
)
label_cst
graph
in
let
(
new_graph
,
de
,
ae
)
=
G_graph
.
shift_out
loc
src_gid
tar_gid
(
test_locality
matching
created_nodes
)
label_cst
graph
in
(
new_graph
,
created_nodes
,
eff
||
de
<>
[]
||
ae
<>
[]
)
|
Command
.
SHIFT_EDGE
(
src_cn
,
tar_cn
,
label_cst
)
->
let
src_gid
=
node_find
src_cn
in
let
tar_gid
=
node_find
tar_cn
in
let
(
new_graph
,
de
,
ae
)
=
G_graph
.
shift_edges
loc
true
src_gid
tar_gid
(
test_locality
matching
created_nodes
)
label_cst
graph
in
let
(
new_graph
,
de
,
ae
)
=
G_graph
.
shift_edges
loc
src_gid
tar_gid
(
test_locality
matching
created_nodes
)
label_cst
graph
in
(
new_graph
,
created_nodes
,
eff
||
de
<>
[]
||
ae
<>
[]
)
|
Command
.
NEW_AFTER
(
created_name
,
base_cn
)
->
...
...
@@ -1612,7 +1614,7 @@ module Rule = struct
let
tar_gid
=
node_find
tar_cn
in
begin
match
G_graph
.
add_edge
gwh
.
Graph_with_history
.
graph
src_gid
edge
tar_gid
with
|
None
when
!
Global
.
s
trict
->
|
None
when
!
Global
.
s
afe_commands
->
Error
.
run
"ADD_EDGE: the edge '%s' already exists %s"
(
G_edge
.
to_string
?
domain
edge
)
(
Loc
.
to_string
loc
)
|
None
->
gwh
...
...
@@ -1632,7 +1634,7 @@ module Rule = struct
begin
match
G_graph
.
add_edge
gwh
.
Graph_with_history
.
graph
src_gid
edge
tar_gid
with
|
None
when
!
Global
.
s
trict
->
|
None
when
!
Global
.
s
afe_commands
->
Error
.
run
"ADD_EDGE_EXPL: the edge '%s' already exists %s"
(
G_edge
.
to_string
?
domain
edge
)
(
Loc
.
to_string
loc
)
|
None
->
gwh
...
...
@@ -1647,7 +1649,7 @@ module Rule = struct
let
src_gid
=
node_find
src_cn
in
let
tar_gid
=
node_find
tar_cn
in
(
match
G_graph
.
del_edge
loc
gwh
.
Graph_with_history
.
graph
src_gid
edge
tar_gid
with
|
None
when
!
Global
.
s
trict
->
|
None
when
!
Global
.
s
afe_commands
->
Error
.
run
"DEL_EDGE_EXPL: the edge '%s' does not exist %s"
(
G_edge
.
to_string
?
domain
edge
)
(
Loc
.
to_string
loc
)
|
None
->
gwh
...
...
@@ -1662,7 +1664,7 @@ module Rule = struct
try
List
.
assoc
edge_ident
matching
.
e_match
with
Not_found
->
Error
.
bug
"The edge identifier '%s' is undefined %s"
edge_ident
(
Loc
.
to_string
loc
)
in
(
match
G_graph
.
del_edge
~
edge_ident
loc
gwh
.
Graph_with_history
.
graph
src_gid
edge
tar_gid
with
|
None
when
!
Global
.
s
trict
->
Error
.
run
"DEL_EDGE_NAME: the edge '%s' does not exist %s"
edge_ident
(
Loc
.
to_string
loc
)
|
None
when
!
Global
.
s
afe_commands
->
Error
.
run
"DEL_EDGE_NAME: the edge '%s' does not exist %s"
edge_ident
(
Loc
.
to_string
loc
)
|
None
->
gwh
|
Some
new_graph
->
{
gwh
with
...
...
@@ -1673,7 +1675,7 @@ module Rule = struct
|
Command
.
DEL_NODE
node_cn
->
let
node_gid
=
node_find
node_cn
in
(
match
G_graph
.
del_node
gwh
.
Graph_with_history
.
graph
node_gid
with
|
None
when
!
Global
.
s
trict
->
Error
.
run
"DEL_NODE the node does not exist %s"
(
Loc
.
to_string
loc
)
|
None
when
!
Global
.
s
afe_commands
->
Error
.
run
"DEL_NODE the node does not exist %s"
(
Loc
.
to_string
loc
)
|
None
->
gwh
|
Some
new_graph
->
{
gwh
with
...
...
@@ -1712,7 +1714,7 @@ module Rule = struct
|
Command
.
DEL_FEAT
(
tar_cn
,
feat_name
)
->
let
tar_gid
=
node_find
tar_cn
in
(
match
G_graph
.
del_feat
gwh
.
Graph_with_history
.
graph
tar_gid
feat_name
with
|
None
when
!
Global
.
s
trict
->
Error
.
run
"DEL_FEAT the feat does not exist %s"
(
Loc
.
to_string
loc
)
|
None
when
!
Global
.
s
afe_commands
->
Error
.
run
"DEL_FEAT the feat does not exist %s"
(
Loc
.
to_string
loc
)
|
None
->
gwh
|
Some
new_graph
->
{
gwh
with
Graph_with_history
.
graph
=
new_graph
;
...
...
@@ -1724,7 +1726,7 @@ module Rule = struct
let
src_gid
=
node_find
src_cn
in
let
tar_gid
=
node_find
tar_cn
in
let
(
new_graph
,
del_edges
,
add_edges
)
=
G_graph
.
shift_in
loc
!
Global
.
strict
src_gid
tar_gid
(
test_locality
matching
[]
)
label_cst
gwh
.
Graph_with_history
.
graph
in
G_graph
.
shift_in
loc
src_gid
tar_gid
(
test_locality
matching
[]
)
label_cst
gwh
.
Graph_with_history
.
graph
in
{
gwh
with
Graph_with_history
.
graph
=
new_graph
;
delta
=
gwh
.
Graph_with_history
.
delta
...
...
@@ -1736,7 +1738,7 @@ module Rule = struct
let
src_gid
=
node_find
src_cn
in
let
tar_gid
=
node_find
tar_cn
in
let
(
new_graph
,
del_edges
,
add_edges
)
=
G_graph
.
shift_out
loc
!
Global
.
strict
src_gid
tar_gid
(
test_locality
matching
[]
)
label_cst
gwh
.
Graph_with_history
.
graph
in
G_graph
.
shift_out
loc
src_gid
tar_gid
(
test_locality
matching
[]
)
label_cst
gwh
.
Graph_with_history
.
graph
in
{
gwh
with
Graph_with_history
.
graph
=
new_graph
;
delta
=
gwh
.
Graph_with_history
.
delta
...
...
@@ -1748,7 +1750,7 @@ module Rule = struct
let
src_gid
=
node_find
src_cn
in
let
tar_gid
=
node_find
tar_cn
in
let
(
new_graph
,
del_edges
,
add_edges
)
=
G_graph
.
shift_edges
loc
!
Global
.
strict
src_gid
tar_gid
(
test_locality
matching
[]
)
label_cst
gwh
.
Graph_with_history
.
graph
in
G_graph
.
shift_edges
loc
src_gid
tar_gid
(
test_locality
matching
[]
)
label_cst
gwh
.
Graph_with_history
.
graph
in
{
gwh
with
Graph_with_history
.
graph
=
new_graph
;
delta
=
gwh
.
Graph_with_history
.
delta
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment