Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
grew
libcaml-grew
Commits
84bd1cdf
Commit
84bd1cdf
authored
Jul 18, 2017
by
Bruno Guillaume
Browse files
* Type of Graph.node_matching changed!
New ordering of graph nodes (two subsets)
parent
c51a331f
Changes
9
Hide whitespace changes
Inline
Side-by-side
src/grew_fs.ml
View file @
84bd1cdf
...
...
@@ -382,11 +382,14 @@ module P_fs = struct
let
check_position
?
param
position
t
=
try
match
List
.
assoc
"position"
t
with
|
{
P_feature
.
cst
=
P_feature
.
Equal
pos_list
;
in_param
=
[]
}
->
List
.
mem
(
Float
position
)
pos_list
|
{
P_feature
.
cst
=
P_feature
.
Different
pos_list
;
in_param
=
[]
}
->
not
(
List
.
mem
(
Float
position
)
pos_list
)
|
{
P_feature
.
cst
=
P_feature
.
Absent
}
->
false
|
_
->
Error
.
bug
"Position can't be parametrized"
match
(
List
.
assoc
"position"
t
,
position
)
with
|
({
P_feature
.
cst
=
P_feature
.
Equal
pos_list
;
in_param
=
[]
}
,
Some
p
)
->
List
.
mem
(
Float
p
)
pos_list
|
({
P_feature
.
cst
=
P_feature
.
Equal
pos_list
;
in_param
=
[]
}
,
None
)
->
false
|
({
P_feature
.
cst
=
P_feature
.
Different
pos_list
;
in_param
=
[]
}
,
Some
p
)
->
not
(
List
.
mem
(
Float
p
)
pos_list
)
|
({
P_feature
.
cst
=
P_feature
.
Different
pos_list
;
in_param
=
[]
}
,
None
)
->
false
|
({
P_feature
.
cst
=
P_feature
.
Absent
}
,
Some
_
)
->
false
|
({
P_feature
.
cst
=
P_feature
.
Absent
}
,
None
)
->
true
|
_
->
Error
.
bug
"Position can't be parametrized"
with
Not_found
->
true
let
build
?
domain
?
pat_vars
ast_fs
=
...
...
src/grew_fs.mli
View file @
84bd1cdf
...
...
@@ -97,7 +97,7 @@ module P_fs: sig
(** [check_position ?parma position pfs] checks wheter [pfs] is compatible with a node at [position].
It returns [true] iff [pfs] has no requirement about position ok if the requirement is satisfied. *)
val
check_position
:
?
param
:
Lex_par
.
t
->
float
->
t
->
bool
val
check_position
:
?
param
:
Lex_par
.
t
->
float
option
->
t
->
bool
exception
Fail_unif
...
...
src/grew_graph.ml
View file @
84bd1cdf
...
...
@@ -296,8 +296,8 @@ module G_graph = struct
let
node
=
Gid_map
.
find
node_id
graph
.
map
in
Massoc_gid
.
exists
(
fun
_
e
->
Label_cst
.
match_
?
domain
label_cst
e
)
(
G_node
.
get_next
node
)
let
get_annot_info
graph
=
let
annot_info
=
let
get_annot_info
graph
=
failwith
"Unused function !"
(*
let annot_info =
Gid_map.fold
(fun _ node acc ->
match (G_node.get_annot_info node, acc) with
...
...
@@ -307,7 +307,7 @@ module G_graph = struct
) graph.map None in
match annot_info with
| Some x -> x
|
None
->
Error
.
build
"[G_node.get_annot_info] No nodes with annot info"
| None -> Error.build "[G_node.get_annot_info] No nodes with annot info"
*)
(* -------------------------------------------------------------------------------- *)
let
map_add_edge_opt
map
id_src
label
id_tar
=
...
...
@@ -350,7 +350,7 @@ module G_graph = struct
else
let
(
new_tail
,
table
)
=
loop
(
node_id
::
already_bound
)
(
index
+
1
)
(
Some
index
)
tail
in
let
succ
=
if
tail
=
[]
then
None
else
Some
(
index
+
1
)
in
let
new_node
=
G_node
.
build
?
domain
?
prec
?
succ
index
(
ast_node
,
loc
)
in
let
new_node
=
G_node
.
build
?
domain
?
prec
?
succ
~
position
:
(
float
index
)
(
ast_node
,
loc
)
in
(
Gid_map
.
add
index
new_node
new_tail
,
(
node_id
,
index
)
::
table
...
...
@@ -529,54 +529,62 @@ module G_graph = struct
{
graph
with
map
=
new_map
}
(* -------------------------------------------------------------------------------- *)
let
insert
?
domain
id1
id2
graph
=
let
insert
id1
id2
graph
=
let
node1
=
Gid_map
.
find
id1
graph
.
map
in
let
node2
=
Gid_map
.
find
id2
graph
.
map
in
let
pos
1
=
G_node
.
get_position
node1
in
let
pos
2
=
G_node
.
get_position
node2
in
let
new_pos
=
(
pos1
+.
pos2
)
/.
2
.
in
let
new_
pos
=
match
(
G_node
.
get_position
node1
,
G_node
.
get_position
node2
)
with
|
(
G_node
.
Ordered
pos
1
,
G_node
.
Ordered
pos2
)
->
(
pos1
+.
pos2
)
/.
2
.
|
_
->
Error
.
run
"Try to insert into non ordered nodes"
in
let
new_gid
=
graph
.
highest_index
+
1
in
let
map
=
graph
.
map
|>
(
Gid_map
.
add
new_gid
(
G_node
.
fresh
?
domain
~
prec
:
id1
~
succ
:
id2
new_pos
))
|>
(
Gid_map
.
add
new_gid
(
G_node
.
fresh
~
prec
:
id1
~
succ
:
id2
new_pos
))
|>
(
Gid_map
.
add
id1
(
G_node
.
set_succ
new_gid
node1
))
|>
(
Gid_map
.
add
id2
(
G_node
.
set_prec
new_gid
node2
))
in
(
new_gid
,
{
graph
with
map
;
highest_index
=
new_gid
})
(* -------------------------------------------------------------------------------- *)
let
append
?
domain
id
graph
=
let
append
id
graph
=
let
node
=
Gid_map
.
find
id
graph
.
map
in
let
pos
=
G_node
.
get_position
node
in
let
new_pos
=
pos
+.
1
.
in
let
new_pos
=
match
G_node
.
get_position
node
with
|
G_node
.
Ordered
pos
->
pos
+.
1
.
|
_
->
Error
.
run
"Try to append into non ordered nodes"
in
let
new_gid
=
graph
.
highest_index
+
1
in
let
map
=
graph
.
map
|>
(
Gid_map
.
add
new_gid
(
G_node
.
fresh
?
domain
~
prec
:
id
new_pos
))
|>
(
Gid_map
.
add
new_gid
(
G_node
.
fresh
~
prec
:
id
new_pos
))
|>
(
Gid_map
.
add
id
(
G_node
.
set_succ
new_gid
node
))
in
(
new_gid
,
{
graph
with
map
;
highest_index
=
new_gid
})
(* -------------------------------------------------------------------------------- *)
let
prepend
?
domain
id
graph
=
let
prepend
id
graph
=
let
node
=
Gid_map
.
find
id
graph
.
map
in
let
pos
=
G_node
.
get_position
node
in
let
new_pos
=
pos
-.
1
.
in
let
new_pos
=
match
G_node
.
get_position
node
with
|
G_node
.
Ordered
pos
->
pos
-.
1
.
|
_
->
Error
.
run
"Try to prepend into non ordered nodes"
in
let
new_gid
=
graph
.
highest_index
+
1
in
let
map
=
graph
.
map
|>
(
Gid_map
.
add
new_gid
(
G_node
.
fresh
?
domain
~
succ
:
id
new_pos
))
|>
(
Gid_map
.
add
new_gid
(
G_node
.
fresh
~
succ
:
id
new_pos
))
|>
(
Gid_map
.
add
id
(
G_node
.
set_prec
new_gid
node
))
in
(
new_gid
,
{
graph
with
map
;
highest_index
=
new_gid
})
(* -------------------------------------------------------------------------------- *)
let
add_after
loc
?
domain
node_id
graph
=
let
add_after
node_id
graph
=
let
node
=
Gid_map
.
find
node_id
graph
.
map
in
match
G_node
.
get_succ
node
with
|
Some
gid_succ
->
insert
?
domain
node_id
gid_succ
graph
|
None
->
append
?
domain
node_id
graph
|
Some
gid_succ
->
insert
node_id
gid_succ
graph
|
None
->
append
node_id
graph
(* -------------------------------------------------------------------------------- *)
let
add_before
loc
?
domain
node_id
graph
=
let
add_before
node_id
graph
=
let
node
=
Gid_map
.
find
node_id
graph
.
map
in
match
G_node
.
get_prec
node
with
|
Some
gid_prec
->
insert
?
domain
gid_prec
node_id
graph
|
None
->
prepend
?
domain
node_id
graph
|
Some
gid_prec
->
insert
gid_prec
node_id
graph
|
None
->
prepend
node_id
graph
(* -------------------------------------------------------------------------------- *)
let
add_unordered
graph
=
let
new_gid
=
graph
.
highest_index
+
1
in
let
map
=
Gid_map
.
add
new_gid
(
G_node
.
fresh_unordered
()
)
graph
.
map
in
(
new_gid
,
{
graph
with
map
;
highest_index
=
new_gid
})
(* -------------------------------------------------------------------------------- *)
(* move out-edges (which respect cst [labels,neg]) from id_src are moved to out-edges out off node id_tar *)
...
...
@@ -661,7 +669,11 @@ module G_graph = struct
(
function
|
Concat_item
.
Feat
(
node_gid
,
"position"
)
->
let
node
=
Gid_map
.
find
node_gid
graph
.
map
in
sprintf
"%g"
(
G_node
.
get_position
node
)
begin
match
G_node
.
get_position
node
with
|
G_node
.
Ordered
p
->
sprintf
"%g"
p
|
_
->
Error
.
run
?
loc
"Try to read position of an unordered node"
end
|
Concat_item
.
Feat
(
node_gid
,
feat_name
)
->
let
node
=
Gid_map
.
find
node_gid
graph
.
map
in
(
match
G_fs
.
get_string_atom
feat_name
(
G_node
.
get_fs
node
)
with
...
...
@@ -760,7 +772,8 @@ module G_graph = struct
(
fun
(
id
,
node
)
->
let
decorated_feat
=
try
List
.
assoc
id
deco
.
G_deco
.
nodes
with
Not_found
->
(
""
,
[]
)
in
let
fs
=
G_node
.
get_fs
node
in
let
dep_fs
=
G_fs
.
to_dep
~
decorated_feat
~
position
:
(
G_node
.
get_position
node
)
?
filter
?
main_feat
fs
in
let
pos
=
match
G_node
.
get_position
node
with
G_node
.
Ordered
x
->
Some
x
|
_
->
None
in
let
dep_fs
=
G_fs
.
to_dep
~
decorated_feat
?
position
:
pos
?
filter
?
main_feat
fs
in
let
style
=
match
G_fs
.
get_string_atom
"void"
fs
with
|
Some
"y"
->
"; forecolor=red; subcolor=red; "
...
...
@@ -884,7 +897,7 @@ module G_graph = struct
let
gnode
=
List
.
assoc
gid
snodes
in
if
G_node
.
is_conll_root
gnode
then
0
.
else
G_node
.
get_
position
(
List
.
assoc
gid
snodes
)
in
else
G_node
.
get_
float
(
List
.
assoc
gid
snodes
)
in
(* Warning: [govs_labs] maps [gid]s to [num]s *)
let
govs_labs
=
...
...
src/grew_graph.mli
View file @
84bd1cdf
...
...
@@ -137,8 +137,9 @@ module G_graph: sig
[graph] is unchanged if the node is not in it. *)
val
del_node
:
t
->
Gid
.
t
->
t
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
add_before
:
Gid
.
t
->
t
->
(
Gid
.
t
*
t
)
val
add_after
:
Gid
.
t
->
t
->
(
Gid
.
t
*
t
)
val
add_unordered
:
t
->
(
Gid
.
t
*
t
)
(** 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_node.ml
View file @
84bd1cdf
...
...
@@ -20,13 +20,17 @@ open Grew_fs
(* ================================================================================ *)
module
G_node
=
struct
type
position
=
|
Ordered
of
float
|
Unordered
of
int
type
t
=
{
name
:
Id
.
name
option
;
fs
:
G_fs
.
t
;
next
:
G_edge
.
t
Massoc_gid
.
t
;
succ
:
Gid
.
t
option
;
prec
:
Gid
.
t
option
;
position
:
float
;
position
:
position
;
conll_root
:
bool
;
efs
:
(
string
*
string
)
list
;
}
...
...
@@ -38,7 +42,9 @@ module G_node = struct
let
set_next
next
t
=
{
t
with
next
}
let
get_position
t
=
t
.
position
let
set_position
position
t
=
{
t
with
position
}
let
set_position
p
t
=
{
t
with
position
=
Ordered
p
}
let
get_float
t
=
match
t
.
position
with
Ordered
p
->
p
|
Unordered
i
->
float
i
let
get_prec
t
=
t
.
prec
let
get_succ
t
=
t
.
succ
...
...
@@ -53,7 +59,7 @@ module G_node = struct
|
Some
n
->
n
|
None
->
sprintf
"_%s_"
(
Gid
.
to_string
gid
)
let
empty
=
{
name
=
None
;
fs
=
G_fs
.
empty
;
next
=
Massoc_gid
.
empty
;
succ
=
None
;
prec
=
None
;
position
=
-
1
.
;
conll_root
=
false
;
efs
=
[]
}
let
empty
=
{
name
=
None
;
fs
=
G_fs
.
empty
;
next
=
Massoc_gid
.
empty
;
succ
=
None
;
prec
=
None
;
position
=
Unordered
0
;
conll_root
=
false
;
efs
=
[]
}
let
is_conll_root
t
=
t
.
conll_root
...
...
@@ -75,9 +81,13 @@ module G_node = struct
let
get_annot_info
t
=
G_fs
.
get_annot_info
t
.
fs
let
build
?
domain
?
prec
?
succ
position
(
ast_node
,
loc
)
=
let
current_index
=
ref
0
let
fresh_index
()
=
decr
current_index
;
!
current_index
let
build
?
domain
?
prec
?
succ
?
position
(
ast_node
,
loc
)
=
let
fs
=
G_fs
.
build
?
domain
ast_node
.
Ast
.
fs
in
{
empty
with
name
=
Some
ast_node
.
Ast
.
node_id
;
fs
;
position
=
float_of_int
position
;
prec
;
succ
}
let
pos
=
match
position
with
None
->
Unordered
(
fresh_index
()
)
|
Some
p
->
Ordered
p
in
{
empty
with
name
=
Some
ast_node
.
Ast
.
node_id
;
fs
;
position
=
pos
;
prec
;
succ
}
let
float_of_conll_id
=
function
|
(
i
,
None
)
->
float
i
...
...
@@ -87,14 +97,15 @@ module G_node = struct
let
of_conll
?
loc
?
prec
?
succ
?
domain
line
=
if
line
=
Conll
.
root
then
{
empty
with
conll_root
=
true
;
succ
}
else
{
empty
with
fs
=
G_fs
.
of_conll
?
loc
?
domain
line
;
position
=
float_of_conll_id
line
.
Conll
.
id
;
prec
;
succ
;
efs
=
line
.
Conll
.
efs
}
else
{
empty
with
fs
=
G_fs
.
of_conll
?
loc
?
domain
line
;
position
=
Ordered
(
float_of_conll_id
line
.
Conll
.
id
)
;
prec
;
succ
;
efs
=
line
.
Conll
.
efs
}
let
pst_leaf
?
loc
?
domain
phon
position
=
{
empty
with
fs
=
G_fs
.
pst_leaf
?
loc
?
domain
phon
;
position
=
float
position
}
{
empty
with
fs
=
G_fs
.
pst_leaf
?
loc
?
domain
phon
;
position
=
Ordered
(
float
position
)
}
let
pst_node
?
loc
?
domain
cat
position
=
{
empty
with
fs
=
G_fs
.
pst_node
?
loc
?
domain
cat
;
position
=
float
position
}
{
empty
with
fs
=
G_fs
.
pst_node
?
loc
?
domain
cat
;
position
=
Ordered
(
float
position
)
}
(* TODO : change to Unordered *)
let
fresh
?
domain
?
prec
?
succ
position
=
{
empty
with
position
;
prec
;
succ
}
let
fresh
?
prec
?
succ
pos
=
{
empty
with
position
=
Ordered
pos
;
prec
;
succ
}
let
fresh_unordered
()
=
{
empty
with
position
=
Unordered
(
fresh_index
()
)}
let
remove
(
id_tar
:
Gid
.
t
)
label
t
=
{
t
with
next
=
Massoc_gid
.
remove
id_tar
label
t
.
next
}
...
...
@@ -169,9 +180,12 @@ module P_node = struct
let
match_
?
param
p_node
g_node
=
(* (match param with None -> printf "<None>" | Some p -> printf "<Some>"; Lex_par.dump p); *)
if
P_fs
.
check_position
?
param
(
G_node
.
get_position
g_node
)
p_node
.
fs
then
P_fs
.
match_
?
param
p_node
.
fs
(
G_node
.
get_fs
g_node
)
else
raise
P_fs
.
Fail
match
G_node
.
get_position
g_node
with
|
G_node
.
Unordered
_
->
None
|
G_node
.
Ordered
p
->
if
P_fs
.
check_position
?
param
(
Some
p
)
p_node
.
fs
then
P_fs
.
match_
?
param
p_node
.
fs
(
G_node
.
get_fs
g_node
)
else
raise
P_fs
.
Fail
let
compare_pos
t1
t2
=
Pervasives
.
compare
t1
.
loc
t2
.
loc
end
(* module P_node *)
src/grew_node.mli
View file @
84bd1cdf
...
...
@@ -19,6 +19,11 @@ open Grew_ast
(* ================================================================================ *)
module
G_node
:
sig
type
position
=
|
Ordered
of
float
|
Unordered
of
int
type
t
val
empty
:
t
...
...
@@ -40,6 +45,10 @@ module G_node: sig
val
set_fs
:
G_fs
.
t
->
t
->
t
val
set_position
:
float
->
t
->
t
val
get_position
:
t
->
position
val
get_float
:
t
->
float
val
set_next
:
G_edge
.
t
Massoc_gid
.
t
->
t
->
t
val
get_name
:
Gid
.
t
->
t
->
string
...
...
@@ -57,14 +66,16 @@ module G_node: sig
val
rm_out_edges
:
t
->
t
val
add_edge
:
G_edge
.
t
->
Gid
.
t
->
t
->
t
option
val
build
:
?
domain
:
Domain
.
t
->
?
prec
:
Gid
.
t
->
?
succ
:
Gid
.
t
->
int
->
Ast
.
node
->
t
val
build
:
?
domain
:
Domain
.
t
->
?
prec
:
Gid
.
t
->
?
succ
:
Gid
.
t
->
?
position
:
float
->
Ast
.
node
->
t
val
of_conll
:
?
loc
:
Loc
.
t
->
?
prec
:
Gid
.
t
->
?
succ
:
Gid
.
t
->
?
domain
:
Domain
.
t
->
Conll
.
line
->
t
val
pst_leaf
:
?
loc
:
Loc
.
t
->
?
domain
:
Domain
.
t
->
string
->
int
->
t
val
pst_node
:
?
loc
:
Loc
.
t
->
?
domain
:
Domain
.
t
->
string
->
int
->
t
val
fresh
:
?
domain
:
Domain
.
t
->
?
prec
:
Gid
.
t
->
?
succ
:
Gid
.
t
->
float
->
t
val
fresh
:
?
prec
:
Gid
.
t
->
?
succ
:
Gid
.
t
->
float
->
t
val
fresh_unordered
:
unit
->
t
val
get_position
:
t
->
float
val
position_comp
:
t
->
t
->
int
...
...
src/grew_rule.ml
View file @
84bd1cdf
...
...
@@ -594,7 +594,7 @@ module Rule = struct
(
fun
pid
gid
acc
->
let
pnode
=
P_graph
.
find
pid
(
fst
pattern
)
.
graph
in
let
gnode
=
G_graph
.
find
gid
graph
in
(
P_node
.
get_name
pnode
,
int_of_float
(
G_node
.
get_
position
gnode
)
)
::
acc
(
P_node
.
get_name
pnode
,
G_node
.
get_
float
gnode
)
::
acc
)
n_match
[]
let
empty_matching
param
=
{
n_match
=
Pid_map
.
empty
;
e_match
=
[]
;
m_param
=
param
;}
...
...
@@ -684,10 +684,20 @@ module Rule = struct
let
apply_cst
?
domain
graph
matching
cst
=
let
get_node
pid
=
G_graph
.
find
(
Pid_map
.
find
pid
matching
.
n_match
)
graph
in
let
get_string_feat
pid
=
function
|
"position"
->
Some
(
sprintf
"%g"
(
G_node
.
get_position
(
get_node
pid
)))
|
"position"
->
begin
match
G_node
.
get_position
(
get_node
pid
)
with
|
G_node
.
Ordered
f
->
Some
(
sprintf
"%g"
f
)
|
_
->
Error
.
run
"Cannot read position of an unordered node"
end
|
feat_name
->
G_fs
.
get_string_atom
feat_name
(
G_node
.
get_fs
(
get_node
pid
))
in
let
get_float_feat
pid
=
function
|
"position"
->
Some
(
G_node
.
get_position
(
get_node
pid
))
|
"position"
->
begin
match
G_node
.
get_position
(
get_node
pid
)
with
|
G_node
.
Ordered
f
->
Some
f
|
_
->
Error
.
run
"Cannot read position of an unordered node"
end
|
feat_name
->
G_fs
.
get_float_feat
feat_name
(
G_node
.
get_fs
(
get_node
pid
))
in
match
cst
with
...
...
@@ -1002,33 +1012,32 @@ module Rule = struct
|
Command
.
NEW_AFTER
(
created_name
,
base_cn
)
->
let
base_gid
=
node_find
base_cn
in
let
(
new_gid
,
new_graph
)
=
G_graph
.
add_after
loc
?
domain
base_gid
instance
.
Instance
.
graph
in
let
(
new_gid
,
new_graph
)
=
G_graph
.
add_after
base_gid
instance
.
Instance
.
graph
in
(
{
instance
with
Instance
.
graph
=
new_graph
;
history
=
List_
.
sort_insert
(
Command
.
H_NEW_AFTER
(
created_name
,
new
_gid
))
instance
.
Instance
.
history
;
history
=
List_
.
sort_insert
(
Command
.
H_NEW_AFTER
(
created_name
,
base
_gid
))
instance
.
Instance
.
history
;
}
,
(
created_name
,
new_gid
)
::
created_nodes
)
|
Command
.
NEW_NODE
(
created_name
)
->
let
base_gid
=
G_graph
.
get_highest
instance
.
Instance
.
graph
in
let
(
new_gid
,
new_graph
)
=
G_graph
.
add_after
loc
?
domain
base_gid
instance
.
Instance
.
graph
in
let
(
new_gid
,
new_graph
)
=
G_graph
.
add_unordered
instance
.
Instance
.
graph
in
(
{
instance
with
Instance
.
graph
=
new_graph
;
history
=
List_
.
sort_insert
(
Command
.
H_NEW_
AFTER
(
created_name
,
new_gid
)
)
instance
.
Instance
.
history
;
history
=
List_
.
sort_insert
(
Command
.
H_NEW_
NODE
created_name
)
instance
.
Instance
.
history
;
}
,
(
created_name
,
new_gid
)
::
created_nodes
)
|
Command
.
NEW_BEFORE
(
created_name
,
base_cn
)
->
let
base_gid
=
node_find
base_cn
in
let
(
new_gid
,
new_graph
)
=
G_graph
.
add_before
loc
?
domain
base_gid
instance
.
Instance
.
graph
in
let
(
new_gid
,
new_graph
)
=
G_graph
.
add_before
base_gid
instance
.
Instance
.
graph
in
(
{
instance
with
Instance
.
graph
=
new_graph
;
history
=
List_
.
sort_insert
(
Command
.
H_NEW_BEFORE
(
created_name
,
new
_gid
))
instance
.
Instance
.
history
;
history
=
List_
.
sort_insert
(
Command
.
H_NEW_BEFORE
(
created_name
,
base
_gid
))
instance
.
Instance
.
history
;
}
,
(
created_name
,
new_gid
)
::
created_nodes
)
...
...
@@ -1317,8 +1326,4 @@ module Rule = struct
Some
(
apply_rule
?
domain
instance
first_matching_where_all_witout_are_fulfilled
rule
)
with
Not_found
->
None
end
(* module Rule *)
src/grew_rule.mli
View file @
84bd1cdf
...
...
@@ -109,7 +109,7 @@ module Rule : sig
val
build_pattern
:
?
domain
:
Domain
.
t
->
Ast
.
pattern
->
pattern
(** [node_matching pattern graph matching] return a assoc list (pid_name, gid.position) *)
val
node_matching
:
pattern
->
G_graph
.
t
->
matching
->
(
string
*
in
t
)
list
val
node_matching
:
pattern
->
G_graph
.
t
->
matching
->
(
string
*
floa
t
)
list
(** [match_in_graph rule graph] returns the list of matching of the pattern of the rule into the graph *)
val
match_in_graph
:
?
domain
:
Domain
.
t
->
?
param
:
Lex_par
.
t
->
pattern
->
G_graph
.
t
->
matching
list
...
...
src/libgrew.mli
View file @
84bd1cdf
...
...
@@ -100,7 +100,7 @@ module Graph : sig
(** [search_pattern pattern graph] returns the list of the possible matching of [pattern] in [graph] *)
val
search_pattern
:
?
domain
:
Domain
.
t
->
Pattern
.
t
->
t
->
Matching
.
t
list
val
node_matching
:
Pattern
.
t
->
t
->
Matching
.
t
->
(
string
*
in
t
)
list
val
node_matching
:
Pattern
.
t
->
t
->
Matching
.
t
->
(
string
*
floa
t
)
list
end
(* ==================================================================================================== *)
...
...
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