Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
grew
libcaml-grew
Commits
9fca1eb5
Commit
9fca1eb5
authored
May 23, 2017
by
Bruno Guillaume
Browse files
remove the command “merge”
parent
7e05b76b
Changes
10
Hide whitespace changes
Inline
Side-by-side
misc/emacs/grew.el
View file @
9fca1eb5
...
...
@@ -17,7 +17,6 @@
;; ("$[a-zA-Z0-9_àéèçâôûêäïüö'\-]+" . font-lock-constant-face);;params inside
(
"del_edge"
.
font-lock-constant-face
)
(
"add_edge"
.
font-lock-constant-face
)
(
"merge"
.
font-lock-constant-face
)
(
"shift"
.
font-lock-constant-face
)
(
"shift_in"
.
font-lock-constant-face
)
(
"shift_out"
.
font-lock-constant-face
)
...
...
src/grew_ast.ml
View file @
9fca1eb5
...
...
@@ -255,7 +255,6 @@ module Ast = struct
|
Shift_out
of
(
Id
.
name
*
Id
.
name
*
edge_label_cst
)
|
Shift_edge
of
(
Id
.
name
*
Id
.
name
*
edge_label_cst
)
|
Merge_node
of
(
Id
.
name
*
Id
.
name
)
|
New_neighbour
of
(
Id
.
name
*
Id
.
name
*
edge_label
)
|
New_node
of
Id
.
name
|
New_before
of
(
Id
.
name
*
Id
.
name
)
...
...
@@ -304,7 +303,6 @@ module Ast = struct
|
Shift_edge
(
n1
,
n2
,
Regexp
re
)
->
sprintf
"shift %s =[re
\"
%s
\"
]=> %s"
n1
re
n2
|
Merge_node
(
n1
,
n2
)
->
sprintf
"merge %s ==> %s"
n1
n2
|
New_neighbour
(
n1
,
n2
,
label
)
->
sprintf
"add_node %s: <-[%s]- %s"
n1
label
n2
|
New_node
(
n
)
->
sprintf
"add_node %s"
n
|
New_before
(
n1
,
n2
)
->
sprintf
"add_node %s :< %s"
n1
n2
...
...
src/grew_ast.mli
View file @
9fca1eb5
...
...
@@ -143,7 +143,6 @@ module Ast : sig
|
Shift_out
of
(
Id
.
name
*
Id
.
name
*
edge_label_cst
)
|
Shift_edge
of
(
Id
.
name
*
Id
.
name
*
edge_label_cst
)
|
Merge_node
of
(
Id
.
name
*
Id
.
name
)
|
New_neighbour
of
(
Id
.
name
*
Id
.
name
*
edge_label
)
|
New_node
of
Id
.
name
...
...
src/grew_command.ml
View file @
9fca1eb5
...
...
@@ -63,7 +63,6 @@ module Command = struct
|
SHIFT_EDGE
of
(
command_node
*
command_node
*
Label_cst
.
t
)
|
SHIFT_IN
of
(
command_node
*
command_node
*
Label_cst
.
t
)
|
SHIFT_OUT
of
(
command_node
*
command_node
*
Label_cst
.
t
)
|
MERGE_NODE
of
(
command_node
*
command_node
)
type
t
=
p
*
Loc
.
t
(* remember command location to be able to localize a command failure *)
...
...
@@ -153,13 +152,6 @@ module Command = struct
(
"label_cst"
,
Label_cst
.
to_json
?
domain
label_cst
);
]
)]
|
MERGE_NODE
(
src
,
tar
)
->
`Assoc
[(
"merge"
,
`Assoc
[
(
"src"
,
command_node_to_json
src
);
(
"tar"
,
command_node_to_json
tar
);
]
)]
(* a item in the command history: command applied to a graph *)
type
h
=
...
...
@@ -178,7 +170,6 @@ module Command = struct
|
H_SHIFT_EDGE
of
(
Gid
.
t
*
Gid
.
t
)
|
H_SHIFT_IN
of
(
Gid
.
t
*
Gid
.
t
)
|
H_SHIFT_OUT
of
(
Gid
.
t
*
Gid
.
t
)
|
H_MERGE_NODE
of
(
Gid
.
t
*
Gid
.
t
)
let
build
?
domain
?
param
(
kai
,
kei
)
table
locals
ast_command
=
...
...
@@ -237,11 +228,6 @@ module Command = struct
check_node_id
loc
act_j
kai
;
((
SHIFT_OUT
(
pid_of_act_id
loc
act_i
,
pid_of_act_id
loc
act_j
,
Label_cst
.
build
?
domain
~
loc
label_cst
)
,
loc
)
,
(
kai
,
kei
))
|
(
Ast
.
Merge_node
(
act_i
,
act_j
)
,
loc
)
->
check_node_id
loc
act_i
kai
;
check_node_id
loc
act_j
kai
;
((
MERGE_NODE
(
pid_of_act_id
loc
act_i
,
pid_of_act_id
loc
act_j
)
,
loc
)
,
(
List_
.
rm
act_i
kai
,
kei
))
|
(
Ast
.
New_node
new_id
,
loc
)
->
if
List
.
mem
new_id
kai
then
Error
.
build
~
loc
"Node identifier
\"
%s
\"
is already used"
new_id
;
...
...
src/grew_command.mli
View file @
9fca1eb5
...
...
@@ -42,7 +42,6 @@ module Command : sig
|
SHIFT_EDGE
of
(
command_node
*
command_node
*
Label_cst
.
t
)
|
SHIFT_IN
of
(
command_node
*
command_node
*
Label_cst
.
t
)
|
SHIFT_OUT
of
(
command_node
*
command_node
*
Label_cst
.
t
)
|
MERGE_NODE
of
(
command_node
*
command_node
)
type
t
=
(
p
*
Loc
.
t
)
val
to_json
:
?
domain
:
Domain
.
t
->
t
->
Yojson
.
Basic
.
json
...
...
@@ -63,7 +62,6 @@ module Command : sig
|
H_SHIFT_EDGE
of
(
Gid
.
t
*
Gid
.
t
)
|
H_SHIFT_IN
of
(
Gid
.
t
*
Gid
.
t
)
|
H_SHIFT_OUT
of
(
Gid
.
t
*
Gid
.
t
)
|
H_MERGE_NODE
of
(
Gid
.
t
*
Gid
.
t
)
val
build
:
?
domain
:
Domain
.
t
->
...
...
src/grew_graph.ml
View file @
9fca1eb5
...
...
@@ -646,24 +646,6 @@ module G_graph = struct
|>
(
shift_in
loc
?
domain
src_gid
tar_gid
is_gid_local
label_cst
)
|>
(
shift_out
loc
?
domain
src_gid
tar_gid
is_gid_local
label_cst
)
(* -------------------------------------------------------------------------------- *)
let
merge_node
loc
?
domain
graph
is_gid_local
src_gid
tar_gid
=
let
se_graph
=
shift_edges
loc
?
domain
src_gid
tar_gid
is_gid_local
Label_cst
.
all
graph
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
match
G_fs
.
unif
(
G_node
.
get_fs
src_node
)
(
G_node
.
get_fs
tar_node
)
with
|
Some
new_fs
->
Some
{
graph
with
map
=
(
Gid_map
.
add
tar_gid
(
G_node
.
set_fs
new_fs
tar_node
)
(
Gid_map
.
remove
src_gid
se_graph
.
map
)
)
}
|
None
->
None
(* -------------------------------------------------------------------------------- *)
let
set_feat
?
loc
?
domain
graph
node_id
feat_name
new_value
=
let
node
=
Gid_map
.
find
node_id
graph
.
map
in
...
...
src/grew_graph.mli
View file @
9fca1eb5
...
...
@@ -144,8 +144,6 @@ module G_graph: sig
val
add_before
:
Loc
.
t
->
?
domain
:
Domain
.
t
->
Gid
.
t
->
t
->
(
Gid
.
t
*
t
)
val
add_after
:
Loc
.
t
->
?
domain
:
Domain
.
t
->
Gid
.
t
->
t
->
(
Gid
.
t
*
t
)
val
merge_node
:
Loc
.
t
->
?
domain
:
Domain
.
t
->
t
->
(
Gid
.
t
->
bool
)
->
Gid
.
t
->
Gid
.
t
->
t
option
(** move all in arcs to id_src are moved to in arcs on node id_tar from graph, with all its incoming edges *)
val
shift_in
:
Loc
.
t
->
?
domain
:
Domain
.
t
->
Gid
.
t
->
Gid
.
t
->
(
Gid
.
t
->
bool
)
->
Label_cst
.
t
->
t
->
t
...
...
src/grew_lexer.mll
View file @
9fca1eb5
...
...
@@ -169,7 +169,7 @@ and standard target = parse
|
"shift_in"
{
SHIFT_IN
}
|
"shift_out"
{
SHIFT_OUT
}
|
"shift"
{
SHIFT
}
|
"merge"
{
MERGE
}
|
"merge"
{
raise
(
Error
"merge commnand was removed since version 0.43"
)
}
|
"del_node"
{
DEL_NODE
}
|
"add_node"
{
ADD_NODE
}
|
"del_feat"
{
DEL_FEAT
}
...
...
src/grew_parser.mly
View file @
9fca1eb5
...
...
@@ -89,7 +89,6 @@ let localize t = (t,get_loc ())
%
token
DEL_EDGE
/*
del_edge
*/
%
token
ADD_EDGE
/*
add_edge
*/
%
token
MERGE
/*
merge
*/
%
token
SHIFT_IN
/*
shift_in
*/
%
token
SHIFT_OUT
/*
shift_out
*/
%
token
SHIFT
/*
shift
*/
...
...
@@ -650,10 +649,6 @@ command:
tar
=
simple_id
{
let
(
src
,
loc
)
=
src_loc
in
(
Ast
.
Shift_edge
(
src
,
tar
,
Ast
.
Neg_list
labels
)
,
loc
)
}
/*
merge
m
==>
n
*/
|
MERGE
src_loc
=
simple_id_with_loc
ARROW
tar
=
simple_id
{
let
(
src
,
loc
)
=
src_loc
in
(
Ast
.
Merge_node
(
src
,
tar
)
,
loc
)
}
/*
del_node
n
*/
|
DEL_NODE
ci_loc
=
simple_id_with_loc
{
let
(
ci
,
loc
)
=
ci_loc
in
(
Ast
.
Del_node
(
ci
)
,
loc
)
}
...
...
src/grew_rule.ml
View file @
9fca1eb5
...
...
@@ -881,11 +881,8 @@ module Rule = struct
extend_matching
?
domain
(
positive
,
neg
)
graph
new_partial
with
P_fs
.
Fail
->
[]
(* ---------------------------------------------------------------------- *)
(* the exception below is added to handle unification failure in merge!! *)
exception
Command_execution_fail
(* [in_img node_gid n_match] checks if [node_gid] belongs to the codomain of [n_match] *)
(* [test_locality matching created_nodes gid] checks if [gid] is a "local" node:
either it belongs to the codomain of [matching] or it is one of the [created_nodes] *)
let
test_locality
matching
created_nodes
gid
=
(
Pid_map
.
exists
(
fun
_
id
->
id
=
gid
)
matching
.
n_match
)
||
(
List
.
exists
(
fun
(
_
,
id
)
->
id
=
gid
)
created_nodes
)
...
...
@@ -966,21 +963,6 @@ module Rule = struct
created_nodes
)
|
Command
.
MERGE_NODE
(
src_cn
,
tar_cn
)
->
let
src_gid
=
node_find
src_cn
in
let
tar_gid
=
node_find
tar_cn
in
(
match
G_graph
.
merge_node
loc
?
domain
instance
.
Instance
.
graph
(
test_locality
matching
created_nodes
)
src_gid
tar_gid
with
|
Some
new_graph
->
(
{
instance
with
Instance
.
graph
=
new_graph
;
history
=
List_
.
sort_insert
(
Command
.
H_MERGE_NODE
(
src_gid
,
tar_gid
))
instance
.
Instance
.
history
}
,
created_nodes
)
|
None
->
raise
Command_execution_fail
)
|
Command
.
UPDATE_FEAT
(
tar_cn
,
tar_feat_name
,
item_list
)
->
let
tar_gid
=
node_find
tar_cn
in
let
rule_items
=
List
.
map
...
...
@@ -1084,8 +1066,7 @@ module Rule = struct
)
(* ---------------------------------------------------------------------- *)
(** [apply_rule instance matching rule] returns a new instance after the application of the rule
[Command_execution_fail] is raised if some merge unification fails *)
(** [apply_rule instance matching rule] returns a new instance after the application of the rule *)
let
apply_rule
?
domain
modul_name
instance
matching
rule
=
(* Timeout check *)
...
...
@@ -1193,8 +1174,7 @@ module Rule = struct
let
matching_list
=
match_in_graph
?
domain
?
param
:
rule
.
param
rule
.
pattern
instance
.
Instance
.
graph
in
List
.
fold_left
(
fun
acc1
matching
->
try
Instance_set
.
add
(
apply_rule
?
domain
modul_name
instance
matching
rule
)
acc1
with
Command_execution_fail
->
acc1
Instance_set
.
add
(
apply_rule
?
domain
modul_name
instance
matching
rule
)
acc1
)
acc
matching_list
)
Instance_set
.
empty
rules
...
...
Write
Preview
Supports
Markdown
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