Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
grew
libcaml-grew
Commits
0455c29d
Commit
0455c29d
authored
Nov 23, 2014
by
Bruno Guillaume
Browse files
the "loc" type is abstract and exported
parent
8dc5feb4
Changes
7
Hide whitespace changes
Inline
Side-by-side
src/grew_base.ml
View file @
0455c29d
...
...
@@ -21,15 +21,15 @@ module Int_map = Map.Make (struct type t = int let compare = Pervasives.compare
module
Loc
=
struct
type
t
=
string
*
int
let
to_string
(
file
,
line
)
=
sprintf
"(file: %s, line: %d)"
(
Filename
.
basename
file
)
line
let
file_line
f
l
=
(
f
,
l
)
let
file
f
=
(
f
,
-
1
)
let
to_string
(
file
,
line
)
=
sprintf
"[file: %s, line: %d]"
(
Filename
.
basename
file
)
line
let
opt_set_line
line
=
function
|
None
->
None
|
Some
(
file
,_
)
->
Some
(
file
,
line
)
let
opt_to_string
=
function
|
None
->
""
|
Some
x
->
to_string
x
end
(* module Loc *)
(* ================================================================================ *)
...
...
src/grew_base.mli
View file @
0455c29d
...
...
@@ -39,7 +39,10 @@ end
(* ================================================================================ *)
(* [Loc] general module to describe errors location: (file name, line number in file) *)
module
Loc
:
sig
type
t
=
string
*
int
type
t
val
file_line
:
string
->
int
->
t
val
file
:
string
->
t
val
opt_set_line
:
int
->
t
option
->
t
option
...
...
src/grew_types.ml
View file @
0455c29d
...
...
@@ -348,7 +348,7 @@ module Conll = struct
match
Str
.
split
(
Str
.
regexp
"="
)
feat
with
|
[
feat_name
]
->
(
feat_name
,
"true"
)
|
[
feat_name
;
feat_value
]
->
(
feat_name
,
feat_value
)
|
_
->
Error
.
build
~
loc
:
(
file_name
,
line_num
)
"[Conll.load] illegal morphology
\n
>>>>>%s<<<<<<"
morph
|
_
->
Error
.
build
~
loc
:
(
Loc
.
file_line
file_name
line_num
)
"[Conll.load] illegal morphology
\n
>>>>>%s<<<<<<"
morph
)
(
Str
.
split
(
Str
.
regexp
"|"
)
morph
)
let
underscore
s
=
if
s
=
""
then
"_"
else
s
...
...
@@ -369,9 +369,9 @@ module Conll = struct
morph
=
parse_morph
file_name
line_num
morph
;
deps
=
deps
;
}
with
exc
->
Error
.
build
~
loc
:
(
file_name
,
line_num
)
"[Conll.load] illegal line, exc=%s
\n
>>>>>%s<<<<<<"
(
Printexc
.
to_string
exc
)
line
with
exc
->
Error
.
build
~
loc
:
(
Loc
.
file_line
file_name
line_num
)
"[Conll.load] illegal line, exc=%s
\n
>>>>>%s<<<<<<"
(
Printexc
.
to_string
exc
)
line
end
|
l
->
Error
.
build
~
loc
:
(
file_name
,
line_num
)
"[Conll.load] illegal line, %d fields (10 are expected)
\n
>>>>>%s<<<<<<"
(
List
.
length
l
)
line
|
l
->
Error
.
build
~
loc
:
(
Loc
.
file_line
file_name
line_num
)
"[Conll.load] illegal line, %d fields (10 are expected)
\n
>>>>>%s<<<<<<"
(
List
.
length
l
)
line
let
load
file_name
=
let
lines
=
File
.
read_ln
file_name
in
...
...
@@ -435,7 +435,7 @@ module Lex_par = struct
then
Filename
.
concat
dir
file
else
file
in
let
lines
=
File
.
read
full_file
in
List_
.
opt_mapi
(
fun
i
line
->
parse_line
~
loc
:
(
full_file
,
i
)
nb_p
nb_c
line
)
lines
List_
.
opt_mapi
(
fun
i
line
->
parse_line
~
loc
:
(
Loc
.
file_line
full_file
i
)
nb_p
nb_c
line
)
lines
with
Sys_error
_
->
Error
.
build
?
loc
"External lexical file '%s' not found"
file
let
sub
x
y
=
List
.
mem
x
(
Str
.
split
(
Str
.
regexp
"|"
)
y
)
...
...
src/libgrew.ml
View file @
0455c29d
...
...
@@ -31,30 +31,30 @@ let empty_grs = Grs.empty
let
set_timeout
t
=
Timeout
.
timeout
:=
t
type
loc
=
Loc
.
t
let
string_of_loc
=
Loc
.
to_string
exception
File_dont_exists
of
string
exception
Parsing_err
of
string
exception
Build
of
string
*
(
string
*
int
)
option
exception
Run
of
string
*
(
string
*
int
)
option
exception
Bug
of
string
*
(
string
*
int
)
option
exception
Parsing_err
of
string
*
loc
option
exception
Build
of
string
*
loc
option
exception
Run
of
string
*
loc
option
exception
Bug
of
string
*
loc
option
let
handle
?
(
name
=
""
)
?
(
file
=
"No file defined"
)
fct
()
=
try
fct
()
with
(* Raise again already catched exceptions *)
|
Parsing_err
msg
->
raise
(
Parsing_err
msg
)
|
Build
(
msg
,
loc
)
->
raise
(
Build
(
msg
,
loc
))
|
Bug
(
msg
,
loc
)
->
raise
(
Bug
(
msg
,
loc
))
|
Run
(
msg
,
loc
)
->
raise
(
Run
(
msg
,
loc
))
|
Parsing_err
(
msg
,
loc_opt
)
->
raise
(
Parsing_err
(
msg
,
loc_opt
)
)
|
Build
(
msg
,
loc
_opt
)
->
raise
(
Build
(
msg
,
loc
_opt
))
|
Bug
(
msg
,
loc
_opt
)
->
raise
(
Bug
(
msg
,
loc
_opt
))
|
Run
(
msg
,
loc
_opt
)
->
raise
(
Run
(
msg
,
loc
_opt
))
(* Catch new exceptions *)
|
Grew_parser
.
Parse_error
(
msg
,
Some
(
sub_file
,
l
))
->
raise
(
Parsing_err
(
sprintf
"[file:%s, line:%d] %s"
sub_file
l
msg
))
|
Grew_parser
.
Parse_error
(
msg
,
None
)
->
raise
(
Parsing_err
(
sprintf
"[file:%s] %s"
file
msg
))
|
Error
.
Build
(
msg
,
loc
)
->
raise
(
Build
(
msg
,
loc
))
|
Error
.
Bug
(
msg
,
loc
)
->
raise
(
Bug
(
msg
,
loc
))
|
Error
.
Run
(
msg
,
loc
)
->
raise
(
Run
(
msg
,
loc
))
|
Grew_parser
.
Parse_error
(
msg
,
loc_opt
)
->
raise
(
Parsing_err
(
msg
,
loc_opt
))
|
Error
.
Build
(
msg
,
loc_opt
)
->
raise
(
Build
(
msg
,
loc_opt
))
|
Error
.
Bug
(
msg
,
loc_opt
)
->
raise
(
Bug
(
msg
,
loc_opt
))
|
Error
.
Run
(
msg
,
loc_opt
)
->
raise
(
Run
(
msg
,
loc_opt
))
|
exc
->
raise
(
Bug
(
sprintf
"[Libgrew.%s] UNCATCHED EXCEPTION: %s"
name
(
Printexc
.
to_string
exc
)
,
None
))
...
...
@@ -118,7 +118,7 @@ let load_gr file =
let
load_conll
file
=
handle
~
name
:
"load_conll"
~
file
(
fun
()
->
let
graph
=
G_graph
.
of_conll
~
loc
:
(
file
,-
1
)
(
Conll
.
load
file
)
in
let
graph
=
G_graph
.
of_conll
~
loc
:
(
Loc
.
file
file
)
(
Conll
.
load
file
)
in
Instance
.
from_graph
graph
)
()
...
...
src/libgrew_.mli
View file @
0455c29d
...
...
@@ -16,16 +16,20 @@ open Grew_grs
val
css_file
:
string
exception
Parsing_err
of
string
type
loc
=
Loc
.
t
val
string_of_loc
:
loc
->
string
exception
File_dont_exists
of
string
exception
Parsing_err
of
string
*
loc
option
(** raised when a Gr/Grs structure fails to build *)
exception
Build
of
string
*
(
string
*
int
)
option
exception
Build
of
string
*
loc
option
(** raised during rewriting when a command is undefined *)
exception
Run
of
string
*
(
string
*
int
)
option
(** raised during rewriting when a command is undefined *)
exception
Run
of
string
*
loc
option
exception
Bug
of
string
*
(
string
*
int
)
option
exception
Bug
of
string
*
loc
option
val
set_timeout
:
float
option
->
unit
...
...
@@ -35,7 +39,7 @@ val is_empty: Rewrite_history.t -> bool
val
num_sol
:
Rewrite_history
.
t
->
int
(** display a gr with a grs in a rew_display
(** display a gr with a grs in a rew_display
@param gr the grapth to rewrite
@param grs the graph rewriting system
@param seq the name of the sequence to apply
...
...
@@ -46,7 +50,7 @@ val write_stat: string -> Rewrite_history.t -> unit
val
empty_grs
:
Grs
.
t
(** get a graph rewriting system from a file
(** get a graph rewriting system from a file
@return a graph rewriting system
@raise Parsing_err if libgrew can't parse the file
@raise File_dont_exists if the file doesn't exists
...
...
@@ -56,7 +60,7 @@ val load_grs: string -> Grs.t
(** [build_html_doc directory grs ] *)
val
build_html_doc
:
?
corpus
:
bool
->
string
->
Grs
.
t
->
unit
(** give the list of sequence names defined in a GRS
(** give the list of sequence names defined in a GRS
@return a string list
*)
val
get_sequence_names
:
Grs
.
t
->
string
list
...
...
@@ -102,35 +106,35 @@ val save_index: dirname:string -> base_names: string list -> unit
val
write_annot
:
title
:
string
->
string
->
string
->
(
string
*
Rewrite_history
.
t
)
list
->
unit
val
write_html
:
val
write_html
:
?
no_init
:
bool
->
?
out_gr
:
bool
->
?
filter
:
string
list
->
?
main_feat
:
string
->
?
main_feat
:
string
->
?
dot
:
bool
->
header
:
string
->
?
graph_file
:
string
->
Rewrite_history
.
t
->
string
->
unit
val
error_html
:
?
no_init
:
bool
->
?
main_feat
:
string
->
val
error_html
:
?
no_init
:
bool
->
?
main_feat
:
string
->
?
dot
:
bool
->
header
:
string
->
string
->
?
init
:
Instance
.
t
->
string
->
header
:
string
->
string
->
?
init
:
Instance
.
t
->
string
->
unit
val
make_index
:
val
make_index
:
title
:
string
->
grs_file
:
string
->
html
:
bool
->
grs
:
Grs
.
t
->
grs_file
:
string
->
html
:
bool
->
grs
:
Grs
.
t
->
seq
:
string
->
input_dir
:
string
->
output_dir
:
string
->
base_names
:
string
list
->
input_dir
:
string
->
output_dir
:
string
->
base_names
:
string
list
->
unit
val
html_sentences
:
title
:
string
->
string
->
(
bool
*
string
*
int
*
string
)
list
->
unit
...
...
src/parser/gr_grs_parser.mly
View file @
0455c29d
...
...
@@ -24,7 +24,7 @@ type graph_item =
|
Graph_node
of
Ast
.
node
|
Graph_edge
of
Ast
.
edge
let
get_loc
()
=
(
!
Parser_global
.
current_file
,
!
Parser_global
.
current_line
+
1
)
let
get_loc
()
=
Loc
.
file_line
!
Parser_global
.
current_file
(
!
Parser_global
.
current_line
+
1
)
let
localize
t
=
(
t
,
get_loc
()
)
%
}
...
...
@@ -258,7 +258,7 @@ grew_module:
rules
=
r
;
confluent
=
conf
;
module_doc
=
(
match
doc
with
Some
d
->
d
|
None
->
[]
);
mod_loc
=
(
!
Parser_global
.
current_file
,
snd
id_loc
);
mod_loc
=
Loc
.
file_line
!
Parser_global
.
current_file
(
snd
id_loc
);
mod_dir
=
""
;
}
}
...
...
@@ -285,7 +285,7 @@ rule:
param
=
None
;
lp
=
None
;
rule_doc
=
begin
match
doc
with
Some
d
->
d
|
None
->
[]
end
;
rule_loc
=
(
!
Parser_global
.
current_file
,
snd
id_loc
);
rule_loc
=
Loc
.
file_line
!
Parser_global
.
current_file
(
snd
id_loc
);
}
}
|
doc
=
option
(
COMMENT
)
LEX_RULE
id_loc
=
simple_id_with_loc
param
=
option
(
param
)
LACC
p
=
pos_item
n
=
list
(
neg_item
)
cmds
=
commands
RACC
lp
=
option
(
lp
)
...
...
@@ -297,7 +297,7 @@ rule:
param
=
param
;
lp
=
lp
;
rule_doc
=
begin
match
doc
with
Some
d
->
d
|
None
->
[]
end
;
rule_loc
=
(
!
Parser_global
.
current_file
,
snd
id_loc
);
rule_loc
=
Loc
.
file_line
!
Parser_global
.
current_file
(
snd
id_loc
);
}
}
|
doc
=
option
(
COMMENT
)
FILTER
id_loc
=
simple_id_with_loc
LACC
p
=
pos_item
n
=
list
(
neg_item
)
RACC
...
...
@@ -309,7 +309,7 @@ rule:
param
=
None
;
lp
=
None
;
rule_doc
=
begin
match
doc
with
Some
d
->
d
|
None
->
[]
end
;
rule_loc
=
(
!
Parser_global
.
current_file
,
snd
id_loc
);
rule_loc
=
Loc
.
file_line
!
Parser_global
.
current_file
(
snd
id_loc
);
}
}
...
...
@@ -516,7 +516,7 @@ sequence:
{
Ast
.
seq_name
=
fst
id_loc
;
seq_mod
=
List
.
map
(
fun
x
->
Ast
.
simple_id_of_ci
x
)
mod_names
;
seq_doc
=
begin
match
doc
with
Some
d
->
d
|
None
->
[]
end
;
seq_loc
=
(
!
Parser_global
.
current_file
,
snd
id_loc
);
seq_loc
=
Loc
.
file_line
!
Parser_global
.
current_file
(
snd
id_loc
);
}
}
%%
src/parser/grew_parser.ml
View file @
0455c29d
...
...
@@ -22,19 +22,19 @@ module Grew_parser = struct
try
fct
lexbuf
with
|
Lexer
.
Error
msg
->
let
cp
=
lexbuf
.
Lexing
.
lex_curr_p
.
Lexing
.
pos_lnum
in
raise
(
Parse_error
(
"Lexing error:"
^
msg
,
Some
(
file
,
cp
)))
raise
(
Parse_error
(
"Lexing error:"
^
msg
,
Some
(
Loc
.
file_line
file
cp
)))
|
Gr_grs_parser
.
Error
->
let
cp
=
lexbuf
.
Lexing
.
lex_curr_p
.
Lexing
.
pos_lnum
in
raise
(
Parse_error
(
"Syntax error:"
^
(
Lexing
.
lexeme
lexbuf
)
,
Some
(
file
,
cp
)))
raise
(
Parse_error
(
"Syntax error:"
^
(
Lexing
.
lexeme
lexbuf
)
,
Some
(
Loc
.
file_line
file
cp
)))
|
Failure
msg
->
let
cp
=
lexbuf
.
Lexing
.
lex_curr_p
.
Lexing
.
pos_lnum
in
raise
(
Parse_error
(
"Failure:"
^
msg
,
Some
(
file
,
cp
)))
raise
(
Parse_error
(
"Failure:"
^
msg
,
Some
(
Loc
.
file_line
file
cp
)))
|
Error
.
Build
(
msg
,_
)
->
let
cp
=
lexbuf
.
Lexing
.
lex_curr_p
.
Lexing
.
pos_lnum
in
raise
(
Parse_error
(
"Syntax error:"
^
msg
,
Some
(
file
,
cp
)))
raise
(
Parse_error
(
"Syntax error:"
^
msg
,
Some
(
Loc
.
file_line
file
cp
)))
|
err
->
let
cp
=
lexbuf
.
Lexing
.
lex_curr_p
.
Lexing
.
pos_lnum
in
raise
(
Parse_error
(
"Unexpected error:"
^
(
Printexc
.
to_string
err
)
,
Some
(
file
,
cp
)))
raise
(
Parse_error
(
"Unexpected error:"
^
(
Printexc
.
to_string
err
)
,
Some
(
Loc
.
file_line
file
cp
)))
(* ------------------------------------------------------------------------------------------*)
let
parse_file_to_grs_with_includes
file
=
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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