Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
L
libcaml-grew
Project overview
Project overview
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
7
Issues
7
List
Boards
Labels
Milestones
Merge Requests
0
Merge Requests
0
Packages
Packages
Container Registry
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Commits
Issue Boards
Open sidebar
grew
libcaml-grew
Commits
4d144edc
Commit
4d144edc
authored
Jun 05, 2018
by
Bruno Guillaume
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
all lexical parameters are “in”
parent
3cecd883
Changes
7
Hide whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
51 additions
and
123 deletions
+51
-123
src/grew_command.ml
src/grew_command.ml
+6
-9
src/grew_command.mli
src/grew_command.mli
+2
-3
src/grew_fs.ml
src/grew_fs.ml
+3
-3
src/grew_fs.mli
src/grew_fs.mli
+1
-1
src/grew_rule.ml
src/grew_rule.ml
+14
-42
src/grew_types.ml
src/grew_types.ml
+17
-57
src/grew_types.mli
src/grew_types.mli
+8
-8
No files found.
src/grew_command.ml
View file @
4d144edc
...
...
@@ -32,8 +32,7 @@ module Command = struct
type
item
=
|
Feat
of
(
command_node
*
string
)
|
String
of
string
|
Param_in
of
int
|
Param_out
of
int
|
Param
of
int
let
item_to_json
=
function
|
Feat
(
cn
,
feature_name
)
->
`Assoc
[(
"copy_feat"
,
...
...
@@ -43,8 +42,7 @@ module Command = struct
]
)]
|
String
s
->
`Assoc
[(
"string"
,
`String
s
)]
|
Param_in
i
->
`Assoc
[(
"param_in"
,
`Int
i
)]
|
Param_out
i
->
`Assoc
[(
"param_out"
,
`Int
i
)]
|
Param
i
->
`Assoc
[(
"param"
,
`Int
i
)]
(* the command in pattern *)
type
p
=
...
...
@@ -266,16 +264,15 @@ module Command = struct
|
Ast
.
Param_item
var
->
match
param
with
|
None
->
Error
.
build
~
loc
"Unknown command variable '%s'"
var
|
Some
(
par
,
cmd
)
->
match
(
List_
.
index
var
par
,
List_
.
index
var
cmd
)
with
|
(
_
,
Some
index
)
->
Param_out
index
|
(
Some
index
,_
)
->
Param_in
index
|
Some
par
->
match
List_
.
index
var
par
with
|
Some
index
->
Param
index
|
_
->
Error
.
build
~
loc
"Unknown command variable '%s'"
var
)
ast_items
in
(* check for consistency *)
(
match
items
with
|
_
when
Domain
.
is_open_feature
?
domain
feat_name
->
()
|
[
Param
_out
_
]
->
()
(* TODO: check that lexical parameters are compatible with the feature domain *)
|
[
Param
_
]
->
()
(* TODO: check that lexical parameters are compatible with the feature domain *)
|
[
String
s
]
->
Domain
.
check_feature
~
loc
?
domain
feat_name
s
|
[
Feat
(
_
,
fn
)]
->
()
|
_
->
Error
.
build
~
loc
"[Update_feat] Only open features can be modified with the concat operator '+' but
\"
%s
\"
is not declared as an open feature"
feat_name
);
...
...
src/grew_command.mli
View file @
4d144edc
...
...
@@ -23,8 +23,7 @@ module Command : sig
type
item
=
|
Feat
of
(
command_node
*
string
)
|
String
of
string
|
Param_in
of
int
|
Param_out
of
int
|
Param
of
int
type
p
=
|
DEL_NODE
of
command_node
...
...
@@ -65,7 +64,7 @@ module Command : sig
val
build
:
?
domain
:
Domain
.
t
->
?
param
:
(
string
list
*
string
list
)
->
?
param
:
string
list
->
(
Id
.
name
list
*
string
list
)
->
Id
.
table
->
Ast
.
command
->
...
...
src/grew_fs.ml
View file @
4d144edc
...
...
@@ -142,7 +142,7 @@ module P_feature = struct
let
to_string
?
param_names
t
=
let
param_string
index
=
match
param_names
with
|
None
->
sprintf
"$%d"
index
|
Some
(
l
,_
)
->
sprintf
"%s"
(
List
.
nth
l
index
)
in
|
Some
l
->
sprintf
"%s"
(
List
.
nth
l
index
)
in
match
t
with
|
(
feat_name
,
{
cst
=
Absent
;
in_param
=
[]
})
->
sprintf
"!%s"
feat_name
...
...
@@ -458,8 +458,8 @@ module P_fs = struct
|
(
None
,_
)
->
Log
.
bug
"[P_fs.match_] Parametrized constraint in a non-parametrized rule"
;
exit
2
|
(
Some
param
,
[
index
])
->
(
match
Lex_par
.
select
index
(
string_of_value
atom
)
param
with
|
None
->
raise
Fail
|
Some
new_param
->
loop
(
Some
new_param
)
(
t_pat
,
t
)
|
[]
->
raise
Fail
|
new_param
->
loop
(
Some
new_param
)
(
t_pat
,
t
)
)
|
_
->
Error
.
bug
"[P_fs.match_] several different parameters contraints for the same feature is not implemented"
in
loop
param
(
p_fs_wo_pos
,
g_fs
)
...
...
src/grew_fs.mli
View file @
4d144edc
...
...
@@ -80,7 +80,7 @@ module P_fs: sig
val
to_string
:
t
->
string
val
to_dep
:
?
filter
:
(
string
->
bool
)
->
(
string
list
*
string
list
)
->
t
->
string
val
to_dep
:
?
filter
:
(
string
->
bool
)
->
string
list
->
t
->
string
val
to_dot
:
t
->
string
...
...
src/grew_rule.ml
View file @
4d144edc
...
...
@@ -364,7 +364,7 @@ module Rule = struct
pattern
:
pattern
;
commands
:
Command
.
t
list
;
param
:
Lex_par
.
t
option
;
param_names
:
(
string
list
*
string
list
)
;
param_names
:
string
list
;
loc
:
Loc
.
t
;
}
...
...
@@ -376,8 +376,7 @@ module Rule = struct
let
param_json
=
match
t
.
param
with
|
None
->
[]
|
Some
lex_par
->
[
(
"pattern_param"
,
`List
(
List
.
map
(
fun
x
->
`String
x
)
(
fst
t
.
param_names
)));
(
"command_param"
,
`List
(
List
.
map
(
fun
x
->
`String
x
)
(
snd
t
.
param_names
)));
(
"pattern_param"
,
`List
(
List
.
map
(
fun
x
->
`String
x
)
(
t
.
param_names
)));
(
"lex_par"
,
Lex_par
.
to_json
lex_par
);
]
in
`Assoc
...
...
@@ -466,19 +465,6 @@ module Rule = struct
command
::
(
loop
(
new_kni
,
new_kei
)
tail
)
in
loop
(
known_node_ids
,
known_edge_ids
)
ast_commands
(* ====================================================================== *)
let
parse_vars
loc
vars
=
let
rec
parse_cmd_vars
=
function
|
[]
->
[]
|
x
::
t
when
x
.
[
0
]
=
'
@
'
->
x
::
parse_cmd_vars
t
|
x
::
t
->
Error
.
bug
~
loc
"Illegal feature definition '%s' in the lexical rule"
x
in
let
rec
parse_pat_vars
=
function
|
[]
->
([]
,
[]
)
|
x
::
t
when
x
.
[
0
]
=
'
@
'
->
([]
,
parse_cmd_vars
(
x
::
t
))
|
x
::
t
when
x
.
[
0
]
=
'
$
'
->
let
(
pv
,
cv
)
=
parse_pat_vars
t
in
(
x
::
pv
,
cv
)
|
x
::
t
->
Error
.
bug
~
loc
"Illegal feature definition '%s' in the lexical rule"
x
in
parse_pat_vars
vars
(* ====================================================================== *)
let
build
?
domain
deprecated_dir
rule_ast
=
...
...
@@ -486,28 +472,26 @@ module Rule = struct
|
Some
d
->
d
|
None
->
deprecated_dir
in
let
(
param
,
pat_vars
,
cmd_vars
)
=
let
(
param
,
pat_vars
)
=
match
rule_ast
.
Ast
.
param
with
|
None
->
(
None
,
[]
,
[]
)
|
None
->
(
None
,
[]
)
|
Some
(
files
,
vars
)
->
let
(
pat_vars
,
cmd_vars
)
=
parse_vars
rule_ast
.
Ast
.
rule_loc
vars
in
let
nb_pv
=
List
.
length
pat_vars
in
let
nb_cv
=
List
.
length
cmd_vars
in
let
nb_var
=
List
.
length
vars
in
(* first: load lexical parameters given in the same file at the end of the rule definition *)
let
local_param
=
match
rule_ast
.
Ast
.
lex_par
with
|
None
->
None
|
Some
lines
->
Some
(
Lex_par
.
from_lines
~
loc
:
rule_ast
.
Ast
.
rule_loc
nb_
pv
nb_cv
lines
)
in
|
Some
lines
->
Some
(
Lex_par
.
from_lines
~
loc
:
rule_ast
.
Ast
.
rule_loc
nb_
var
lines
)
in
(* second: load lexical parameters given in external files *)
let
full_param
=
List
.
fold_left
(
fun
acc
file
->
match
acc
with
|
None
->
Some
(
Lex_par
.
load
~
loc
:
rule_ast
.
Ast
.
rule_loc
dir
nb_
pv
nb_cv
file
)
|
Some
lp
->
Some
(
Lex_par
.
append
(
Lex_par
.
load
~
loc
:
rule_ast
.
Ast
.
rule_loc
dir
nb_
pv
nb_cv
file
)
lp
)
|
None
->
Some
(
Lex_par
.
load
~
loc
:
rule_ast
.
Ast
.
rule_loc
dir
nb_
var
file
)
|
Some
lp
->
Some
(
Lex_par
.
append
(
Lex_par
.
load
~
loc
:
rule_ast
.
Ast
.
rule_loc
dir
nb_
var
file
)
lp
)
)
local_param
files
in
(
full_param
,
pat_vars
,
cmd_
vars
)
in
(
full_param
,
vars
)
in
(
match
(
param
,
pat_vars
)
with
|
(
None
,
_
::_
)
->
Error
.
build
~
loc
:
rule_ast
.
Ast
.
rule_loc
"[Rule.build] Missing lexical parameters in rule
\"
%s
\"
"
rule_ast
.
Ast
.
rule_id
...
...
@@ -533,10 +517,10 @@ module Rule = struct
{
name
=
rule_ast
.
Ast
.
rule_id
;
pattern
=
(
pos
,
negs
);
commands
=
build_commands
?
domain
~
param
:
(
pat_vars
,
cmd_vars
)
pos
pos_table
rule_ast
.
Ast
.
commands
;
commands
=
build_commands
?
domain
~
param
:
pat_vars
pos
pos_table
rule_ast
.
Ast
.
commands
;
loc
=
rule_ast
.
Ast
.
rule_loc
;
param
=
param
;
param_names
=
(
pat_vars
,
cmd_vars
)
param_names
=
pat_vars
;
}
let
build_pattern
?
domain
pattern_ast
=
...
...
@@ -975,11 +959,7 @@ module Rule = struct
(
function
|
Command
.
Feat
(
cnode
,
feat_name
)
->
Concat_item
.
Feat
(
node_find
cnode
,
feat_name
)
|
Command
.
String
s
->
Concat_item
.
String
s
|
Command
.
Param_out
index
->
(
match
matching
.
m_param
with
|
None
->
Error
.
bug
"Cannot apply a UPDATE_FEAT command without parameter"
|
Some
param
->
Concat_item
.
String
(
Lex_par
.
get_command_value
index
param
))
|
Command
.
Param_in
index
->
|
Command
.
Param
index
->
(
match
matching
.
m_param
with
|
None
->
Error
.
bug
"Cannot apply a UPDATE_FEAT command without parameter"
|
Some
param
->
Concat_item
.
String
(
Lex_par
.
get_param_value
index
param
))
...
...
@@ -1434,11 +1414,7 @@ module Rule = struct
(
function
|
Command
.
Feat
(
cnode
,
feat_name
)
->
Concat_item
.
Feat
(
node_find
cnode
,
feat_name
)
|
Command
.
String
s
->
Concat_item
.
String
s
|
Command
.
Param_out
index
->
(
match
matching
.
m_param
with
|
None
->
Error
.
bug
"Cannot apply a UPDATE_FEAT command without parameter"
|
Some
param
->
Concat_item
.
String
(
Lex_par
.
get_command_value
index
param
))
|
Command
.
Param_in
index
->
|
Command
.
Param
index
->
(
match
matching
.
m_param
with
|
None
->
Error
.
bug
"Cannot apply a UPDATE_FEAT command without parameter"
|
Some
param
->
Concat_item
.
String
(
Lex_par
.
get_param_value
index
param
))
...
...
@@ -1680,14 +1656,10 @@ module Rule = struct
(
function
|
Command
.
Feat
(
cnode
,
feat_name
)
->
Concat_item
.
Feat
(
node_find
cnode
,
feat_name
)
|
Command
.
String
s
->
Concat_item
.
String
s
|
Command
.
Param
_out
index
->
|
Command
.
Param
index
->
(
match
matching
.
m_param
with
|
None
->
Error
.
bug
"Cannot apply a UPDATE_FEAT command without parameter"
|
Some
param
->
Concat_item
.
String
(
Lex_par
.
get_command_value
index
param
))
|
Command
.
Param_in
index
->
(
match
matching
.
m_param
with
|
None
->
Error
.
bug
"Cannot apply a UPDATE_FEAT command without parameter"
|
Some
param
->
Concat_item
.
String
(
Lex_par
.
get_param_value
index
param
))
)
item_list
in
let
(
new_graph
,
new_feature_value
)
=
(* TODO: take value type into account in update_feat *)
...
...
src/grew_types.ml
View file @
4d144edc
...
...
@@ -95,11 +95,9 @@ module Massoc_pid = Massoc_make (Pid)
(* This module defines a type for lexical parameter (i.e. one line in a lexical file) *)
module
Lex_par
=
struct
type
item
=
string
list
*
string
list
(* first list: pattern parameters $id , second list command parameters @id *)
type
item
=
string
list
let
item_to_string
=
function
|
(
l
,
[]
)
->
String
.
concat
"#"
l
|
(
pat
,
com
)
->
(
String
.
concat
"#"
pat
)
^
"##"
^
(
String
.
concat
"#"
com
)
let
item_to_string
l
=
String
.
concat
"#"
l
type
t
=
item
list
...
...
@@ -111,87 +109,49 @@ module Lex_par = struct
let
signature
=
function
|
[]
->
Error
.
bug
"[Lex_par.signature] empty data"
|
(
pp
,
cp
)
::_
->
(
List
.
length
pp
,
List
.
length
cp
)
|
v
->
List
.
length
v
let
dump
t
=
printf
"[Lex_par.dump] --> size = %d
\n
"
(
List
.
length
t
);
List
.
iter
(
fun
(
pp
,
cp
)
->
printf
"%s##%s
\n
"
(
String
.
concat
"#"
pp
)
(
String
.
concat
"#"
cp
)
)
t
List
.
iter
(
fun
il
->
printf
"%s
\n
"
(
String
.
concat
"#"
il
))
t
let
parse_line
?
loc
nb_
p
nb_c
line
=
let
parse_line
?
loc
nb_
var
line
=
let
line
=
String_
.
rm_peripheral_white
line
in
if
line
=
""
||
line
.
[
0
]
=
'
%
'
then
None
else
let
line
=
Str
.
global_replace
(
Str
.
regexp
"
\\\\
%"
)
"%"
line
in
match
Str
.
split
(
Str
.
regexp
"##"
)
line
with
|
[
args
]
when
nb_c
=
0
->
(
match
Str
.
split
(
Str
.
regexp
"#"
)
args
with
|
l
when
List
.
length
l
=
nb_p
->
Some
(
l
,
[]
)
|
_
->
Error
.
build
?
loc
"Illegal lexical parameter line:
\"
%s
\"
doesn't contain %d args"
line
nb_p
)
|
[
args
;
values
]
->
(
match
(
Str
.
split
(
Str
.
regexp
"#"
)
args
,
Str
.
split
(
Str
.
regexp
"#"
)
values
)
with
|
(
lp
,
lc
)
when
List
.
length
lp
=
nb_p
&&
List
.
length
lc
=
nb_c
->
Some
(
lp
,
lc
)
|
_
->
Error
.
build
?
loc
"Illegal lexical parameter line:
\"
%s
\"
doesn't contain %d args and %d values"
line
nb_p
nb_c
)
|
_
->
Error
.
build
?
loc
"Illegal param line: '%s'"
line
let
from_lines
?
loc
nb_p
nb_c
lines
=
match
List_
.
opt_map
(
parse_line
?
loc
nb_p
nb_c
)
lines
with
match
Str
.
split
(
Str
.
regexp
"##
\\
|#"
)
line
with
|
args
when
List
.
length
args
=
nb_var
->
Some
args
|
args
->
Error
.
build
?
loc
"Wrong param number: '%d instead of %d'"
(
List
.
length
args
)
nb_var
let
from_lines
?
loc
nb_var
lines
=
match
List_
.
opt_map
(
parse_line
?
loc
nb_var
)
lines
with
|
[]
->
Error
.
build
?
loc
"Empty lexical parameter list"
|
l
->
l
let
load
?
loc
dir
nb_
p
nb_c
file
=
let
load
?
loc
dir
nb_
var
file
=
try
let
full_file
=
if
Filename
.
is_relative
file
then
Filename
.
concat
dir
file
else
file
in
let
lines
=
File
.
read
full_file
in
match
List_
.
opt_mapi
(
fun
i
line
->
parse_line
~
loc
:
(
Loc
.
file_line
full_file
i
)
nb_
p
nb_c
line
)
lines
with
match
List_
.
opt_mapi
(
fun
i
line
->
parse_line
~
loc
:
(
Loc
.
file_line
full_file
i
)
nb_
var
line
)
lines
with
|
[]
->
Error
.
build
?
loc
"Empty lexical parameter file '%s'"
file
|
l
->
l
with
Sys_error
_
->
Error
.
build
?
loc
"External lexical file '%s' not found"
file
let
select
index
atom
t
=
match
List_
.
opt_map
(
fun
(
p_par
,
c_par
)
->
let
par
=
List
.
nth
p_par
index
in
if
atom
=
par
then
Some
(
p_par
,
c_par
)
else
None
)
t
with
|
[]
->
None
|
t
->
Some
t
let
select
index
atom
t
=
List
.
filter
(
fun
par
->
List
.
nth
par
index
=
atom
)
t
let
get_param_value
index
=
function
|
[]
->
Error
.
bug
"[Lex_par.get_param_value] empty parameter"
|
(
params
,_
)
::_
->
List
.
nth
params
index
|
params
::_
->
List
.
nth
params
index
let
get_command_value
index
=
function
|
[(
_
,
one
)]
->
List
.
nth
one
index
|
[]
->
Error
.
bug
"[Lex_par.get_command_value] empty parameter"
|
(
_
,
[
sing
])
::
tail
when
index
=
0
->
Printf
.
sprintf
"%s/%s"
sing
(
List_
.
to_string
(
function
|
(
_
,
[
s
])
->
s
|
_
->
Error
.
bug
"[Lex_par.get_command_value] inconsistent param"
)
"/"
tail
)
|
(
left
,_
)
::_
->
Error
.
run
"Lexical parameter are not functional, input parameter%s: %s"
(
if
(
List
.
length
left
)
>
1
then
"s"
else
""
)
(
String
.
concat
", "
left
)
|
[
one
]
->
List
.
nth
one
index
|
_
->
Error
.
run
"Lexical parameter are not functional"
end
(* module Lex_par *)
(* ================================================================================ *)
...
...
src/grew_types.mli
View file @
4d144edc
...
...
@@ -66,7 +66,7 @@ module Massoc_pid : S with type key = Pid.t
(* ================================================================================ *)
(** module for rules that are lexically parametrized *)
module
Lex_par
:
sig
type
t
type
t
=
string
list
list
val
to_json
:
t
->
Yojson
.
Basic
.
json
...
...
@@ -76,20 +76,20 @@ module Lex_par: sig
val
size
:
t
->
int
(** [signature t] returns
(number of pattern parameters, number of lexical parameters)
*)
val
signature
:
t
->
(
int
*
int
)
(** [signature t] returns
number of parameters
*)
val
signature
:
t
->
int
(** [from_lines filename nb_
pattern_var nb_command_
var strings] *)
val
from_lines
:
?
loc
:
Loc
.
t
->
int
->
int
->
string
list
->
t
(** [from_lines filename nb_var strings] *)
val
from_lines
:
?
loc
:
Loc
.
t
->
int
->
string
list
->
t
(** [load ?loc local_dir_name nb_
pattern_var nb_command_
var file] *)
val
load
:
?
loc
:
Loc
.
t
->
string
->
int
->
int
->
string
->
t
(** [load ?loc local_dir_name nb_var file] *)
val
load
:
?
loc
:
Loc
.
t
->
string
->
int
->
string
->
t
(** [select index atom t] returns the subset of [t] which contains only entries
which refers to [atom] at the [index]^th pattern_var.
[None] is returned if no such entry s founded.
*)
val
select
:
int
->
string
->
t
->
t
option
val
select
:
int
->
string
->
t
->
t
(** [get_param_value index t] returns the [index]^th param_var. *)
val
get_param_value
:
int
->
t
->
string
...
...
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