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
9dd92d06
Commit
9dd92d06
authored
Sep 25, 2015
by
POTTIER Francois
Browse files
More auxiliary functions in [Interpret].
parent
38ef45d2
Changes
1
Hide whitespace changes
Inline
Side-by-side
src/interpret.ml
View file @
9dd92d06
...
...
@@ -340,6 +340,88 @@ let read_messages filename : run list =
(* --------------------------------------------------------------------------- *)
(* [message_table] converts a list of targeted runs to a table (a mapping) of
states to located sentences. Optionally, it can detect that two sentences
lead to the same state, and report an error. *)
let
message_table
(
detect_redundancy
:
bool
)
(
runs
:
targeted_run
list
)
:
located_sentence
Lr1
.
NodeMap
.
t
=
let
table
=
List
.
fold_left
(
fun
table
(
sentences_and_states
,
_message
)
->
List
.
fold_left
(
fun
table
(
sentence2
,
s
)
->
match
Lr1
.
NodeMap
.
find
s
table
with
|
sentence1
->
if
detect_redundancy
then
Error
.
signal
(
fst
sentence1
@
fst
sentence2
)
(
Printf
.
sprintf
"Redundancy: these sentences both cause an error in state %d."
(
Lr1
.
number
s
));
table
|
exception
Not_found
->
Lr1
.
NodeMap
.
add
s
sentence2
table
)
table
sentences_and_states
)
Lr1
.
NodeMap
.
empty
runs
in
if
Error
.
errors
()
then
exit
1
;
table
(* --------------------------------------------------------------------------- *)
(* [compile_runs] converts a list of targeted runs to OCaml code that encodes
a mapping of state numbers to error messages. The code is sent to the
standard output channel. *)
let
compile_runs
filename
(
runs
:
targeted_run
list
)
:
unit
=
(* We wish to produce a function that maps a state number to a message.
By convention, we call this function [message]. *)
let
name
=
"message"
in
let
open
IL
in
let
open
CodeBits
in
let
default
=
{
branchpat
=
PWildcard
;
branchbody
=
eraisenotfound
(* The default branch raises an exception, which can be caught by
the user, who can then produce a generic error message. *)
}
in
let
branches
=
List
.
fold_left
(
fun
branches
(
sentences_and_states
,
message
)
->
(* Create an or-pattern for these states. *)
let
states
=
List
.
map
(
fun
(
_
,
s
)
->
pint
(
Lr1
.
number
s
)
)
sentences_and_states
in
(* Map all these states to this message. *)
{
branchpat
=
POr
states
;
branchbody
=
EStringConst
message
}
::
branches
)
[
default
]
runs
in
let
messagedef
=
{
valpublic
=
true
;
valpat
=
PVar
name
;
valval
=
EFun
([
PVar
"s"
]
,
EMatch
(
EVar
"s"
,
branches
))
}
in
let
program
=
[
SIComment
(
Printf
.
sprintf
"This file was auto-generated based on
\"
%s
\"
."
filename
);
SIComment
(
Printf
.
sprintf
"Please note that the function [%s] can raise [Not_found]."
name
);
SIValDefs
(
false
,
[
messagedef
]);
]
in
(* Write this program to the standard output channel. *)
let
module
P
=
Printer
.
Make
(
struct
let
f
=
stdout
let
locate_stretches
=
None
end
)
in
P
.
program
program
(* --------------------------------------------------------------------------- *)
(* If [--compile-errors <filename>] is set, compile the error message
descriptions found in file [filename] down to OCaml code, then stop. *)
...
...
@@ -355,22 +437,7 @@ let () =
(* Build a mapping of states to located sentences. This allows us to
detect if two sentences lead to the same state. *)
let
(
_
:
located_sentence
Lr1
.
NodeMap
.
t
)
=
List
.
fold_left
(
fun
mapping
(
sentences_and_states
,
_message
)
->
List
.
fold_left
(
fun
mapping
(
sentence2
,
s
)
->
match
Lr1
.
NodeMap
.
find
s
mapping
with
|
sentence1
->
Error
.
signal
(
fst
sentence1
@
fst
sentence2
)
(
Printf
.
sprintf
"Redundancy: these sentences both cause an error in state %d."
(
Lr1
.
number
s
));
mapping
|
exception
Not_found
->
Lr1
.
NodeMap
.
add
s
sentence2
mapping
)
mapping
sentences_and_states
)
Lr1
.
NodeMap
.
empty
runs
in
if
Error
.
errors
()
then
exit
1
;
let
_
=
message_table
true
runs
in
(* In principle, we would like to check whether this set of sentences
is complete (i.e., covers all states where an error can arise), but
...
...
@@ -382,48 +449,7 @@ let () =
(* Now, compile this information down to OCaml code. We wish to
produce a function that maps a state number to a message. By
convention, we call this function [message]. *)
let
name
=
"message"
in
let
open
IL
in
let
open
CodeBits
in
let
default
=
{
branchpat
=
PWildcard
;
branchbody
=
eraisenotfound
(* The default branch raises an exception, which can be caught by
the user, who can then produce a generic error message. *)
}
in
let
branches
=
List
.
fold_left
(
fun
branches
(
sentences_and_states
,
message
)
->
(* Create an or-pattern for these states. *)
let
states
=
List
.
map
(
fun
(
_
,
s
)
->
pint
(
Lr1
.
number
s
)
)
sentences_and_states
in
(* Map all these states to this message. *)
{
branchpat
=
POr
states
;
branchbody
=
EStringConst
message
}
::
branches
)
[
default
]
runs
in
let
messagedef
=
{
valpublic
=
true
;
valpat
=
PVar
name
;
valval
=
EFun
([
PVar
"s"
]
,
EMatch
(
EVar
"s"
,
branches
))
}
in
let
program
=
[
SIComment
(
Printf
.
sprintf
"This file was auto-generated based on
\"
%s
\"
."
filename
);
SIComment
(
Printf
.
sprintf
"Please note that the function [%s] can raise [Not_found]."
name
);
SIValDefs
(
false
,
[
messagedef
])
]
in
(* Write this program to the standard output channel. *)
let
module
P
=
Printer
.
Make
(
struct
let
f
=
stdout
let
locate_stretches
=
None
end
)
in
P
.
program
program
;
compile_runs
filename
runs
;
exit
0
)
...
...
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