Skip to content
Projects
Groups
Snippets
Help
Loading...
Sign in
Toggle navigation
L
libcamlgrew
Project
Project
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
8
Issues
8
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
Registry
Registry
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Commits
Issue Boards
Open sidebar
grew
libcamlgrew
Commits
088c6085
Commit
088c6085
authored
May 04, 2018
by
Bruno Guillaume
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
version 0.47.2: Dealing with increasing Grs
parent
b916663c
Hide whitespace changes
Inline
Sidebyside
Showing
6 changed files
with
41 additions
and
20 deletions
+41
20
CHANGES.md
CHANGES.md
+4
1
VERSION
VERSION
+2
2
grew_graph.ml
src/grew_graph.ml
+6
3
grew_graph.mli
src/grew_graph.mli
+1
0
grew_grs.ml
src/grew_grs.ml
+4
2
grew_rule.ml
src/grew_rule.ml
+24
12
No files found.
CHANGES.md
View file @
088c6085
## 0.47.2 (2018/05/04)
*
Deal with increasing Grs
## 0.47.1 (2018/03/16)
*
f
ix bug in grs loading with relative path
*
F
ix bug in grs loading with relative path
# 0.47.0 (2018/03/13)
*
Add conll_fields in domain definition
...
...
VERSION
View file @
088c6085
0.47.1
\ No newline at end of file
0.47.2
\ No newline at end of file
src/grew_graph.ml
View file @
088c6085
...
...
@@ 1088,7 +1088,9 @@ module Delta = struct
let
set_feat
seed_graph
gid
feat_name
new_val_opt
t
=
(* equal_orig is true iff new val is the same as the one in seed_graph *)
let
equal_orig
=
(
new_val_opt
=
G_fs
.
get_atom
feat_name
(
G_node
.
get_fs
(
G_graph
.
find
gid
seed_graph
)))
in
let
equal_orig
=
try
(
new_val_opt
=
G_fs
.
get_atom
feat_name
(
G_node
.
get_fs
(
G_graph
.
find
gid
seed_graph
)))
with
Not_found
>
false
(* when gid is in created nodes *)
in
let
rec
loop
=
fun
old
>
match
old
with

[]
when
equal_orig
>
[]

[]
>
[(
gid
,
feat_name
)
,
new_val_opt
]
...
...
@@ 1105,12 +1107,13 @@ module Graph_with_history = struct
seed
:
G_graph
.
t
;
delta
:
Delta
.
t
;
graph
:
G_graph
.
t
;
added_gids
:
(
string
*
Gid
.
t
)
list
;
}
let
from_graph
graph
=
{
graph
;
seed
=
graph
;
delta
=
Delta
.
empty
}
let
from_graph
graph
=
{
graph
;
seed
=
graph
;
delta
=
Delta
.
empty
;
added_gids
=
[]
}
(* WARNING: compare is correct only on data with the same seed! *)
let
compare
t1
t2
=
Pervasives
.
compare
t1
.
delta
t2
.
delta
let
compare
t1
t2
=
Pervasives
.
compare
(
t1
.
delta
,
t1
.
added_gids
)
(
t2
.
delta
,
t2
.
added_gids
)
end
(* module Graph_with_history*)
module
Graph_with_history_set
=
Set
.
Make
(
Graph_with_history
)
src/grew_graph.mli
View file @
088c6085
...
...
@@ 215,6 +215,7 @@ module Graph_with_history : sig
seed
:
G_graph
.
t
;
delta
:
Delta
.
t
;
graph
:
G_graph
.
t
;
added_gids
:
(
string
*
Gid
.
t
)
list
;
}
val
from_graph
:
G_graph
.
t
>
t
...
...
src/grew_grs.ml
View file @
088c6085
...
...
@@ 1144,11 +1144,13 @@ module Grs = struct
)
in
loop
(
Graph_with_history_set
.
singleton
gwh
,
Graph_with_history_set
.
empty
,
Graph_with_history_set
.
empty
)
let
gwh_simple_rewrite
grs
strat
graph
=
let
gwh_simple_rewrite
grs
strat_string
graph
=
let
domain
=
domain
grs
in
let
casted_graph
=
G_graph
.
cast
?
domain
graph
in
let
strat
=
Parser
.
strategy
strat_string
in
let
gwh
=
Graph_with_history
.
from_graph
casted_graph
in
let
set
=
gwh_strat_simple_rewrite
?
domain
(
top
grs
)
(
Parser
.
strategy
strat
)
gwh
in
let
set
=
gwh_strat_simple_rewrite
?
domain
(
top
grs
)
strat
gwh
in
List
.
map
(
fun
gwh
>
gwh
.
Graph_with_history
.
graph
)
(
Graph_with_history_set
.
elements
set
)
...
...
src/grew_rule.ml
View file @
088c6085
...
...
@@ 1488,7 +1488,7 @@ module Rule = struct
let
(
new_gid
,
new_graph
)
=
G_graph
.
add_unordered
graph
in
(
new_graph
,
(
created_name
,
new_gid
)
::
created_nodes
,
true
)
let
rec
onf_apply
?
domain
rule
graph
=
let
onf_apply
?
domain
rule
graph
=
let
(
pos
,
negs
)
=
rule
.
pattern
in
(* get the list of partial matching for positive part of the pattern *)
let
matching_list
=
...
...
@@ 1587,16 +1587,16 @@ module Rule = struct
let
find
cnode
?
loc
matching
=
let
find
cnode
?
loc
gwh
matching
=
match
cnode
with

