Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
L
libcaml-grew
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
3
Issues
3
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
Operations
Operations
Incidents
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
grew
libcaml-grew
Commits
6f112b30
Commit
6f112b30
authored
Dec 13, 2017
by
Bruno Guillaume
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
remove Dep2pict / Html code
parent
f9efdaec
Changes
8
Show whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
0 additions
and
1209 deletions
+0
-1209
src/grew_grs.ml
src/grew_grs.ml
+0
-18
src/grew_grs.mli
src/grew_grs.mli
+0
-13
src/grew_html.ml
src/grew_html.ml
+0
-1015
src/grew_html.mli
src/grew_html.mli
+0
-81
src/grew_rule.ml
src/grew_rule.ml
+0
-14
src/grew_rule.mli
src/grew_rule.mli
+0
-5
src/libgrew.ml
src/libgrew.ml
+0
-44
src/libgrew.mli
src/libgrew.mli
+0
-19
No files found.
src/grew_grs.ml
View file @
6f112b30
...
...
@@ -41,24 +41,6 @@ module Rewrite_history = struct
|
{
good_nf
=
[]
}
->
1
|
{
good_nf
=
l
}
->
List
.
fold_left
(
fun
acc
t
->
acc
+
(
num_sol
t
))
0
l
let
save_nfs
?
domain
?
filter
?
main_feat
~
dot
base_name
t
=
let
rec
loop
file_name
rules
t
=
match
t
.
good_nf
with
|
[]
when
dot
->
Instance
.
save_dot_png
?
domain
?
filter
?
main_feat
file_name
t
.
instance
;
[
rules
,
file_name
]
|
[]
->
ignore
(
Instance
.
save_dep_png
?
domain
?
filter
?
main_feat
file_name
t
.
instance
);
[
rules
,
file_name
]
|
l
->
List_
.
foldi_left
(
fun
i
acc
son
->
(* Instance.save_dep_png ?main_feat (sprintf "%s_%d" file_name i) son.instance; *)
let
nfs
=
loop
(
sprintf
"%s_%d"
file_name
i
)
(
rules
@
[
t
.
module_name
,
son
.
instance
.
Instance
.
rules
])
son
in
nfs
@
acc
)
[]
l
in
loop
base_name
[]
t
let
save_gr
?
domain
base
t
=
let
rec
loop
file_name
t
=
match
t
.
good_nf
with
...
...
src/grew_grs.mli
View file @
6f112b30
...
...
@@ -29,19 +29,6 @@ module Rewrite_history: sig
val
num_sol
:
t
->
int
(** [save_nfs ?main_feat base_name t] does two things:
- write PNG files of normal forms
- returns a list of couples (rules, file)
*)
val
save_nfs
:
?
domain
:
Domain
.
t
->
?
filter
:
string
list
->
?
main_feat
:
string
->
dot
:
bool
->
string
->
t
->
((
string
*
string
list
)
list
*
string
)
list
(** [save_gr base_name t] saves one gr_file for each normal form defined in [t].
Output files are named according to [base_name] and the Gorn adress in the rewriting tree. *)
val
save_gr
:
?
domain
:
Domain
.
t
->
string
->
t
->
unit
...
...
src/grew_html.ml
deleted
100644 → 0
View file @
f9efdaec
(**********************************************************************************)
(* Libcaml-grew - a Graph Rewriting library dedicated to NLP applications *)
(* *)
(* Copyright 2011-2013 Inria, Université de Lorraine *)
(* *)
(* Webpage: http://grew.loria.fr *)
(* License: CeCILL (see LICENSE folder or "http://www.cecill.info") *)
(* Authors: see AUTHORS file *)
(**********************************************************************************)
open
Printf
open
Log
open
Grew_base
open
Grew_types
open
Grew_ast
open
Grew_domain
open
Grew_graph
open
Grew_rule
open
Grew_grs
let
html_header
?
css_file
?
title
?
(
add_lines
=
[]
)
buff
=
let
wnl
fmt
=
Printf
.
ksprintf
(
fun
x
->
Printf
.
bprintf
buff
"%s
\n
"
x
)
fmt
in
wnl
"<!DOCTYPE HTML PUBLIC
\"
-//W3C//DTD HTML 4.01 Transitional//EN
\"
>"
;
wnl
"<html>"
;
wnl
" <head>"
;
wnl
" <meta http-equiv=
\"
Content-Type
\"
content=
\"
text/html; charset=UTF-8
\"
>"
;
(
match
css_file
with
|
Some
file
->
wnl
" <link rel=
\"
stylesheet
\"
href=
\"
%s
\"
type=
\"
text/css
\"
>"
file
|
None
->
()
);
(
match
title
with
|
Some
t
->
wnl
" <title>%s</title>"
(
Str
.
global_replace
(
Str
.
regexp
"#"
)
" "
t
)
|
None
->
()
);
List
.
iter
(
fun
line
->
wnl
" %s"
line
)
add_lines
;
wnl
" </head>"
;
(* ================================================================================*)
module
Html_doc
=
struct
let
string_of_concat_item
=
function
|
Ast
.
Qfn_item
id
->
sprintf
"%s"
(
Ast
.
dump_feature_ident
id
)
|
Ast
.
String_item
s
->
sprintf
"
\"
%s
\"
"
s
|
Ast
.
Param_item
var
->
sprintf
"%s"
var
let
buff_html_command
?
(
li_html
=
false
)
buff
(
u_command
,_
)
=
bprintf
buff
" "
;
if
li_html
then
bprintf
buff
"<li>"
;
bprintf
buff
"%s"
(
Ast
.
string_of_u_command
u_command
);
if
li_html
then
bprintf
buff
"</li>
\n
"
else
bprintf
buff
";
\n
"
let
html_feature
(
u_feature
,_
)
=
match
u_feature
.
Ast
.
kind
with
|
Ast
.
Equality
values
->
sprintf
"%s=%s"
u_feature
.
Ast
.
name
(
List_
.
to_string
(
fun
x
->
x
)
"|"
values
)
|
Ast
.
Disequality
[]
->
sprintf
"%s=*"
u_feature
.
Ast
.
name
|
Ast
.
Absent
->
sprintf
"!%s"
u_feature
.
Ast
.
name
|
Ast
.
Disequality
values
->
sprintf
"%s<>%s"
u_feature
.
Ast
.
name
(
List_
.
to_string
(
fun
x
->
x
)
"|"
values
)
|
Ast
.
Equal_param
index
->
sprintf
"%s=%s"
u_feature
.
Ast
.
name
index
let
buff_html_node
buff
(
u_node
,_
)
=
bprintf
buff
" %s ["
u_node
.
Ast
.
node_id
;
bprintf
buff
"%s"
(
String
.
concat
", "
(
List
.
map
html_feature
u_node
.
Ast
.
fs
));
bprintf
buff
"];
\n
"
let
buff_html_edge
buff
(
u_edge
,_
)
=
bprintf
buff
" "
;
bprintf
buff
"%s"
(
match
u_edge
.
Ast
.
edge_id
with
Some
n
->
n
^
": "
|
None
->
""
);
match
u_edge
.
Ast
.
edge_label_cst
with
|
Ast
.
Pos_list
l
->
bprintf
buff
"%s -[%s]-> %s;
\n
"
u_edge
.
Ast
.
src
(
List_
.
to_string
(
fun
x
->
x
)
"|"
l
)
u_edge
.
Ast
.
tar
|
Ast
.
Neg_list
l
->
bprintf
buff
"%s -[^%s]-> %s;
\n
"
u_edge
.
Ast
.
src
(
List_
.
to_string
(
fun
x
->
x
)
"|"
l
)
u_edge
.
Ast
.
tar
|
Ast
.
Regexp
re
->
bprintf
buff
"%s -[re
\"
%s
\"
]-> %s;
\n
"
u_edge
.
Ast
.
src
re
u_edge
.
Ast
.
tar
let
buff_html_const
buff
(
u_const
,_
)
=
bprintf
buff
" "
;
(
match
u_const
with
|
Ast
.
Cst_out
(
ident
,
Ast
.
Neg_list
[]
)
->
bprintf
buff
"%s -> *"
ident
|
Ast
.
Cst_out
(
ident
,
Ast
.
Pos_list
labels
)
->
bprintf
buff
"%s -[%s]-> *"
ident
(
List_
.
to_string
(
fun
x
->
x
)
"|"
labels
)
|
Ast
.
Cst_out
(
ident
,
Ast
.
Neg_list
labels
)
->
bprintf
buff
"%s -[^%s]-> *"
ident
(
List_
.
to_string
(
fun
x
->
x
)
"|"
labels
)
|
Ast
.
Cst_out
(
ident
,
Ast
.
Regexp
re
)
->
bprintf
buff
"%s -[re
\"
%s
\"
]-> *"
ident
re
|
Ast
.
Cst_in
(
ident
,
Ast
.
Neg_list
[]
)
->
bprintf
buff
"* -> %s"
ident
|
Ast
.
Cst_in
(
ident
,
Ast
.
Pos_list
labels
)
->
bprintf
buff
"* -[%s]-> %s"
(
List_
.
to_string
(
fun
x
->
x
)
"|"
labels
)
ident
|
Ast
.
Cst_in
(
ident
,
Ast
.
Neg_list
labels
)
->
bprintf
buff
"* -[^%s]-> %s"
(
List_
.
to_string
(
fun
x
->
x
)
"|"
labels
)
ident
|
Ast
.
Cst_in
(
ident
,
Ast
.
Regexp
re
)
->
bprintf
buff
"* -[re
\"
%s
\"
]-> %s"
re
ident
|
Ast
.
Features_eq
(
feat_id_l
,
feat_id_r
)
->
bprintf
buff
"%s = %s"
(
Ast
.
dump_feature_ident
feat_id_l
)
(
Ast
.
dump_feature_ident
feat_id_r
);
|
Ast
.
Features_diseq
(
feat_id_l
,
feat_id_r
)
->
bprintf
buff
"%s <> %s"
(
Ast
.
dump_feature_ident
feat_id_l
)
(
Ast
.
dump_feature_ident
feat_id_r
);
|
Ast
.
Features_ineq
(
ineq
,
feat_id_l
,
feat_id_r
)
->
bprintf
buff
"%s %s %s"
(
Ast
.
dump_feature_ident
feat_id_l
)
(
Ast
.
string_of_ineq
ineq
)
(
Ast
.
dump_feature_ident
feat_id_r
)
|
Ast
.
Feature_ineq_cst
(
ineq
,
feat_id_l
,
constant
)
->
bprintf
buff
"%s %s %f"
(
Ast
.
dump_feature_ident
feat_id_l
)
(
Ast
.
string_of_ineq
ineq
)
constant
|
Ast
.
Feature_eq_cst
(
feat_id_l
,
value
)
->
bprintf
buff
"%s =
\"
%s
\"
"
(
Ast
.
dump_feature_ident
feat_id_l
)
value
;
|
Ast
.
Feature_diff_cst
(
feat_id_l
,
value
)
->
bprintf
buff
"%s ≠
\"
%s
\"
"
(
Ast
.
dump_feature_ident
feat_id_l
)
value
;
|
Ast
.
Feature_eq_float
(
feat_id_l
,
value
)
->
bprintf
buff
"%s = %g"
(
Ast
.
dump_feature_ident
feat_id_l
)
value
;
|
Ast
.
Feature_diff_float
(
feat_id_l
,
value
)
->
bprintf
buff
"%s ≠ %g"
(
Ast
.
dump_feature_ident
feat_id_l
)
value
;
|
Ast
.
Feature_eq_regexp
(
feat_id
,
regexp
)
->
bprintf
buff
"%s ==
\"
%s
\"
"
(
Ast
.
dump_feature_ident
feat_id
)
regexp
|
Ast
.
Immediate_prec
(
id1
,
id2
)
->
bprintf
buff
"%s < %s"
id1
id2
|
Ast
.
Large_prec
(
id1
,
id2
)
->
bprintf
buff
"%s << %s"
id1
id2
);
bprintf
buff
"
\n
"
let
buff_html_pos_basic
buff
pos_basic
=
bprintf
buff
" <font color=
\"
purple
\"
>match</font> <b>{</b>
\n
"
;
List
.
iter
(
buff_html_node
buff
)
pos_basic
.
Ast
.
pat_nodes
;
List
.
iter
(
buff_html_edge
buff
)
pos_basic
.
Ast
.
pat_edges
;
List
.
iter
(
buff_html_const
buff
)
pos_basic
.
Ast
.
pat_const
;
bprintf
buff
" <b>}</b>
\n
"
let
buff_html_neg_basic
buff
neg_basic
=
bprintf
buff
" <font color=
\"
purple
\"
>without</font> <b>{</b>
\n
"
;
List
.
iter
(
buff_html_node
buff
)
neg_basic
.
Ast
.
pat_nodes
;
List
.
iter
(
buff_html_edge
buff
)
neg_basic
.
Ast
.
pat_edges
;
List
.
iter
(
buff_html_const
buff
)
neg_basic
.
Ast
.
pat_const
;
bprintf
buff
" <b>}</b>
\n
"
let
to_html_rules
rules
=
let
buff
=
Buffer
.
create
32
in
List
.
iter
(
fun
rule
->
(* the first line: (lex_)rule / filter *)
(
match
(
rule
.
Ast
.
commands
,
rule
.
Ast
.
param
)
with
|
(
_
,
None
)
->
bprintf
buff
"<font color=
\"
purple
\"
>rule</font> %s <b>{</b>
\n
"
rule
.
Ast
.
rule_id
|
(
_
,
Some
(
files
,
vars
))
->
let
param
=
match
files
with
|
[]
->
sprintf
"(feature %s)"
(
String
.
concat
", "
vars
)
|
l
->
sprintf
"(feature %s; %s)"
(
String
.
concat
", "
vars
)
(
String
.
concat
", "
(
List
.
map
(
fun
f
->
sprintf
"file
\"
%s
\"
"
f
)
l
))
in
bprintf
buff
"<font color=
\"
purple
\"
>lex_rule</font> %s %s <b>{</b>
\n
"
rule
.
Ast
.
rule_id
param
);
(* the match part *)
buff_html_pos_basic
buff
rule
.
Ast
.
pattern
.
Ast
.
pat_pos
;
(* the without parts *)
List
.
iter
(
buff_html_neg_basic
buff
)
rule
.
Ast
.
pattern
.
Ast
.
pat_negs
;
(* the commands part *)
bprintf
buff
" <font color=
\"
purple
\"
>commands</font> <b>{</b>
\n
"
;
List
.
iter
(
buff_html_command
buff
)
rule
.
Ast
.
commands
;
bprintf
buff
" <b>}</b>
\n
"
;
bprintf
buff
"<b>}</b>
\n
"
;
)
rules
;
Buffer
.
contents
buff
let
doc_to_html
string
=
if
Str
.
string_match
(
Str
.
regexp
"^
\\
* "
)
string
0
then
sprintf
"<font color=
\"
green
\"
><i>%s</i></font>"
(
String
.
sub
string
4
((
String
.
length
string
)
-
4
))
else
List
.
fold_left
(
fun
acc
(
re
,
str
)
->
Str
.
global_replace
(
Str
.
regexp
re
)
str
acc
)
string
[
"
\\
["
,
"<b>"
;
"
\\
]"
,
"</b>"
;
"~"
,
" "
;
]
let
of_opt_color
=
function
|
[]
->
"black"
|
c
::_
->
String
.
sub
c
1
((
String
.
length
c
)
-
1
)
let
module_page_text
~
corpus
prev
next
module_
=
let
buff
=
Buffer
.
create
32
in
let
wnl
fmt
=
Printf
.
ksprintf
(
fun
x
->
Printf
.
bprintf
buff
"%s
\n
"
x
)
fmt
in
let
w
fmt
=
Printf
.
ksprintf
(
fun
x
->
Printf
.
bprintf
buff
"%s"
x
)
fmt
in
let
title
=
sprintf
"Grew -- Module %s"
module_
.
Ast
.
module_id
in
html_header
~
css_file
:
"style.css"
~
title
buff
;
wnl
" <body>"
;
if
corpus
then
wnl
"<a href=
\"
../sentences.html
\"
>Sentences</a> -- <a href=
\"
../index.html
\"
>Rewriting stats</a> -- GRS documentation"
;
wnl
" <div class=
\"
navbar
\"
>"
;
w
" "
;
(
match
prev
with
Some
p
->
w
" <a href=
\"
%s.html
\"
>Previous</a>"
p
|
_
->
()
);
w
" <a href=
\"
index.html
\"
>Up</a>"
;
(
match
next
with
Some
n
->
w
" <a href=
\"
%s.html
\"
>Next</a>"
n
|
_
->
()
);
wnl
" </div>"
;
wnl
" <center><h1>Module <div class=
\"
module_title
\"
>%s</div></h1></center><br/>"
module_
.
Ast
.
module_id
;
List
.
iter
(
fun
s
->
wnl
" %s<br/>"
(
doc_to_html
s
))
module_
.
Ast
.
module_doc
;
wnl
" <h6>%d Rules</h6>"
(
List
.
length
module_
.
Ast
.
rules
);
wnl
" <table class=
\"
indextable
\"
>"
;
List
.
iter
(
fun
rule
->
wnl
" <tr>"
;
wnl
" <td width=
\"
200px
\"
><a href=
\"
%s_%s.html
\"
>%s</a></td>"
module_
.
Ast
.
module_id
rule
.
Ast
.
rule_id
rule
.
Ast
.
rule_id
;
(
match
rule
.
Ast
.
rule_doc
with
[]
->
()
|
l
::_
->
wnl
" <td>%s</td>"
(
doc_to_html
l
));
wnl
" </tr>"
;
)
module_
.
Ast
.
rules
;
wnl
" </table>"
;
wnl
" </body>"
;
wnl
"</html>"
;
Buffer
.
contents
buff
let
rule_page_text
~
corpus
~
dep
prev
next
rule_
module_
=
let
rid
=
rule_
.
Ast
.
rule_id
in
let
mid
=
module_
.
Ast
.
module_id
in
let
buff
=
Buffer
.
create
32
in
let
wnl
fmt
=
Printf
.
ksprintf
(
fun
x
->
Printf
.
bprintf
buff
"%s
\n
"
x
)
fmt
in
let
w
fmt
=
Printf
.
ksprintf
(
fun
x
->
Printf
.
bprintf
buff
"%s"
x
)
fmt
in
let
title
=
sprintf
"Grew -- Rule %s/%s"
mid
rid
in
html_header
~
css_file
:
"style.css"
~
title
buff
;
wnl
" <body>"
;
if
corpus
then
wnl
"<a href=
\"
../sentences.html
\"
>Sentences</a> -- <a href=
\"
../index.html
\"
>Rewriting stats</a> -- GRS documentation"
;
wnl
" <div class=
\"
navbar
\"
>"
;
w
" "
;
(
match
prev
with
Some
p
->
w
" <a href=
\"
%s_%s.html
\"
>Previous</a>"
mid
p
|
_
->
()
);
w
" <a href=
\"
%s.html
\"
>Up</a>"
mid
;
(
match
next
with
Some
n
->
w
" <a href=
\"
%s_%s.html
\"
>Next</a>"
mid
n
|
_
->
()
);
wnl
" </div>"
;
wnl
"<center><h1>Rule <a href=
\"
%s.html
\"
>%s</a>.<div class=
\"
module_title
\"
>%s</div></h1></center>"
mid
mid
rid
;
List
.
iter
(
fun
s
->
wnl
" %s<br/>"
(
doc_to_html
s
))
rule_
.
Ast
.
rule_doc
;
wnl
"<h6>Code</h6>"
;
wnl
"<pre>"
;
w
"%s"
(
to_html_rules
[
rule_
]);
wnl
"</pre>"
;
if
dep
then
begin
wnl
"<h6>Pattern</h6>"
;
wnl
"<pre>"
;
w
"<IMG src=
\"
%s
\"
>"
(
sprintf
"%s_%s-patt.png"
mid
rid
);
wnl
"</pre>"
end
;
let
output_table
args
lines
=
wnl
" <table border=
\"
1
\"
cellspacing=
\"
0
\"
cellpadding=
\"
3
\"
>"
;
wnl
" <tr>%s</tr>"
(
List_
.
to_string
(
fun
x
->
sprintf
"<th bgcolor=
\"
#cccccc
\"
>%s</th>"
x
)
""
args
);
List
.
iter
(
fun
l
->
wnl
"<tr>%s</tr>"
(
List_
.
to_string
(
fun
x
->
sprintf
"<td>%s</td>"
x
)
""
(
Str
.
split
(
Str
.
regexp
"#+"
)
l
))
)
lines
;
wnl
" </table>"
in
(
match
rule_
.
Ast
.
param
with
|
None
->
()
|
Some
(
files
,
args
)
->
wnl
"<h6>Lexical parameters</h6>"
;
(* output local lexical parameters (if any) *)
(
match
rule_
.
Ast
.
lex_par
with
|
None
->
()
|
Some
lines
->
wnl
"<b>Local parameters</b><br/>"
;
output_table
args
lines
);
(* output external lexical parameters (if any) *)
List
.
iter
(
fun
file
->
let
filename
=
Filename
.
concat
module_
.
Ast
.
mod_dir
file
in
wnl
"<b>File:</b> %s<br/>"
file
;
let
lines
=
try
File
.
read
filename
with
Sys_error
msg
->
wnl
"<font color=
\"
red
\"
>Error: %s</font>"
msg
;
[]
in
output_table
args
lines
)
files
);
wnl
" </body>"
;
wnl
"</html>"
;
Buffer
.
contents
buff
let
sequences_text
~
corpus
ast
=
let
buff
=
Buffer
.
create
32
in
let
wnl
fmt
=
Printf
.
ksprintf
(
fun
x
->
Printf
.
bprintf
buff
"%s
\n
"
x
)
fmt
in
let
title
=
sprintf
"Grew -- List of sequences"
in
html_header
~
css_file
:
"style.css"
~
title
buff
;
wnl
" <body>"
;
if
corpus
then
wnl
"<a href=
\"
../sentences.html
\"
>Sentences</a> -- <a href=
\"
../index.html
\"
>Rewriting stats</a> -- GRS documentation"
;
wnl
" <div class=
\"
navbar
\"
> <a href=
\"
index.html
\"
>Up</a></div>"
;
wnl
" <center><h1>List of sequences</h1></center>"
;
List
.
iter
(
fun
ast_seq
->
wnl
"<h6>%s</h6>"
ast_seq
.
Ast
.
strat_name
;
List
.
iter
(
fun
l
->
wnl
"<p>%s</p>"
(
doc_to_html
l
))
ast_seq
.
Ast
.
strat_doc
;
wnl
"<div class=
\"
code
\"
>"
;
wnl
"%s"
(
Ast
.
strat_def_to_string
ast_seq
.
Ast
.
strat_def
);
wnl
"</div>"
;
)
ast
.
Ast
.
strategies
;
wnl
" </body>"
;
wnl
"</html>"
;
Buffer
.
contents
buff
let
index_modules_text
ast
=
let
buff
=
Buffer
.
create
32
in
let
wnl
fmt
=
Printf
.
ksprintf
(
fun
x
->
Printf
.
bprintf
buff
"%s
\n
"
x
)
fmt
in
let
title
=
sprintf
"Grew -- Index of modules"
in
html_header
~
css_file
:
"style.css"
~
title
buff
;
wnl
" <body>"
;
wnl
" <div class=
\"
navbar
\"
> <a href=
\"
index.html
\"
>Up</a></div>"
;
wnl
" <center><h1>Index of modules</h1></center>"
;
wnl
" <table width=100%%>"
;
List
.
iter
(
fun
initial
->
match
List
.
filter
(
fun
mod_
->
Char
.
uppercase_ascii
mod_
.
Ast
.
module_id
.
[
0
]
=
initial
)
ast
.
Ast
.
modules
with
|
[]
->
()
|
l
->
wnl
"<tr><td colspan=2 ><h6>%s</h6></td></tr>"
(
Char
.
escaped
initial
);
List
.
iter
(
fun
mod_
->
wnl
"<tr>"
;
wnl
"<td width=
\"
200px
\"
><a href=
\"
%s.html
\"
>%s</a></td>"
mod_
.
Ast
.
module_id
mod_
.
Ast
.
module_id
;
(
match
mod_
.
Ast
.
module_doc
with
[]
->
()
|
h
::_
->
wnl
"<td>%s</td>
\n
"
(
doc_to_html
h
));
wnl
"</tr>"
;
)
l
)
[
'
A'
;
'
B'
;
'
C'
;
'
D'
;
'
E'
;
'
F'
;
'
G'
;
'
H'
;
'
I'
;
'
J'
;
'
K'
;
'
L'
;
'
M'
;
'
N'
;
'
O'
;
'
P'
;
'
Q'
;
'
R'
;
'
S'
;
'
T'
;
'
U'
;
'
V'
;
'
W'
;
'
X'
;
'
Y'
;
'
Z'
];
wnl
" </body>"
;
wnl
"</html>"
;
Buffer
.
contents
buff
let
domain_text
~
corpus
ast
=
let
buff
=
Buffer
.
create
32
in
let
wnl
fmt
=
Printf
.
ksprintf
(
fun
x
->
Printf
.
bprintf
buff
"%s
\n
"
x
)
fmt
in
let
w
fmt
=
Printf
.
ksprintf
(
fun
x
->
Printf
.
bprintf
buff
"%s"
x
)
fmt
in
let
title
=
sprintf
"Grew -- Features domain"
in
html_header
~
css_file
:
"style.css"
~
title
buff
;
wnl
" <body>"
;
if
corpus
then
wnl
"<a href=
\"
../sentences.html
\"
>Sentences</a> -- <a href=
\"
../index.html
\"
>Rewriting stats</a> -- GRS documentation"
;
wnl
" <div class=
\"
navbar
\"
> <a href=
\"
index.html
\"
>Up</a></div>"
;
wnl
" <h6>Features</h6>"
;
wnl
" <code class=
\"
code
\"
>"
;
List
.
iter
(
function
|
Ast
.
Closed
(
feat_name
,
values
)
->
wnl
"<b>%s</b> : %s<br/>"
feat_name
(
String
.
concat
" | "
values
)
|
Ast
.
Open
feat_name
->
wnl
" <b>%s</b> : *<br/>"
feat_name
|
Ast
.
Num
feat_name
->
wnl
" <b>%s</b> : #<br/>"
feat_name
)
ast
.
Ast
.
feature_domain
;
wnl
" </code>"
;
wnl
" <h6>Labels</h6>"
;
wnl
" <code class=
\"
code
\"
>"
;
(
match
ast
.
Ast
.
label_domain
with
|
[]
->
wnl
"No labels defined!"
|
(
l
,
c
)
::
t
->
w
"<font color=
\"
%s
\"
>%s</font>"
(
of_opt_color
c
)
l
;
List
.
iter
(
fun
(
lab
,
color
)
->
w
", <font color=
\"
%s
\"
>%s</font>"
(
of_opt_color
color
)
lab
;
)
t
;
wnl
""
);
wnl
" </code>"
;
wnl
" </body>"
;
wnl
"</html>"
;
Buffer
.
contents
buff
let
build
~
dep
~
corpus
output_dir
grs
=
let
filename
=
Old_grs
.
get_filename
grs
in
let
ast
=
Old_grs
.
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)); *)
(** index.html **)
let
index
=
Filename
.
concat
output_dir
"index.html"
in
(* let table = create_modules_table ast.Ast.modules in *)
let
buff
=
Buffer
.
create
32
in
let
wnl
fmt
=
Printf
.
ksprintf
(
fun
x
->
Printf
.
bprintf
buff
"%s
\n
"
x
)
fmt
in
let
title
=
sprintf
"Grew -- Graph Rewriting System: %s"
(
Filename
.
basename
filename
)
in
html_header
~
css_file
:
"style.css"
~
title
buff
;
wnl
" <body>"
;
if
corpus
then
wnl
"<a href=
\"
../sentences.html
\"
>Sentences</a> -- <a href=
\"
../index.html
\"
>Rewriting stats</a> -- GRS documentation"
;
wnl
"<h1>Graph Rewriting System: %s</h1>"
(
Filename
.
basename
filename
);
wnl
"<center><b>full path</b>: %s</center>"
filename
;
wnl
"<a href=domain.html>Domain</a><br/>"
;
wnl
"<a href=modules.html>Index of modules</a><br/>"
;
wnl
"<a href=sequences.html>List of sequences</a><br/>"
;
wnl
"<h6>Modules</h6>"
;
wnl
"<table class=
\"
indextable
\"
>"
;
List
.
iter
(
fun
m
->
wnl
"<tr>"
;
wnl
"<td width=
\"
200px
\"
><a href=
\"
%s.html
\"
>%s</a></td>"
m
.
Ast
.
module_id
m
.
Ast
.
module_id
;
(
match
m
.
Ast
.
module_doc
with
[]
->
()
|
h
::_
->
wnl
"<td>%s</td>
\n
"
(
doc_to_html
h
));
wnl
"</tr>"
)
ast
.
Ast
.
modules
;
wnl
"</table>"
;
wnl
"</body>"
;
wnl
"</html>"
;
let
index_out_ch
=
open_out
index
in
output_string
index_out_ch
(
Buffer
.
contents
buff
);
close_out
index_out_ch
;
(** Sequences.html **)
let
sequences
=
Filename
.
concat
output_dir
"sequences.html"
in
let
sequences_out_ch
=
open_out
sequences
in
output_string
sequences_out_ch
(
sequences_text
~
corpus
ast
);
close_out
sequences_out_ch
;
(** Modules.html **)
let
modules
=
Filename
.
concat
output_dir
"modules.html"
in
let
modules_out_ch
=
open_out
modules
in
output_string
modules_out_ch
(
index_modules_text
ast
);
close_out
modules_out_ch
;
(** domain.html **)
let
domain
=
Filename
.
concat
output_dir
"domain.html"
in
let
domain_out_ch
=
open_out
domain
in
begin
match
ast
.
Ast
.
domain
with
|
Some
dom
->
output_string
domain_out_ch
(
domain_text
~
corpus
dom
)
|
None
->
output_string
domain_out_ch
"No domain defined"
end
;
close_out
domain_out_ch
;
(** Modules + rules **)
let
modules_array
=
Array
.
of_list
ast
.
Ast
.
modules
in
for
i
=
0
to
(
Array
.
length
modules_array
-
1
)
do
let
page
=
Filename
.
concat
output_dir
(
modules_array
.
(
i
)
.
Ast
.
module_id
^
".html"
)
in
let
page_out_ch
=
open_out
page
in
output_string
page_out_ch
(
module_page_text
~
corpus
(
try
Some
(
modules_array
.
(
i
-
1
)
.
Ast
.
module_id
)
with
_
->
None
)
(
try
Some
(
modules_array
.
(
i
+
1
)
.
Ast
.
module_id
)
with
_
->
None
)
modules_array
.
(
i
)
);
close_out
page_out_ch
;
let
rules_array
=
Array
.
of_list
modules_array
.
(
i
)
.
Ast
.
rules
in
for
j
=
0
to
(
Array
.
length
rules_array
-
1
)
do
let
page
=
Filename
.
concat
output_dir
(
modules_array
.
(
i
)
.
Ast
.
module_id
^
"_"
^
rules_array
.
(
j
)
.
Ast
.
rule_id
^
".html"
)
in
let
page_out_ch
=
open_out
page
in
output_string
page_out_ch
(
rule_page_text
~
corpus
~
dep
(
try
Some
(
rules_array
.
(
j
-
1
)
.
Ast
.
rule_id
)
with
_
->
None
)
(
try
Some
(
rules_array
.
(
j
+
1
)
.
Ast
.
rule_id
)
with
_
->
None
)
rules_array
.
(
j
)
modules_array
.
(
i
)
);
close_out
page_out_ch
;
done
;
done
end
(* module Html_doc *)
(* ================================================================================ *)
module
Html_rh
=
struct
let
build
?
domain
?
filter
?
main_feat
?
(
dot
=
false
)
?
(
init_graph
=
true
)
?
(
out_gr
=
false
)
?
header
?
graph_file
prefix
t
=
(* remove files from previous runs *)
let
_
=
Unix
.
system
(
sprintf
"rm -f %s*.html"
prefix
)
in
let
_
=
Unix
.
system
(
sprintf
"rm -f %s*.dep"
prefix
)
in
let
_
=
Unix
.
system
(
sprintf
"rm -f %s*.png"
prefix
)
in
(
if
init_graph
then
ignore
(
Instance
.
save_dep_png
?
domain
?
filter
?
main_feat
prefix
t
.
Rewrite_history
.
instance
)
);
let
nf_files
=
Rewrite_history
.
save_nfs
?
domain
?
filter
?
main_feat
~
dot
prefix
t
in
let
l
=
List
.
length
nf_files
in
let
local
=
Filename
.
basename
prefix
in
let
buff
=
Buffer
.
create
32
in
let
wnl
fmt
=
Printf
.
ksprintf
(
fun
x
->
Printf
.
bprintf
buff
"%s
\n
"
x
)
fmt
in
let
title
=
sprintf
"Sentence: %s --- %d Normal form%s"
local
l
(
if
l
>
1
then
"s"
else
""
)
in
html_header
~
css_file
:
"style.css"
~
title
buff
;
wnl
"<body>"
;
wnl
"<a href=
\"
sentences.html
\"
>Sentences</a> -- <a href=
\"
index.html
\"
>Rewriting stats</a> -- <a href=
\"
doc/index.html
\"
>GRS documentation</a>"
;
wnl
"<h1>%s</h1>"
title
;
begin
match
header
with
|
Some
h
->
wnl
"%s<br/>"
h
|
None
->
()
end
;
begin
match
graph_file
with
|
Some
gf
->
wnl
"<b>Input file</b>: <a href=
\"
%s
\"
>%s</a><br/>"
gf
(
Filename
.
basename
gf
)
|
None
->
()
end
;
wnl
"<b>Input sentence</b>: <font color=
\"
green
\"
><i>%s</i></font></p><br/>"
(
G_graph
.
to_sentence
?
main_feat
t
.
Rewrite_history
.
instance
.
Instance
.
graph
);
if
init_graph
then
begin
wnl
"<h6>Initial graph</h6>"
;
wnl
"<div width=100%% style=
\"
overflow-x:auto
\"
><IMG SRC=
\"
%s.png
\"
></div>"
local
end
;
List
.
iteri
(
fun
i
(
rules_list
,
file_name
)
->
wnl
"<h6>Solution %d</h6>"
(
i
+
1
);
let
local_name
=
Filename
.
basename
file_name
in
if
out_gr
then
wnl
"<p><a href=
\"
%s.gr
\"
>gr file</a>"
local_name
;
(* the png file *)
wnl
"<div width=100%% style=
\"
overflow-x:auto
\"
><IMG SRC=
\"
%s.png
\"
></div>"
local_name
;