Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
grew
libcaml-grew
Commits
c99807c1
Commit
c99807c1
authored
May 29, 2017
by
Bruno Guillaume
Browse files
reuse Loc.t in Global
parent
f2405941
Changes
5
Hide whitespace changes
Inline
Side-by-side
src/grew_base.ml
View file @
c99807c1
...
...
@@ -597,17 +597,24 @@ end (* module Timeout *)
(* ================================================================================ *)
module
Global
=
struct
let
current_file
=
ref
None
let
current_line
=
ref
1
let
current_loc
=
ref
Loc
.
empty
let
label_flag
=
ref
false
let
debug
=
ref
false
let
loc_string
()
=
match
!
current_file
with
|
None
->
sprintf
"[line %d]"
!
current_line
|
Some
f
->
sprintf
"[file %s, line %d]"
f
!
current_line
let
get_loc
()
=
!
current_loc
let
loc_string
()
=
Loc
.
to_string
!
current_loc
let
new_file
filename
=
current_loc
:=
(
Some
filename
,
Some
1
);
label_flag
:=
false
let
init
file
=
current_file
:=
Some
file
;
current_line
:=
1
;
let
new_string
()
=
current_loc
:=
(
None
,
Some
1
);
label_flag
:=
false
let
new_line
()
=
match
!
current_loc
with
|
(
_
,
None
)
->
()
|
(
fo
,
Some
l
)
->
current_loc
:=
(
fo
,
Some
(
l
+
1
))
let
debug
=
ref
false
end
src/grew_base.mli
View file @
c99807c1
...
...
@@ -282,12 +282,13 @@ end
(* ================================================================================ *)
module
Global
:
sig
val
current_file
:
string
option
ref
val
current_line
:
int
ref
val
init
:
string
->
unit
val
label_flag
:
bool
ref
val
new_file
:
string
->
unit
val
new_string
:
unit
->
unit
val
new_line
:
unit
->
unit
val
get_loc
:
unit
->
Loc
.
t
val
loc_string
:
unit
->
string
val
label_flag
:
bool
ref
val
debug
:
bool
ref
end
src/grew_lexer.mll
View file @
c99807c1
...
...
@@ -56,7 +56,7 @@ let color = hex hex hex hex hex hex | hex hex hex
(* ------------------------------------------------------------------------------- *)
rule
comment
target
=
parse
|
'\n'
{
incr
Global
.
current
_line
;
Lexing
.
new_line
lexbuf
;
target
lexbuf
}
|
'\n'
{
Global
.
new
_line
()
;
Lexing
.
new_line
lexbuf
;
target
lexbuf
}
|
eof
{
EOF
}
|
_
{
comment
target
lexbuf
}
...
...
@@ -65,7 +65,7 @@ and comment_multi_doc target = shortest
let
start
=
ref
0
in
try
while
(
Str
.
search_forward
(
Str
.
regexp
"
\n
"
)
comment
!
start
!=
-
1
)
do
start
:=
Str
.
match_end
()
;
incr
Global
.
current
_line
;
Global
.
new
_line
()
;
Lexing
.
new_line
lexbuf
;
done
;
assert
false
with
Not_found
->
...
...
@@ -74,7 +74,7 @@ and comment_multi_doc target = shortest
and
comment_multi
target
=
parse
|
"*/"
{
target
lexbuf
}
|
'\n'
{
incr
Global
.
current
_line
;
Lexing
.
new_line
lexbuf
;
comment_multi
target
lexbuf
}
|
'\n'
{
Global
.
new
_line
()
;
Lexing
.
new_line
lexbuf
;
comment_multi
target
lexbuf
}
|
_
{
comment_multi
target
lexbuf
}
and
string_lex
re
target
=
parse
...
...
@@ -83,7 +83,7 @@ and string_lex re target = parse
then
(
bprintf
buff
"
\\
"
;
escaped
:=
false
;
string_lex
re
target
lexbuf
)
else
(
escaped
:=
true
;
string_lex
re
target
lexbuf
)
}
|
'\n'
{
incr
Global
.
current
_line
;
Lexing
.
new_line
lexbuf
;
bprintf
buff
"
\n
"
;
string_lex
re
target
lexbuf
}
|
'\n'
{
Global
.
new
_line
()
;
Lexing
.
new_line
lexbuf
;
bprintf
buff
"
\n
"
;
string_lex
re
target
lexbuf
}
|
'\"'
{
if
!
escaped
then
(
bprintf
buff
"
\"
"
;
escaped
:=
false
;
string_lex
re
target
lexbuf
)
...
...
@@ -98,9 +98,9 @@ and string_lex re target = parse
(* a dedicated lexer for lexical parameter: read everything until "#END" *)
and
lp_lex
target
=
parse
|
'\n'
{
incr
Global
.
current
_line
;
Lexing
.
new_line
lexbuf
;
bprintf
buff
"
\n
"
;
lp_lex
target
lexbuf
}
|
'\n'
{
Global
.
new
_line
()
;
Lexing
.
new_line
lexbuf
;
bprintf
buff
"
\n
"
;
lp_lex
target
lexbuf
}
|
_
as
c
{
bprintf
buff
"%c"
c
;
lp_lex
target
lexbuf
}
|
"#END"
[
'
'
'\t'
]
*
'\n'
{
incr
Global
.
current
_line
;
LEX_PAR
(
Str
.
split
(
Str
.
regexp
"
\n
"
)
(
Buffer
.
contents
buff
))
}
|
"#END"
[
'
'
'\t'
]
*
'\n'
{
Global
.
new
_line
()
;
LEX_PAR
(
Str
.
split
(
Str
.
regexp
"
\n
"
)
(
Buffer
.
contents
buff
))
}
(* The lexer must be different when label_ident are parsed. The [global] lexer calls either
[label_parser] or [standard] depending on the flag [Global.label_flag].
...
...
@@ -120,7 +120,7 @@ and label_parser target = parse
|
[
'
'
'\t'
]
{
global
lexbuf
}
|
"/*"
{
comment_multi
global
lexbuf
}
|
'
%
'
{
comment
global
lexbuf
}
|
'\n'
{
incr
Global
.
current
_line
;
Lexing
.
new_line
lexbuf
;
global
lexbuf
}
|
'\n'
{
Global
.
new
_line
()
;
Lexing
.
new_line
lexbuf
;
global
lexbuf
}
|
'
{
'
{
LACC
}
|
'
}
'
{
Global
.
label_flag
:=
false
;
RACC
}
...
...
@@ -146,9 +146,9 @@ and standard target = parse
|
"/*"
{
comment_multi
global
lexbuf
}
|
'
%
'
{
comment
global
lexbuf
}
|
"#BEGIN"
[
'
'
'\t'
]
*
'\n'
{
incr
Global
.
current
_line
;
Buffer
.
clear
buff
;
lp_lex
global
lexbuf
}
|
"#BEGIN"
[
'
'
'\t'
]
*
'\n'
{
Global
.
new
_line
()
;
Buffer
.
clear
buff
;
lp_lex
global
lexbuf
}
|
'\n'
{
incr
Global
.
current
_line
;
Lexing
.
new_line
lexbuf
;
global
lexbuf
}
|
'\n'
{
Global
.
new
_line
()
;
Lexing
.
new_line
lexbuf
;
global
lexbuf
}
|
"include"
{
INCL
}
|
"domain"
{
DOMAIN
}
...
...
@@ -242,7 +242,7 @@ and standard target = parse
and
const
=
parse
|
[
'
'
'\t'
]
{
const
lexbuf
}
|
'\n'
{
incr
Global
.
current
_line
;
const
lexbuf
}
|
'\n'
{
Global
.
new
_line
()
;
const
lexbuf
}
|
'
(
'
{
LPAREN
}
|
'
)
'
{
RPAREN
}
|
[
^
'
(
'
'
)
'
'
'
]
+
as
id
{
ID
id
}
src/grew_loader.ml
View file @
c99807c1
...
...
@@ -13,15 +13,14 @@ open Grew_ast
(* ------------------------------------------------------------------------------------------*)
(** general function to handle parse errors *)
let
parse_handle
file
fct
lexbuf
=
let
get_loc
()
=
Loc
.
file_line
file
!
Global
.
current_line
in
let
parse_handle
fct
lexbuf
=
try
fct
lexbuf
with
|
Grew_lexer
.
Error
msg
->
Error
.
parse
~
loc
:
(
get_loc
()
)
"Lexing error: %s"
msg
|
Grew_parser
.
Error
->
Error
.
parse
~
loc
:
(
get_loc
()
)
"Syntax error: %s"
(
Lexing
.
lexeme
lexbuf
)
|
Error
.
Build
(
msg
,
None
)
->
Error
.
parse
~
loc
:
(
get_loc
()
)
"Syntax error: %s"
msg
|
Grew_lexer
.
Error
msg
->
Error
.
parse
~
loc
:
(
Global
.
get_loc
()
)
"Lexing error: %s"
msg
|
Grew_parser
.
Error
->
Error
.
parse
~
loc
:
(
Global
.
get_loc
()
)
"Syntax error: %s"
(
Lexing
.
lexeme
lexbuf
)
|
Error
.
Build
(
msg
,
None
)
->
Error
.
parse
~
loc
:
(
Global
.
get_loc
()
)
"Syntax error: %s"
msg
|
Error
.
Build
(
msg
,
Some
loc
)
->
Error
.
parse
~
loc
"Syntax error: %s"
msg
|
Failure
msg
->
Error
.
parse
~
loc
:
(
get_loc
()
)
"Failure: %s"
msg
|
err
->
Error
.
bug
~
loc
:
(
get_loc
()
)
"Unexpected error: %s"
(
Printexc
.
to_string
err
)
|
Failure
msg
->
Error
.
parse
~
loc
:
(
Global
.
get_loc
()
)
"Failure: %s"
msg
|
err
->
Error
.
bug
~
loc
:
(
Global
.
get_loc
()
)
"Unexpected error: %s"
(
Printexc
.
to_string
err
)
module
Loader
=
struct
...
...
@@ -29,10 +28,10 @@ module Loader = struct
(* ------------------------------------------------------------------------------------------*)
let
parse_file_to_grs_wi
file
=
try
Global
.
init
file
;
Global
.
new_file
file
;
let
in_ch
=
open_in
file
in
let
lexbuf
=
Lexing
.
from_channel
in_ch
in
let
grs
=
parse_handle
file
(
Grew_parser
.
grs_wi
Grew_lexer
.
global
)
lexbuf
in
let
grs
=
parse_handle
(
Grew_parser
.
grs_wi
Grew_lexer
.
global
)
lexbuf
in
close_in
in_ch
;
grs
with
Sys_error
msg
->
Error
.
parse
~
loc
:
(
Loc
.
file
file
)
"[Grew_loader.Loader.parse_file_to_grs_wi] %s"
msg
...
...
@@ -40,10 +39,10 @@ module Loader = struct
(* ------------------------------------------------------------------------------------------*)
let
parse_file_to_module_list
file
=
try
Global
.
init
file
;
Global
.
new_file
file
;
let
in_ch
=
open_in
file
in
let
lexbuf
=
Lexing
.
from_channel
in_ch
in
let
module_list
=
parse_handle
file
(
Grew_parser
.
included
Grew_lexer
.
global
)
lexbuf
in
let
module_list
=
parse_handle
(
Grew_parser
.
included
Grew_lexer
.
global
)
lexbuf
in
close_in
in_ch
;
module_list
with
Sys_error
msg
->
Error
.
parse
~
loc
:
(
Loc
.
file
file
)
"[Grew_loader.Loader.parse_file_to_module_list] %s"
msg
...
...
@@ -51,10 +50,10 @@ module Loader = struct
(* ------------------------------------------------------------------------------------------*)
let
domain
file
=
try
Global
.
init
file
;
Global
.
new_file
file
;
let
in_ch
=
open_in
file
in
let
lexbuf
=
Lexing
.
from_channel
in_ch
in
let
gr
=
parse_handle
file
(
Grew_parser
.
domain
Grew_lexer
.
global
)
lexbuf
in
let
gr
=
parse_handle
(
Grew_parser
.
domain
Grew_lexer
.
global
)
lexbuf
in
close_in
in_ch
;
gr
with
Sys_error
msg
->
Error
.
parse
~
loc
:
(
Loc
.
file
file
)
"[Grew_loader.Loader.domain] %s"
msg
...
...
@@ -99,10 +98,10 @@ module Loader = struct
(* ------------------------------------------------------------------------------------------*)
let
gr
file
=
try
Global
.
init
file
;
Global
.
new_file
file
;
let
in_ch
=
open_in
file
in
let
lexbuf
=
Lexing
.
from_channel
in_ch
in
let
gr
=
parse_handle
file
(
Grew_parser
.
gr
Grew_lexer
.
global
)
lexbuf
in
let
gr
=
parse_handle
(
Grew_parser
.
gr
Grew_lexer
.
global
)
lexbuf
in
close_in
in_ch
;
gr
with
Sys_error
msg
->
Error
.
parse
~
loc
:
(
Loc
.
file
file
)
"[Grew_loader.Loader.gr] %s"
msg
...
...
@@ -111,10 +110,10 @@ module Loader = struct
(* ------------------------------------------------------------------------------------------*)
let
pattern
file
=
try
Global
.
init
file
;
Global
.
new_file
file
;
let
in_ch
=
open_in
file
in
let
lexbuf
=
Lexing
.
from_channel
in_ch
in
let
pattern
=
parse_handle
file
(
Grew_parser
.
pattern
Grew_lexer
.
global
)
lexbuf
in
let
pattern
=
parse_handle
(
Grew_parser
.
pattern
Grew_lexer
.
global
)
lexbuf
in
close_in
in_ch
;
pattern
with
Sys_error
msg
->
Error
.
parse
~
loc
:
(
Loc
.
file
file
)
"[Grew_loader.Loader.pattern] %s"
msg
...
...
@@ -122,10 +121,10 @@ module Loader = struct
(* ------------------------------------------------------------------------------------------*)
let
phrase_structure_tree
file
=
try
Global
.
init
file
;
Global
.
new_file
file
;
let
in_ch
=
open_in
file
in
let
lexbuf
=
Lexing
.
from_channel
in_ch
in
let
graph
=
parse_handle
file
(
Grew_parser
.
phrase_structure_tree
Grew_lexer
.
const
)
lexbuf
in
let
graph
=
parse_handle
(
Grew_parser
.
phrase_structure_tree
Grew_lexer
.
const
)
lexbuf
in
close_in
in_ch
;
graph
with
Sys_error
msg
->
Error
.
parse
~
loc
:
(
Loc
.
file
file
)
"[Grew_loader.Loader.phrase_structure_tree] %s"
msg
...
...
@@ -137,36 +136,36 @@ module Parser = struct
(* ------------------------------------------------------------------------------------------*)
let
gr
gr_string
=
try
Global
.
init
"Not a file"
;
Global
.
new_string
()
;
let
lexbuf
=
Lexing
.
from_string
gr_string
in
let
gr
=
parse_handle
"Not a file"
(
Grew_parser
.
gr
Grew_lexer
.
global
)
lexbuf
in
let
gr
=
parse_handle
(
Grew_parser
.
gr
Grew_lexer
.
global
)
lexbuf
in
gr
with
Sys_error
msg
->
Error
.
parse
"[Grew_loader.Parser.gr] %s"
msg
(* ------------------------------------------------------------------------------------------*)
let
phrase_structure_tree
s
=
try
Global
.
init
"Not a file"
;
Global
.
new_string
()
;
let
lexbuf
=
Lexing
.
from_string
s
in
let
graph
=
parse_handle
"Not a file"
(
Grew_parser
.
phrase_structure_tree
Grew_lexer
.
const
)
lexbuf
in
let
graph
=
parse_handle
(
Grew_parser
.
phrase_structure_tree
Grew_lexer
.
const
)
lexbuf
in
graph
with
Sys_error
msg
->
Error
.
parse
"[Grew_loader.Parser.phrase_structure_tree] %s"
msg
(* ------------------------------------------------------------------------------------------*)
let
pattern
desc
=
try
Global
.
init
"Not a file"
;
Global
.
new_string
()
;
let
lexbuf
=
Lexing
.
from_string
desc
in
let
pattern
=
parse_handle
"Not a file"
(
Grew_parser
.
pattern
Grew_lexer
.
global
)
lexbuf
in
let
pattern
=
parse_handle
(
Grew_parser
.
pattern
Grew_lexer
.
global
)
lexbuf
in
pattern
with
Sys_error
msg
->
Error
.
parse
"[Grew_loader.Parser.pattern] %s"
msg
(* ------------------------------------------------------------------------------------------*)
let
strat_def
desc
=
try
Global
.
init
"Not a file"
;
Global
.
new_string
()
;
let
lexbuf
=
Lexing
.
from_string
desc
in
let
strategy
=
parse_handle
"Not a file"
(
Grew_parser
.
strat_def
Grew_lexer
.
global
)
lexbuf
in
let
strategy
=
parse_handle
(
Grew_parser
.
strat_def
Grew_lexer
.
global
)
lexbuf
in
strategy
with
Sys_error
msg
->
Error
.
parse
"[Grew_loader.Parser.strategy] %s"
msg
...
...
src/grew_parser.mly
View file @
c99807c1
...
...
@@ -28,7 +28,7 @@ type ineq_item =
|
Ineq_sofi
of
Ast
.
simple_or_feature_ident
|
Ineq_float
of
float
let
get_loc
()
=
Loc
.
file_opt_line
!
Global
.
current_file
!
Global
.
current_line
let
get_loc
()
=
Global
.
get_loc
()
let
localize
t
=
(
t
,
get_loc
()
)
%
}
...
...
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