Command
.
Pat
pid
>
(
try
Pid_map
.
find
pid
matching
.
n_match
with
Not_found
>
Error
.
bug
?
loc
"Inconsistent matching pid '%s' not found"
(
Pid
.
to_string
pid
))

Command
.
New
name
>
Error
.
bug
?
loc
"New node must not appear HERE !"
name

Command
.
New
name
>
List
.
assoc
name
gwh
.
Graph_with_history
.
added_gids
let
gwh_apply_command
?
domain
(
command
,
loc
)
gwh
matching
=
let
node_find
cnode
=
find
~
loc
cnode
matching
in
let
node_find
cnode
=
find
~
loc
cnode
gwh
matching
in
match
command
with

Command
.
ADD_EDGE
(
src_cn
,
tar_cn
,
edge
)
>
...
...
@@ 1748,16 +1748,28 @@ module Rule = struct
>
(
List
.
fold_right
(
fun
(
s
,
e
,
t
)
>
Delta
.
add_edge
s
e
t
)
add_edges
)
}

_
>
Error
.
bug
"Add node must not occur here !!!"

Command
.
NEW_AFTER
(
created_name
,
base_cn
)
>
let
base_gid
=
node_find
base_cn
in
let
(
new_gid
,
new_graph
)
=
G_graph
.
add_after
base_gid
gwh
.
Graph_with_history
.
graph
in
{
gwh
with
Graph_with_history
.
graph
=
new_graph
;
added_gids
=
(
created_name
,
new_gid
)
::
gwh
.
Graph_with_history
.
added_gids
}

Command
.
NEW_BEFORE
(
created_name
,
base_cn
)
>
let
base_gid
=
node_find
base_cn
in
let
(
new_gid
,
new_graph
)
=
G_graph
.
add_before
base_gid
gwh
.
Graph_with_history
.
graph
in
{
gwh
with
Graph_with_history
.
graph
=
new_graph
;
added_gids
=
(
created_name
,
new_gid
)
::
gwh
.
Graph_with_history
.
added_gids
}

Command
.
NEW_NODE
(
created_name
)
>
let
(
new_gid
,
new_graph
)
=
G_graph
.
add_unordered
gwh
.
Graph_with_history
.
graph
in
{
gwh
with
Graph_with_history
.
graph
=
new_graph
;
added_gids
=
(
created_name
,
new_gid
)
::
gwh
.
Graph_with_history
.
added_gids
}
(*  *)
(** [apply_rule graph_with_history matching rule] returns a new graph_with_history after the application of the rule *)
...
...
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