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
27caa03b
Commit
27caa03b
authored
Mar 01, 2017
by
Bruno Guillaume
Browse files
Check for duplicate node identifiers at building time
parent
b9e5ea66
Changes
3
Hide whitespace changes
Inline
Side-by-side
src/grew_ast.ml
View file @
27caa03b
...
...
@@ -161,6 +161,35 @@ module Ast = struct
pat_negs
:
basic
list
;
}
let
check_duplicate_edge_identifier
basic
=
let
ids
=
List_
.
opt_map
(
function
({
edge_id
=
Some
e
}
,
loc
)
->
Some
(
e
,
loc
)
|
_
->
None
)
basic
.
pat_edges
in
let
rec
loop
=
function
|
[]
->
()
|
(
x
,
loc
)
::
t
when
List
.
exists
(
fun
(
y
,_
)
->
x
=
y
)
t
->
Error
.
build
~
loc
"The identifier '%s' is used twice"
x
|
_
::
t
->
loop
t
in
loop
ids
let
normalize_pattern
pattern
=
check_duplicate_edge_identifier
pattern
.
pat_pos
;
{
pattern
with
pat_negs
=
List
.
map
(
fun
pat_neg
->
{
pat_neg
with
pat_edges
=
List
.
map
(
fun
(
u_edge
,
loc
)
->
match
u_edge
.
edge_id
with
|
None
->
(
u_edge
,
loc
)
|
Some
id
->
Log
.
fwarning
"[%s] identifier
\"
%s
\"
is useless in without part"
(
Loc
.
to_string
loc
)
id
;
({
u_edge
with
edge_id
=
None
}
,
loc
)
)
pat_neg
.
pat_edges
}
)
pattern
.
pat_negs
}
let
add_implicit_node
loc
aux
name
pat_nodes
=
if
(
List
.
exists
(
fun
({
node_id
}
,_
)
->
node_id
=
name
)
pat_nodes
)
||
(
List
.
exists
(
fun
({
node_id
}
,_
)
->
node_id
=
name
)
aux
)
...
...
src/grew_ast.mli
View file @
27caa03b
...
...
@@ -121,6 +121,10 @@ module Ast : sig
pat_negs
:
basic
list
;
}
(* [check for duplicate edge identifier in pos part and
remove edge identifier in neg part] *)
val
normalize_pattern
:
pattern
->
pattern
val
complete_pattern
:
pattern
->
pattern
type
concat_item
=
...
...
src/grew_rule.ml
View file @
27caa03b
...
...
@@ -395,8 +395,9 @@ module Rule = struct
|
_
->
()
);
let
pattern
=
Ast
.
normalize_pattern
rule_ast
.
Ast
.
pattern
in
let
(
pos
,
pos_table
)
=
try
build_pos_basic
?
domain
~
pat_vars
rule_ast
.
Ast
.
pattern
.
Ast
.
pat_pos
try
build_pos_basic
?
domain
~
pat_vars
pattern
.
Ast
.
pat_pos
with
P_fs
.
Fail_unif
->
Error
.
build
~
loc
:
rule_ast
.
Ast
.
rule_loc
"[Rule.build] in rule
\"
%s
\"
: feature structures declared in the
\"
match
\"
clause are inconsistent"
...
...
@@ -409,7 +410,7 @@ module Rule = struct
Log
.
fwarning
"In rule
\"
%s
\"
[%s], the wihtout number %d cannot be satisfied, it is skipped"
rule_ast
.
Ast
.
rule_id
(
Loc
.
to_string
rule_ast
.
Ast
.
rule_loc
)
pos
;
(
acc
,
pos
+
1
)
)
([]
,
1
)
rule_ast
.
Ast
.
pattern
.
Ast
.
pat_negs
in
)
([]
,
1
)
pattern
.
Ast
.
pat_negs
in
{
name
=
rule_ast
.
Ast
.
rule_id
;
pattern
=
(
pos
,
negs
);
...
...
@@ -420,14 +421,15 @@ module Rule = struct
}
let
build_pattern
?
domain
pattern_ast
=
let
n_pattern
=
Ast
.
normalize_pattern
pattern_ast
in
let
(
pos
,
pos_table
)
=
try
build_pos_basic
?
domain
pattern
_ast
.
Ast
.
pat_pos
try
build_pos_basic
?
domain
n_
pattern
.
Ast
.
pat_pos
with
P_fs
.
Fail_unif
->
Error
.
build
"feature structures declared in the
\"
match
\"
clause are inconsistent "
in
let
negs
=
List_
.
try_map
P_fs
.
Fail_unif
(* Skip the without parts that are incompatible with the match part *)
(
fun
basic_ast
->
build_neg_basic
?
domain
pos_table
basic_ast
)
pattern
_ast
.
Ast
.
pat_negs
in
n_
pattern
.
Ast
.
pat_negs
in
(
pos
,
negs
)
(* ====================================================================== *)
...
...
GUILLAUME Bruno
@guillaum
mentioned in issue
#1 (closed)
·
Mar 01, 2017
mentioned in issue
#1 (closed)
mentioned in issue #1
Toggle commit list
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