Commit 53e2c164 authored by POTTIER Francois's avatar POTTIER Francois

Big cleanup in myocamlbuild.ml. Generic rules. Completeness check.

  Generic rules for dealing with .messages files.
  Completeness check now built into "make bootstrap".
parent 39a54d0c
......@@ -44,14 +44,14 @@ let rec loop lexer lexbuf (result : 'a result) : 'a =
Obj.magic (s : _ lr1state)
in
(* Display a nice error message. In principle, the table found in
[FancyParserMessages] should be complete, so we should obtain
[ParserMessages] 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]. *)
in [ParserMessages] is auto-generated based on the table in
[ParserMessages.messages]. *)
let message =
try
FancyParserMessages.message s
ParserMessages.message s
with Not_found ->
Printf.sprintf "Unknown syntax error (in state %d).\n" s
in
......
open Ocamlbuild_plugin
open Command
(* The following rules can be copied into other projects. *)
(* ---------------------------------------------------------------------------- *)
(* Compilation flags. *)
(* This rule generates an .ml file [target] from an .mly file [grammar] and a
.messages file [messages]. *)
let flags () =
(* -inline 1000 *)
flag ["ocaml"; "compile"; "native"] (S [A "-inline"; A "1000"]);
(* -noassert *)
flag ["ocaml"; "compile"; "noassert"] (S [A "-noassert"]);
(* nazi warnings *)
flag ["ocaml"; "compile"; "my_warnings"] (S[A "-w"; A "@1..49-4-9-41-44"])
(* If the name of a witness file is passed, it is made an additional
dependency. This triggers a separate rule (see below) which performs a
completeness check, that is, which checks that the .messages file lists
every possible syntax error. *)
let compile_errors grammar messages (witness : string list) target =
rule
"menhir/compile_errors"
~prod:target
~deps:([ grammar; messages ] @ witness)
(fun env _ ->
let grammar = env grammar in
let tags = tags_of_pathname grammar ++ "ocaml" ++ "menhir" in
Cmd(S[
!Options.ocamlyacc; (* menhir *)
T tags;
P grammar;
A "--compile-errors"; P (env messages);
Sh ">"; Px (env target);
]))
(* A generic version of the above rule, with uniform naming. *)
let generic_compile_errors (check_completeness : bool) =
compile_errors
(* sources: *)
"%.mly" "%Messages.messages"
(* if present, this dependency forces a completeness check: *)
(if check_completeness then [ "%Messages.witness" ] else [])
(* target: *)
"%Messages.ml"
(* ---------------------------------------------------------------------------- *)
(* This rule generates a .messages file [messages] from an .mly file
[grammar]. *)
let list_errors grammar messages =
rule
"produce a list of messages"
~prod:messages
~dep:grammar
(fun env _ ->
let grammar = env grammar in
let tags = tags_of_pathname grammar ++ "ocaml" ++ "menhir" in
Cmd(S[
!Options.ocamlyacc; (* menhir *)
T tags;
P grammar;
A "--list-errors";
Sh ">"; Px (env messages);
]))
(* ---------------------------------------------------------------------------- *)
(* This rule compares the .messages files [messages1] and [messages2]. This is
used to ensure complete coverage, i.e., check that every possible error is
covered. The file [witness] is used as a witness that the comparison has
been carried out. *)
let compare_errors grammar messages1 messages2 witness =
rule
"compare two lists of messages"
~stamp:witness
~deps:[ grammar; messages1; messages2 ]
(fun env _ ->
let grammar = env grammar in
let tags = tags_of_pathname grammar ++ "ocaml" ++ "menhir" in
Cmd(S[
!Options.ocamlyacc; (* menhir *)
T tags;
P grammar;
A "--compare-errors"; P (env messages1);
A "--compare-errors"; P (env messages2);
]))
(* ---------------------------------------------------------------------------- *)
(* This rule combines the above two rules and makes sure that the [messages]
file is complete, i.e., covers all possible errors. This rule creates a
witness file. *)
let completeness_check grammar messages witness =
(* We need a name for a temporary [.messages] file, which we produce,
and which lists all possible errors. *)
let complete_messages = grammar ^ ".auto.messages" in
(* Use the above two rules. *)
list_errors grammar complete_messages;
compare_errors grammar complete_messages messages witness
(* A generic version of the above rule, with uniform naming. *)
let generic_completeness_check () =
completeness_check
(* sources: *)
"%.mly" "%Messages.messages"
(* target: *)
"%Messages.witness"
(* ---------------------------------------------------------------------------- *)
(* The following rules and settings are specific to the compilation of Menhir. *)
(* ---------------------------------------------------------------------------- *)
(* Dealing with the two parsers. *)
(* Just for fun, Menhir comes with two parsers for its own input files. One is
......@@ -27,20 +123,6 @@ let fancy () : bool =
mark_tag_used "fancy_parser";
Tags.mem "fancy_parser" (tags_of_pathname "")
let compile_messages grammar messages target =
rule
"compile a custom table of messages"
~prod:target
~deps:[ grammar; messages ]
(fun env _ ->
Cmd(S[
!Options.ocamlyacc; (* menhir *)
(* no additional flags; may allow them in the future *)
P (env grammar);
A "--compile-errors"; P (env messages);
Sh ">"; Px (env target);
]))
let parser_configuration () =
(* Create [parser.mly] by copying the appropriate source file. *)
copy_rule "create parser.mly"
......@@ -56,14 +138,25 @@ let parser_configuration () =
(* target: *)
"Driver.ml"
;
(* In the fancy case, use Menhir to generate [FancyParserMessages.ml] based
on [fancy-parser.messages], which is maintained by hand. *)
if fancy() then
compile_messages
(* sources: *)
"parser.mly" "fancy-parser.messages"
(* target: *)
"FancyParserMessages.ml"
(* In the fancy case, use Menhir to generate [parserMessages.ml] based
on [parserMessages.messages], which is maintained by hand. Also, check
that [parserMessages.messages] covers all possible syntax errors. *)
if fancy() then begin
generic_compile_errors true;
generic_completeness_check()
end
(* ---------------------------------------------------------------------------- *)
(* Compilation flags for Menhir. *)
let flags () =
(* -inline 1000 *)
flag ["ocaml"; "compile"; "native"] (S [A "-inline"; A "1000"]);
(* -noassert *)
flag ["ocaml"; "compile"; "noassert"] (S [A "-noassert"]);
(* nazi warnings *)
flag ["ocaml"; "compile"; "my_warnings"] (S[A "-w"; A "@1..49-4-9-41-44"])
(* ---------------------------------------------------------------------------- *)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment