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
POTTIER Francois
menhir
Commits
69bd2a49
Commit
69bd2a49
authored
Sep 24, 2015
by
POTTIER Francois
Browse files
Updated [FancyDriver] to produce a fancy message. This seems to be working.
parent
13bd0b0f
Changes
1
Hide whitespace changes
Inline
Side-by-side
src/fancyDriver.ml
View file @
69bd2a49
...
...
@@ -7,49 +7,67 @@
(* TEMPORARY a lot of code is copied from [Engine]. Can we avoid it? *)
(* A short name for the incremental parser API. *)
module
I
=
Parser
.
MenhirInterpreter
open
MenhirLib
.
General
(* streams: Nil, Cons *)
open
Parser
.
MenhirInterpreter
(* incremental API to our parser *)
(* The loop which drives the parser. At each iteration, we analyze a
result produced by the parser, and act in an appropriate manner. *)
(* [lexbuf] is the lexing buffer. [result] is the last result produced
by the parser. *)
result produced by the parser, and act in an appropriate manner.
We have to do this in order to get ahold of the current state when
a syntax error is encountered. *)
let
rec
loop
lexer
lexbuf
(
result
:
'
a
I
.
result
)
:
'
a
=
let
rec
loop
lexer
lexbuf
(
result
:
'
a
result
)
:
'
a
=
let
open
Lexing
in
match
result
with
|
I
.
InputNeeded
_
->
|
InputNeeded
_
->
(* The parser needs a token. Request one from the lexer,
and offer it to the parser, which will produce a new
result. Then, repeat. *)
let
token
=
lexer
lexbuf
in
let
result
=
I
.
offer
result
(
token
,
lexbuf
.
lex_start_p
,
lexbuf
.
lex_curr_p
)
in
let
result
=
offer
result
(
token
,
lexbuf
.
lex_start_p
,
lexbuf
.
lex_curr_p
)
in
loop
lexer
lexbuf
result
|
I
.
Shifting
_
|
I
.
AboutToReduce
_
->
let
result
=
I
.
resume
result
in
|
Shifting
_
|
AboutToReduce
_
->
let
result
=
resume
result
in
loop
lexer
lexbuf
result
|
I
.
HandlingError
_env
->
(* The parser has suspended itself because of a syntax error. Stop. *)
(* TEMPORARY *)
Printf
.
fprintf
stderr
"At offset %d: syntax error.
\n
%!"
(
lexeme_start
lexbuf
);
exit
1
|
I
.
Accepted
v
->
|
HandlingError
env
->
(* The parser has suspended itself because of a syntax error. Stop.
Find out which state the parser is currently in. *)
let
stack
=
stack
env
in
let
s
:
int
=
match
Lazy
.
force
stack
with
|
Nil
->
(* Hmm... The parser is in its initial state. Its number is
usually 0. This is a BIG HACK. TEMPORARY *)
0
|
Cons
(
Element
(
s
,
_
,
_
,
_
)
,
_
)
->
(* We are missing a conversion [lr1state -> int]. TEMPORARY *)
Obj
.
magic
(
s
:
_
lr1state
)
in
(* Display a nice error message. In principle, the table found in
[FancyParserMessages] should be complete, so we should obtain
a nice message. If [Not_found] is raised, we produce a generic
message, which is better than nothing. Note that the OCaml code
in [FancyParserMessages] is auto-generated based on the table in
[fancy-parser.messages]. *)
let
message
=
try
FancyParserMessages
.
message
s
with
Not_found
->
Printf
.
sprintf
"Unknown syntax error (in state %d).
\n
"
s
in
(* Hack: remove the final newline, because [Error.error] adds one. *)
let
message
=
String
.
sub
message
0
(
String
.
length
message
-
1
)
in
(* Display our message and die. *)
Error
.
error
(
Positions
.
lexbuf
lexbuf
)
message
|
Accepted
v
->
v
|
I
.
Rejected
->
|
Rejected
->
(* The parser rejects this input. This cannot happen because
we stop as soon as the parser reports [HandlingError]. *)
assert
false
(* The entry point. *)
module
F
=
FancyParserMessages
(* TEMPORARY *)
let
grammar
lexer
lexbuf
=
loop
lexer
lexbuf
(
Parser
.
Incremental
.
grammar
()
)
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