Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
grew
libcaml-grew
Commits
1eb9b2fd
Commit
1eb9b2fd
authored
Aug 22, 2017
by
Bruno Guillaume
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
* switch naming of Grs (Grs —> Old_grs & New_grs —> Grs)
parent
ef867aba
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
57 additions
and
57 deletions
+57
-57
src/grew_grs.ml
src/grew_grs.ml
+5
-5
src/grew_grs.mli
src/grew_grs.mli
+3
-3
src/grew_html.ml
src/grew_html.ml
+3
-3
src/grew_html.mli
src/grew_html.mli
+2
-2
src/libgrew.ml
src/libgrew.ml
+35
-35
src/libgrew.mli
src/libgrew.mli
+9
-9
No files found.
src/grew_grs.ml
View file @
1eb9b2fd
...
...
@@ -167,7 +167,7 @@ module Modul = struct
end
(* module Modul *)
(* ================================================================================ *)
module
G
rs
=
struct
module
Old_g
rs
=
struct
type
t
=
{
domain
:
Domain
.
t
option
;
...
...
@@ -473,7 +473,7 @@ end (* module Grs *)
module
New_g
rs
=
struct
module
G
rs
=
struct
type
decl
=
|
Rule
of
Rule
.
t
...
...
@@ -497,11 +497,11 @@ module New_grs = struct
List
.
iter
(
dump_decl
(
indent
+
2
))
decl_list
let
dump
t
=
printf
"================
New_g
rs ================
\n
"
;
printf
"================
G
rs ================
\n
"
;
Domain
.
dump
t
.
domain
;
printf
"-----------------------
\n
"
;
List
.
iter
(
dump_decl
0
)
t
.
decls
;
printf
"================
New_g
rs ================
\n
%!"
;
printf
"================
G
rs ================
\n
%!"
;
()
...
...
@@ -959,5 +959,5 @@ module Univ_grs = struct
with
exc_old
->
Log
.
finfo
"[Univ_grs.load] FAILED to load file
\"
%s
\"
with OLD syntax: exc=
\"
%s
\"
"
file
(
Printexc
.
to_string
exc_old
);
raise
exc_new
in
New_g
rs
.
from_ast
file
new_ast
G
rs
.
from_ast
file
new_ast
end
\ No newline at end of file
src/grew_grs.mli
View file @
1eb9b2fd
...
...
@@ -75,7 +75,7 @@ module Modul: sig
end
(* module Modul *)
(* ================================================================================ *)
module
G
rs
:
sig
module
Old_g
rs
:
sig
type
t
val
empty
:
t
...
...
@@ -110,7 +110,7 @@ module Grs: sig
val
to_json
:
t
->
Yojson
.
Basic
.
json
end
(* module Grs *)
module
New_g
rs
:
sig
module
G
rs
:
sig
type
t
val
load
:
string
->
t
...
...
@@ -128,5 +128,5 @@ module New_grs : sig
end
module
Univ_grs
:
sig
val
load
:
string
->
New_g
rs
.
t
val
load
:
string
->
G
rs
.
t
end
\ No newline at end of file
src/grew_html.ml
View file @
1eb9b2fd
...
...
@@ -403,8 +403,8 @@ module Html_doc = struct
Buffer
.
contents
buff
let
build
~
dep
~
corpus
output_dir
grs
=
let
filename
=
G
rs
.
get_filename
grs
in
let
ast
=
G
rs
.
get_ast
grs
in
let
filename
=
Old_g
rs
.
get_filename
grs
in
let
ast
=
Old_g
rs
.
get_ast
grs
in
ignore
(
Sys
.
command
(
"rm -rf "
^
output_dir
));
ignore
(
Sys
.
command
(
"mkdir "
^
output_dir
));
(* ignore(Sys.command ("cp "^DATA_DIR^"/style.css "^output_dir)); *)
...
...
@@ -827,7 +827,7 @@ module Corpus_stat = struct
)
String_map
.
empty
modul
.
Modul
.
rules
in
String_map
.
add
modul
.
Modul
.
name
rule_map
acc
else
acc
)
String_map
.
empty
(
G
rs
.
get_modules
grs
)
in
)
String_map
.
empty
(
Old_g
rs
.
get_modules
grs
)
in
{
modules
=
modules
;
map
=
map
;
amb
=
Int_map
.
empty
;
error
=
[]
;
num
=
0
}
let
add
modul
rule
file
(
min_occ
,
max_occ
)
map
=
...
...
src/grew_html.mli
View file @
1eb9b2fd
...
...
@@ -17,7 +17,7 @@ open Grew_graph
(* ================================================================================ *)
module
Html_doc
:
sig
(* dep is a flag which is true iff dep file are shown in doc (iff dep2pict is available) *)
val
build
:
dep
:
bool
->
corpus
:
bool
->
string
->
G
rs
.
t
->
unit
val
build
:
dep
:
bool
->
corpus
:
bool
->
string
->
Old_g
rs
.
t
->
unit
end
(* module Html_doc *)
(* ================================================================================ *)
...
...
@@ -68,7 +68,7 @@ end (* module Gr_stat *)
module
Corpus_stat
:
sig
type
t
val
empty
:
grs
:
G
rs
.
t
->
seq
:
string
->
t
val
empty
:
grs
:
Old_g
rs
.
t
->
seq
:
string
->
t
val
add_gr_stat
:
string
->
Gr_stat
.
t
->
t
->
t
...
...
src/libgrew.ml
View file @
1eb9b2fd
...
...
@@ -57,13 +57,13 @@ module Domain = struct
let
load
filename
=
let
ast
=
Grew_loader
.
Loader
.
domain
filename
in
Grew_grs
.
G
rs
.
domain_build
ast
Grew_grs
.
Old_g
rs
.
domain_build
ast
let
load
filename
=
handle
~
name
:
"Domain.load"
(
fun
()
->
let
ast
=
Grew_loader
.
Loader
.
domain
filename
in
Grew_grs
.
G
rs
.
domain_build
ast
Grew_grs
.
Old_g
rs
.
domain_build
ast
)
()
let
feature_names
domain
=
...
...
@@ -233,76 +233,76 @@ end
(* ==================================================================================================== *)
(** {2 Graph Rewriting System} *)
(* ==================================================================================================== *)
module
G
rs
=
struct
type
t
=
Grew_grs
.
G
rs
.
t
module
Old_g
rs
=
struct
type
t
=
Grew_grs
.
Old_g
rs
.
t
let
empty
=
Grew_grs
.
G
rs
.
empty
let
empty
=
Grew_grs
.
Old_g
rs
.
empty
let
load
file
=
handle
~
name
:
"
G
rs.load"
~
file
handle
~
name
:
"
Old_g
rs.load"
~
file
(
fun
()
->
if
not
(
Sys
.
file_exists
file
)
then
raise
(
Error
(
"File_not_found: "
^
file
))
else
Grew_grs
.
G
rs
.
build
file
else
Grew_grs
.
Old_g
rs
.
build
file
)
()
let
get_sequence_names
grs
=
handle
~
name
:
"
G
rs.get_sequence_names"
handle
~
name
:
"
Old_g
rs.get_sequence_names"
(
fun
()
->
Grew_grs
.
G
rs
.
sequence_names
grs
Grew_grs
.
Old_g
rs
.
sequence_names
grs
)
()
let
build_html_doc
?
(
corpus
=
false
)
dir
grs
=
handle
~
name
:
"
G
rs.build_doc [with Dep2pict]"
let
build_html_doc
?
(
corpus
=
false
)
dir
(
grs
:
Grew_grs
.
Old_grs
.
t
)
=
handle
~
name
:
"
Old_g
rs.build_doc [with Dep2pict]"
(
fun
()
->
Grew_html
.
Html_doc
.
build
~
corpus
~
dep
:
true
dir
grs
;
(* draw pattern graphs for all rules *)
let
fct
module_
rule_
=
let
dep_code
=
Grew_rule
.
Rule
.
to_dep
?
domain
:
(
Grew_grs
.
G
rs
.
get_domain
grs
)
rule_
in
let
dep_code
=
Grew_rule
.
Rule
.
to_dep
?
domain
:
(
Grew_grs
.
Old_g
rs
.
get_domain
grs
)
rule_
in
let
dep_png_file
=
sprintf
"%s/%s_%s-patt.png"
dir
module_
(
Grew_rule
.
Rule
.
get_name
rule_
)
in
let
d2p
=
Dep2pict
.
Dep2pict
.
from_dep
~
dep
:
dep_code
in
Dep2pict
.
Dep2pict
.
save_png
~
filename
:
dep_png_file
d2p
in
Grew_grs
.
G
rs
.
rule_iter
fct
grs
Grew_grs
.
Old_g
rs
.
rule_iter
fct
grs
)
()
let
get_domain
grs
=
Grew_grs
.
G
rs
.
get_domain
grs
let
get_domain
grs
=
Grew_grs
.
Old_g
rs
.
get_domain
grs
let
to_json
t
=
let
json
=
Grew_grs
.
G
rs
.
to_json
t
in
let
json
=
Grew_grs
.
Old_g
rs
.
to_json
t
in
Yojson
.
Basic
.
pretty_to_string
json
end
(* ==================================================================================================== *)
(** {2 New Graph Rewriting System} *)
(* ==================================================================================================== *)
module
New_g
rs
=
struct
type
t
=
Grew_grs
.
New_g
rs
.
t
module
G
rs
=
struct
type
t
=
Grew_grs
.
G
rs
.
t
let
load
file
=
handle
~
name
:
"
New_g
rs.load"
~
file
handle
~
name
:
"
G
rs.load"
~
file
(
fun
()
->
Grew_grs
.
Univ_grs
.
load
file
)
()
let
dump
grs
=
handle
~
name
:
"
New_g
rs.dump"
handle
~
name
:
"
G
rs.dump"
(
fun
()
->
Grew_grs
.
New_g
rs
.
dump
grs
Grew_grs
.
G
rs
.
dump
grs
)
()
let
domain
grs
=
handle
~
name
:
"
New_g
rs.domain"
handle
~
name
:
"
G
rs.domain"
(
fun
()
->
Grew_grs
.
New_g
rs
.
domain
grs
Grew_grs
.
G
rs
.
domain
grs
)
()
let
to_json
_
=
failwith
"TODO
New_g
rs.to_json"
let
to_json
_
=
failwith
"TODO
G
rs.to_json"
let
get_strat_list
grs
=
handle
~
name
:
"
New_g
rs.get_strat_list"
handle
~
name
:
"
G
rs.get_strat_list"
(
fun
()
->
Grew_grs
.
New_g
rs
.
get_strat_list
grs
Grew_grs
.
G
rs
.
get_strat_list
grs
)
()
end
...
...
@@ -321,27 +321,27 @@ module Rewrite = struct
let
set_debug_loop
()
=
Grew_rule
.
Rule
.
set_debug_loop
()
let
display
~
gr
~
grs
~
seq
=
handle
~
name
:
"Rewrite.display"
(
fun
()
->
Grew_grs
.
G
rs
.
build_rew_display
grs
seq
gr
)
()
let
old_
display
~
gr
~
grs
~
seq
=
handle
~
name
:
"Rewrite.
old_
display"
(
fun
()
->
Grew_grs
.
Old_g
rs
.
build_rew_display
grs
seq
gr
)
()
let
new_
display
~
gr
~
grs
~
strat
=
handle
~
name
:
"Rewrite.
new_
display"
(
fun
()
->
Grew_grs
.
New_g
rs
.
det_rew_display
grs
strat
gr
)
()
let
display
~
gr
~
grs
~
strat
=
handle
~
name
:
"Rewrite.display"
(
fun
()
->
Grew_grs
.
G
rs
.
det_rew_display
grs
strat
gr
)
()
let
set_timeout
t
=
Grew_base
.
Timeout
.
timeout
:=
t
let
rewrite
~
gr
~
grs
~
seq
=
handle
~
name
:
"Rewrite.rewrite"
(
fun
()
->
Grew_grs
.
Grs
.
rewrite
grs
seq
gr
)
()
handle
~
name
:
"Rewrite.rewrite"
(
fun
()
->
Grew_grs
.
Old_grs
.
rewrite
grs
seq
gr
)
()
let
old_simple_rewrite
~
gr
~
grs
~
strat
=
handle
~
name
:
"Rewrite.old_simple_rewrite"
(
fun
()
->
Grew_grs
.
Old_grs
.
simple_rewrite
grs
strat
gr
)
()
let
simple_rewrite
~
gr
~
grs
~
strat
=
handle
~
name
:
"Rewrite.simple_rewrite"
(
fun
()
->
Grew_grs
.
Grs
.
simple_rewrite
grs
strat
gr
)
()
let
new_simple_rewrite
~
gr
~
grs
~
strat
=
handle
~
name
:
"Rewrite.new_simple_rewrite"
(
fun
()
->
Grew_grs
.
New_grs
.
simple_rewrite
grs
strat
gr
)
()
let
at_least_one
~
grs
~
strat
=
handle
~
name
:
"Rewrite.
new_simple_rewrit
e"
(
fun
()
->
Grew_grs
.
New_g
rs
.
at_least_one
grs
strat
)
()
handle
~
name
:
"Rewrite.
at_least_on
e"
(
fun
()
->
Grew_grs
.
G
rs
.
at_least_one
grs
strat
)
()
let
at_most_one
~
grs
~
strat
=
handle
~
name
:
"Rewrite.
new_simple_rewrit
e"
(
fun
()
->
Grew_grs
.
New_g
rs
.
at_most_one
grs
strat
)
()
handle
~
name
:
"Rewrite.
at_most_on
e"
(
fun
()
->
Grew_grs
.
G
rs
.
at_most_one
grs
strat
)
()
let
is_empty
rh
=
...
...
src/libgrew.mli
View file @
1eb9b2fd
...
...
@@ -106,7 +106,7 @@ end
(* ==================================================================================================== *)
(** {2 Graph Rewriting System} *)
(* ==================================================================================================== *)
module
G
rs
:
sig
module
Old_g
rs
:
sig
type
t
val
empty
:
t
...
...
@@ -131,7 +131,7 @@ end
(* ==================================================================================================== *)
(** {2 New Graph Rewriting System} *)
(* ==================================================================================================== *)
module
New_g
rs
:
sig
module
G
rs
:
sig
type
t
val
load
:
string
->
t
...
...
@@ -163,18 +163,18 @@ module Rewrite: sig
@param gr the grapth to rewrite
@param grs the graph rewriting system
@param seq the name of the sequence to apply *)
val
display
:
gr
:
Graph
.
t
->
grs
:
G
rs
.
t
->
seq
:
string
->
display
val
new_
display
:
gr
:
Graph
.
t
->
grs
:
New_g
rs
.
t
->
strat
:
string
->
display
val
old_
display
:
gr
:
Graph
.
t
->
grs
:
Old_g
rs
.
t
->
seq
:
string
->
display
val
display
:
gr
:
Graph
.
t
->
grs
:
G
rs
.
t
->
strat
:
string
->
display
val
at_least_one
:
grs
:
New_g
rs
.
t
->
strat
:
string
->
bool
val
at_most_one
:
grs
:
New_g
rs
.
t
->
strat
:
string
->
bool
val
at_least_one
:
grs
:
G
rs
.
t
->
strat
:
string
->
bool
val
at_most_one
:
grs
:
G
rs
.
t
->
strat
:
string
->
bool
val
set_timeout
:
float
option
->
unit
val
rewrite
:
gr
:
Graph
.
t
->
grs
:
G
rs
.
t
->
seq
:
string
->
history
val
rewrite
:
gr
:
Graph
.
t
->
grs
:
Old_g
rs
.
t
->
seq
:
string
->
history
val
old_simple_rewrite
:
gr
:
Graph
.
t
->
grs
:
Old_grs
.
t
->
strat
:
string
->
Graph
.
t
list
val
simple_rewrite
:
gr
:
Graph
.
t
->
grs
:
Grs
.
t
->
strat
:
string
->
Graph
.
t
list
val
new_simple_rewrite
:
gr
:
Graph
.
t
->
grs
:
New_grs
.
t
->
strat
:
string
->
Graph
.
t
list
val
is_empty
:
history
->
bool
...
...
@@ -209,7 +209,7 @@ module Rewrite: sig
val
error_html
:
?
domain
:
Domain
.
t
->
?
no_init
:
bool
->
?
main_feat
:
string
->
?
dot
:
bool
->
header
:
string
->
string
->
?
init
:
Graph
.
t
->
string
->
unit
val
make_index
:
title
:
string
->
grs_file
:
string
->
html
:
bool
->
grs
:
G
rs
.
t
->
seq
:
string
->
input_dir
:
string
->
output_dir
:
string
->
base_names
:
string
array
->
unit
val
make_index
:
title
:
string
->
grs_file
:
string
->
html
:
bool
->
grs
:
Old_g
rs
.
t
->
seq
:
string
->
input_dir
:
string
->
output_dir
:
string
->
base_names
:
string
array
->
unit
val
html_sentences
:
title
:
string
->
string
->
(
bool
*
string
*
int
*
string
)
list
->
unit
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