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
188f89ad
Commit
188f89ad
authored
Aug 08, 2018
by
Bruno Guillaume
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
remove old lexicon implementation
parent
ca3d349c
Changes
17
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
17 changed files
with
80 additions
and
287 deletions
+80
-287
src/grew_ast.ml
src/grew_ast.ml
+0
-10
src/grew_ast.mli
src/grew_ast.mli
+0
-4
src/grew_command.ml
src/grew_command.ml
+1
-11
src/grew_command.mli
src/grew_command.mli
+0
-2
src/grew_fs.ml
src/grew_fs.ml
+45
-72
src/grew_fs.mli
src/grew_fs.mli
+3
-3
src/grew_graph.ml
src/grew_graph.ml
+5
-5
src/grew_graph.mli
src/grew_graph.mli
+0
-2
src/grew_lexer.mll
src/grew_lexer.mll
+1
-1
src/grew_node.ml
src/grew_node.ml
+2
-3
src/grew_node.mli
src/grew_node.mli
+1
-1
src/grew_parser.mly
src/grew_parser.mly
+0
-2
src/grew_rule.ml
src/grew_rule.ml
+18
-67
src/grew_rule.mli
src/grew_rule.mli
+1
-1
src/grew_types.ml
src/grew_types.ml
+0
-62
src/grew_types.mli
src/grew_types.mli
+0
-38
src/libgrew.mli
src/libgrew.mli
+3
-3
No files found.
src/grew_ast.ml
View file @
188f89ad
...
...
@@ -98,7 +98,6 @@ module Ast = struct
|
Disequality
of
feature_value
list
|
Equal_lex
of
string
*
string
|
Disequal_lex
of
string
*
string
|
Equal_param
of
string
(* $ident *)
|
Absent
|
Else
of
(
feature_value
*
feature_name
*
feature_value
)
...
...
@@ -108,7 +107,6 @@ module Ast = struct
|
Disequality
fv_list
->
sprintf
" <> %s"
(
String
.
concat
"|"
fv_list
)
|
Equal_lex
(
lex
,
fn
)
->
sprintf
" = %s.%s"
lex
fn
|
Disequal_lex
(
lex
,
fn
)
->
sprintf
" <> %s.%s"
lex
fn
|
Equal_param
param
->
sprintf
" = $%s"
param
|
Absent
->
" <> *"
|
Else
(
fv1
,
fn2
,
fv2
)
->
sprintf
" = %s/%s = %s"
fv1
fn2
fv2
...
...
@@ -246,12 +244,10 @@ module Ast = struct
type
concat_item
=
|
Qfn_or_lex_item
of
pointed
|
String_item
of
string
|
Param_item
of
string
let
string_of_concat_item
=
function
|
Qfn_or_lex_item
pointed
->
sprintf
"%s.%s"
(
fst
pointed
)
(
snd
pointed
)
|
String_item
s
->
sprintf
"
\"
%s
\"
"
s
|
Param_item
var
->
var
type
u_command
=
|
Del_edge_expl
of
(
Id
.
name
*
Id
.
name
*
edge_label
)
...
...
@@ -326,16 +322,10 @@ module Ast = struct
type
lexicon_info
=
(
string
*
lexicon
)
list
(* the [rule] type is used for 3 kinds of module items:
- rule { param=None; ... }
- lex_rule
*)
type
rule
=
{
rule_id
:
Id
.
name
;
pattern
:
pattern
;
commands
:
command
list
;
param
:
(
string
list
*
string
list
)
option
;
(* (files, vars) *)
lex_par
:
string
list
option
;
(* lexical parameters in the file *)
lexicon_info
:
lexicon_info
;
rule_doc
:
string
list
;
rule_loc
:
Loc
.
t
;
...
...
src/grew_ast.mli
View file @
188f89ad
...
...
@@ -62,7 +62,6 @@ module Ast : sig
|
Disequality
of
feature_value
list
|
Equal_lex
of
string
*
string
|
Disequal_lex
of
string
*
string
|
Equal_param
of
string
(* $ident *)
|
Absent
|
Else
of
(
feature_value
*
feature_name
*
feature_value
)
...
...
@@ -146,7 +145,6 @@ module Ast : sig
type
concat_item
=
|
Qfn_or_lex_item
of
(
string
*
string
)
|
String_item
of
string
|
Param_item
of
string
type
u_command
=
|
Del_edge_expl
of
(
Id
.
name
*
Id
.
name
*
edge_label
)
...
...
@@ -180,8 +178,6 @@ module Ast : sig
rule_id
:
Id
.
name
;
pattern
:
pattern
;
commands
:
command
list
;
param
:
(
string
list
*
string
list
)
option
;
(* (files, vars) *)
lex_par
:
string
list
option
;
(* lexical parameters in the file *)
lexicon_info
:
lexicon_info
;
rule_doc
:
string
list
;
rule_loc
:
Loc
.
t
;
...
...
src/grew_command.ml
View file @
188f89ad
...
...
@@ -33,7 +33,6 @@ module Command = struct
|
Feat
of
(
command_node
*
string
)
|
String
of
string
|
Lexical_field
of
(
string
*
string
)
|
Param
of
int
let
item_to_json
=
function
|
Feat
(
cn
,
feature_name
)
->
`Assoc
[(
"copy_feat"
,
...
...
@@ -44,7 +43,6 @@ module Command = struct
)]
|
String
s
->
`Assoc
[(
"string"
,
`String
s
)]
|
Lexical_field
(
lex
,
field
)
->
`Assoc
[(
"lexical_filed"
,
`String
(
lex
^
"."
^
field
))]
|
Param
i
->
`Assoc
[(
"param"
,
`Int
i
)]
(* the command in pattern *)
type
p
=
...
...
@@ -153,7 +151,7 @@ module Command = struct
]
)]
let
build
?
domain
?
param
lexicons
(
kni
,
kei
)
table
ast_command
=
let
build
?
domain
lexicons
(
kni
,
kei
)
table
ast_command
=
(* kni stands for "known node idents", kei for "known edge idents" *)
let
cn_of_node_id
node_id
=
...
...
@@ -256,18 +254,10 @@ module Command = struct
Feat
(
cn_of_node_id
node_id_or_lex
,
feature_name_or_lex_field
)
end
|
Ast
.
String_item
s
->
String
s
|
Ast
.
Param_item
var
->
match
param
with
|
None
->
Error
.
build
~
loc
"Unknown command variable '%s'"
var
|
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
_
]
->
()
(* 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 @
188f89ad
...
...
@@ -24,7 +24,6 @@ module Command : sig
|
Feat
of
(
command_node
*
string
)
|
String
of
string
|
Lexical_field
of
(
string
*
string
)
|
Param
of
int
type
p
=
|
DEL_NODE
of
command_node
...
...
@@ -49,7 +48,6 @@ module Command : sig
val
build
:
?
domain
:
Domain
.
t
->
?
param
:
string
list
->
Lexicons
.
t
->
(
Id
.
name
list
*
string
list
)
->
Id
.
table
->
...
...
src/grew_fs.ml
View file @
188f89ad
This diff is collapsed.
Click to expand it.
src/grew_fs.mli
View file @
188f89ad
...
...
@@ -76,11 +76,11 @@ module P_fs: sig
val
empty
:
t
val
build
:
?
domain
:
Domain
.
t
->
?
pat_vars
:
string
list
->
Lexicons
.
t
->
Ast
.
feature
list
->
t
val
build
:
?
domain
:
Domain
.
t
->
Lexicons
.
t
->
Ast
.
feature
list
->
t
val
to_string
:
t
->
string
val
to_dep
:
?
filter
:
(
string
->
bool
)
->
string
list
->
t
->
string
val
to_dep
:
?
filter
:
(
string
->
bool
)
->
t
->
string
val
to_dot
:
t
->
string
...
...
@@ -93,7 +93,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
option
->
t
->
bool
val
check_position
:
float
option
->
t
->
bool
exception
Fail_unif
...
...
src/grew_graph.ml
View file @
188f89ad
...
...
@@ -62,15 +62,15 @@ module P_graph = struct
|
Some
new_node
->
Some
(
Pid_map
.
add
id_src
new_node
map
)
(* -------------------------------------------------------------------------------- *)
let
build
?
domain
?
pat_vars
lexicons
(
full_node_list
:
Ast
.
node
list
)
full_edge_list
=
let
build
?
domain
lexicons
(
full_node_list
:
Ast
.
node
list
)
full_edge_list
=
(* NB: insert searches for a previous node with the Same name and uses unification rather than constraint *)
(* NB: insertion of new node at the end of the list: not efficient but graph building is not the hard part. *)
let
rec
insert
(
ast_node
,
loc
)
=
function
|
[]
->
[
P_node
.
build
?
domain
?
pat_vars
lexicons
(
ast_node
,
loc
)]
|
[]
->
[
P_node
.
build
?
domain
lexicons
(
ast_node
,
loc
)]
|
(
node_id
,
fs
)
::
tail
when
ast_node
.
Ast
.
node_id
=
node_id
->
begin
try
(
node_id
,
P_node
.
unif_fs
(
P_fs
.
build
?
domain
?
pat_vars
lexicons
ast_node
.
Ast
.
fs
)
fs
)
::
tail
try
(
node_id
,
P_node
.
unif_fs
(
P_fs
.
build
?
domain
lexicons
ast_node
.
Ast
.
fs
)
fs
)
::
tail
with
Error
.
Build
(
msg
,_
)
->
raise
(
Error
.
Build
(
msg
,
Some
loc
))
end
|
head
::
tail
->
head
::
(
insert
(
ast_node
,
loc
)
tail
)
in
...
...
@@ -117,9 +117,9 @@ module P_graph = struct
(* -------------------------------------------------------------------------------- *)
(* It may raise [P_fs.Fail_unif] in case of contradiction on constraints *)
let
build_extension
?
domain
?
pat_vars
lexicons
pos_table
full_node_list
full_edge_list
=
let
build_extension
?
domain
lexicons
pos_table
full_node_list
full_edge_list
=
let
built_nodes
=
List
.
map
(
P_node
.
build
?
domain
?
pat_vars
lexicons
)
full_node_list
in
let
built_nodes
=
List
.
map
(
P_node
.
build
?
domain
lexicons
)
full_node_list
in
let
(
old_nodes
,
new_nodes
)
=
List
.
partition
...
...
src/grew_graph.mli
View file @
188f89ad
...
...
@@ -65,7 +65,6 @@ module P_graph: sig
(** It raises [P_fs.Fail_unif] exception in case of inconsistent feature structures. *)
val
build
:
?
domain
:
Domain
.
t
->
?
pat_vars
:
string
list
->
Lexicons
.
t
->
Ast
.
node
list
->
Ast
.
edge
list
->
...
...
@@ -74,7 +73,6 @@ module P_graph: sig
(** It raises [P_fs.Fail_unif] exception in case of inconsistent feature structures. *)
val
build_extension
:
?
domain
:
Domain
.
t
->
?
pat_vars
:
string
list
->
Lexicons
.
t
->
Id
.
table
->
Ast
.
node
list
->
...
...
src/grew_lexer.mll
View file @
188f89ad
...
...
@@ -98,7 +98,7 @@ and string_lex re target = parse
string_lex
re
target
lexbuf
}
(* a dedicated lexer for l
exical parameter
: read everything until "#END" *)
(* a dedicated lexer for l
ocal lexicons
: read everything until "#END" *)
and
lp_lex
name
target
=
parse
|
'\n'
{
(
match
Global
.
get_line
()
with
|
None
->
raise
(
Error
"no loc in lexer"
)
...
...
src/grew_node.ml
View file @
188f89ad
...
...
@@ -159,11 +159,11 @@ module P_node = struct
let
empty
=
{
fs
=
P_fs
.
empty
;
next
=
Massoc_pid
.
empty
;
name
=
""
;
loc
=
None
}
let
build
?
domain
?
pat_vars
lexicons
(
ast_node
,
loc
)
=
let
build
?
domain
lexicons
(
ast_node
,
loc
)
=
(
ast_node
.
Ast
.
node_id
,
{
name
=
ast_node
.
Ast
.
node_id
;
fs
=
P_fs
.
build
?
domain
?
pat_vars
lexicons
ast_node
.
Ast
.
fs
;
fs
=
P_fs
.
build
?
domain
lexicons
ast_node
.
Ast
.
fs
;
next
=
Massoc_pid
.
empty
;
loc
=
Some
loc
;
}
)
...
...
@@ -175,7 +175,6 @@ module P_node = struct
let
match_
?
lexicons
p_node
g_node
=
(* (match param with None -> printf "<None>" | Some p -> printf "<Some>"; Lex_par.dump p); *)
match
G_node
.
get_position
g_node
with
|
G_node
.
Unordered
_
->
raise
P_fs
.
Fail
(* TOOO: check this return !! *)
|
G_node
.
Ordered
p
->
...
...
src/grew_node.mli
View file @
188f89ad
...
...
@@ -102,7 +102,7 @@ module P_node: sig
It raises [P_fs.Fail_unif] exception in case of Failure. *)
val
unif_fs
:
P_fs
.
t
->
t
->
t
val
build
:
?
domain
:
Domain
.
t
->
?
pat_vars
:
string
list
->
Lexicons
.
t
->
Ast
.
node
->
(
Id
.
name
*
t
)
val
build
:
?
domain
:
Domain
.
t
->
Lexicons
.
t
->
Ast
.
node
->
(
Id
.
name
*
t
)
val
add_edge
:
P_edge
.
t
->
Pid
.
t
->
t
->
t
option
...
...
src/grew_parser.mly
View file @
188f89ad
...
...
@@ -288,8 +288,6 @@ rule:
{
Ast
.
rule_id
=
fst
id_loc
;
pattern
=
Ast
.
complete_pattern
{
Ast
.
pat_pos
=
p
;
Ast
.
pat_negs
=
n
};
commands
=
cmds
;
param
=
None
;
lex_par
=
None
;
lexicon_info
=
lexicons
;
rule_doc
=
begin
match
doc
with
Some
d
->
d
|
None
->
[]
end
;
rule_loc
=
snd
id_loc
;
...
...
src/grew_rule.ml
View file @
188f89ad
This diff is collapsed.
Click to expand it.
src/grew_rule.mli
View file @
188f89ad
...
...
@@ -64,7 +64,7 @@ module Rule : sig
val
node_matching
:
pattern
->
G_graph
.
t
->
matching
->
(
string
*
float
)
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
->
?
lexicons
:
Lexicons
.
t
->
?
param
:
Lex_par
.
t
->
pattern
->
G_graph
.
t
->
matching
list
val
match_in_graph
:
?
domain
:
Domain
.
t
->
?
lexicons
:
Lexicons
.
t
->
pattern
->
G_graph
.
t
->
matching
list
(** [match_deco rule matching] builds the decoration of the [graph] illustrating the given [matching] of the [rule] *)
(* NB: it can be computed independly from the graph itself! *)
...
...
src/grew_types.ml
View file @
188f89ad
...
...
@@ -93,68 +93,6 @@ module Massoc_pid = Massoc_make (Pid)
module
Massoc_string
=
Massoc_make
(
String
)
(* ================================================================================ *)
(* This module defines a type for lexical parameter (i.e. one line in a lexical file) *)
module
Lex_par
=
struct
type
item
=
string
list
let
item_to_string
l
=
String
.
concat
"#"
l
type
t
=
item
list
let
to_json
t
=
`List
(
List
.
map
(
fun
item
->
`String
(
item_to_string
item
))
t
)
let
size
=
List
.
length
let
append
=
List
.
append
let
signature
=
function
|
[]
->
Error
.
bug
"[Lex_par.signature] empty data"
|
v
->
List
.
length
v
let
dump
t
=
printf
"[Lex_par.dump] --> size = %d
\n
"
(
List
.
length
t
);
List
.
iter
(
fun
il
->
printf
"%s
\n
"
(
String
.
concat
"#"
il
))
t
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
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_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_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
=
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
let
get_command_value
index
=
function
|
[]
->
Error
.
bug
"[Lex_par.get_command_value] empty parameter"
|
[
one
]
->
List
.
nth
one
index
|
_
->
Error
.
run
"Lexical parameter are not functional"
end
(* module Lex_par *)
(* ================================================================================ *)
module
Lexicon
=
struct
...
...
src/grew_types.mli
View file @
188f89ad
...
...
@@ -66,44 +66,6 @@ module Massoc_pid : S with type key = Pid.t
(* ================================================================================ *)
module
Massoc_string
:
S
with
type
key
=
string
(* ================================================================================ *)
(** module for rules that are lexically parametrized *)
module
Lex_par
:
sig
type
item
=
string
list
type
t
=
item
list
val
to_json
:
t
->
Yojson
.
Basic
.
json
val
append
:
t
->
t
->
t
val
dump
:
t
->
unit
val
size
:
t
->
int
(** [signature t] returns number of parameters *)
val
signature
:
t
->
int
(** [from_lines filename nb_var strings] *)
val
from_lines
:
?
loc
:
Loc
.
t
->
int
->
string
list
->
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
(** [get_param_value index t] returns the [index]^th param_var. *)
val
get_param_value
:
int
->
t
->
string
(** [get_command_value index t] supposes that [t] contains iny one element.
It returns the [index]^th command_var. *)
val
get_command_value
:
int
->
t
->
string
end
(* module Lex_par *)
(* ================================================================================ *)
module
Lexicon
:
sig
type
t
...
...
src/libgrew.mli
View file @
188f89ad
...
...
@@ -143,10 +143,10 @@ module Rewrite: sig
val
set_debug_loop
:
unit
->
unit
(** [display gr grs seq] builds the [display] (datatype used by the GUI) given by
the rewriting of graph [gr] with the s
equence [seq
] of [grs].
@param gr the grap
t
h to rewrite
the rewriting of graph [gr] with the s
trategy [strat
] of [grs].
@param gr the graph to rewrite
@param grs the graph rewriting system
@param s
eq the name of the sequence
to apply *)
@param s
trat the name of the strategy
to apply *)
val
display
:
gr
:
Graph
.
t
->
grs
:
Grs
.
t
->
strat
:
string
->
display
val
at_least_one
:
grs
:
Grs
.
t
->
strat
:
string
->
bool
...
...
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