diff --git a/lib/Makefile b/lib/Makefile index bf8c2c0..9c7078a 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -9,7 +9,7 @@ data: cd data && python3.6 ../pack_data.py > ../data.ml main.byte: - ocamlfind ocamlc -g -I "mlts_api/_build" -package elpi -package js_of_ocaml -package js_of_ocaml.ppx -package base64 -linkpkg mlts_API.cma data.mli data.ml main.ml -o main.byte + ocamlfind ocamlc -g -I "mlts_api/_build" -package elpi -package js_of_ocaml -package js_of_ocaml.ppx -package base64 -package menhirLib -linkpkg mlts_API.cma data.mli data.ml main.ml -o main.byte js: main.byte js_of_ocaml --opt 3 +weak.js main.byte diff --git a/lib/mlts_api/.merlin b/lib/mlts_api/.merlin index a198d95..3f5dc62 100644 --- a/lib/mlts_api/.merlin +++ b/lib/mlts_api/.merlin @@ -1 +1,3 @@ -B _build \ No newline at end of file +B _build +PKG ocamlbuild +PKG menhirLib \ No newline at end of file diff --git a/lib/mlts_api/Makefile b/lib/mlts_api/Makefile index 7e9fdd8..4dd3ee4 100644 --- a/lib/mlts_api/Makefile +++ b/lib/mlts_api/Makefile @@ -2,4 +2,4 @@ .PHONY: all all: - ocamlbuild mlts_API.cma + ocamlbuild -use-ocamlfind mlts_API.cma diff --git a/lib/mlts_api/_tags b/lib/mlts_api/_tags index b947a59..a498039 100644 --- a/lib/mlts_api/_tags +++ b/lib/mlts_api/_tags @@ -1 +1,2 @@ -true: use_menhir, explain \ No newline at end of file +true: use_menhir, explain, package(menhirLib) +: explain, menhir_table \ No newline at end of file diff --git a/lib/mlts_api/mlts_API.ml b/lib/mlts_api/mlts_API.ml index a3e92af..4aeb232 100644 --- a/lib/mlts_api/mlts_API.ml +++ b/lib/mlts_api/mlts_API.ml @@ -7,11 +7,37 @@ let string_of_pos l c = ("Line " ^ (string_of_int l) ^ ", column "^ (string_of_int c) ^ ": ") +exception Parse_error of string option * Lexing.position * Lexing.position +let parse parse_fun lexbuf = + (* see the Menhir manual for the description of + error messages support *) + let open MenhirLib.General in + let module Interp = MltsParser.MenhirInterpreter in + let input = Interp.lexer_lexbuf_to_supplier MltsLexer.token lexbuf in + let success prog = prog in + let failure error_state = + let env = match[@warning "-4"] error_state with + | Interp.HandlingError env -> env + | _ -> assert false in + match Interp.stack env with + | lazy Nil -> assert false + | lazy (Cons (Interp.Element (state, _, start_pos, end_pos), _)) -> + let message = + match MltsParser_messages.message (Interp.number state) with + | exception Not_found -> None + | empty when String.trim empty = "" -> None + | "\n" -> None + | error_message -> Some error_message + in + raise (Parse_error (message, start_pos, end_pos)) + in + Interp.loop_handle success failure input + (parse_fun lexbuf.Lexing.lex_curr_p) + let parse_and_translate mlts_prog = let tokens = Lexing.from_string mlts_prog in try - let p = MltsParser.main MltsLexer.token tokens in - + let p = parse MltsParser.Incremental.main tokens in let prog, _, _, _ = Translator.toLPString p in prog with Translator.TranslatorError(s, pos) @@ -19,6 +45,14 @@ let parse_and_translate mlts_prog = | MltsLexer.Error(s, pos) -> let l, c = ints_of_pos pos in raise (Error((string_of_pos l c) ^ "Lexing error : " ^ s, l, c)) - | MltsParser.Error -> - let l, c = ints_of_pos (tokens.Lexing.lex_curr_p) in - raise (Error((string_of_pos l c) ^ "Parsing error.", l, c)) + | Parse_error (parser_message, start_pos, end_pos) -> + let l, c = ints_of_pos start_pos in + ignore end_pos; + (* TODO: use both the start and end position of the error + (they may span several characters and several lines) *) + let message = Printf.sprintf "%sParsing error%s" + (string_of_pos l c) + (match parser_message with + | None -> "." + | Some str -> " : " ^ str) in + raise (Error(message, l, c)) diff --git a/lib/mlts_api/myocamlbuild.ml b/lib/mlts_api/myocamlbuild.ml new file mode 100644 index 0000000..dbbed7f --- /dev/null +++ b/lib/mlts_api/myocamlbuild.ml @@ -0,0 +1,95 @@ +open Ocamlbuild_plugin + +module Menhir = struct + let menhir () = + if !Options.ocamlyacc = N then V"MENHIR" else !Options.ocamlyacc + let menhir_tags mly = + tags_of_pathname mly ++"ocaml"++"parser"++"menhir" + + let menhir_produce_messages env build = + let messages, mly = env "%.messages", env "%.mly" in + let open Ocamlbuild_pack in + Ocaml_compiler.prepare_compile build mly; + Cmd(S[menhir (); T (menhir_tags mly); + A "--list-errors"; P mly; Sh ">"; Px messages]) + + let menhir_compile_messages env build = + let mly = env "%.mly" in + let messages = env "%.messages" in + let target = env "%_messages.ml" in + Cmd(S[menhir (); T (menhir_tags mly); P mly; + A "--compile-errors"; P messages; + Sh ">"; Px target]) + + let menhir_update_messages env build = + let mly = env "%.mly" in + let messages = env "%.messages" in + let tmp = Filename.temp_file "menhir" ".messages" in + Seq [ + Cmd(S[menhir (); T (menhir_tags mly); P mly; + A "--update-errors"; P messages; + Sh ">"; P tmp]); + Cmd(S[A "mv"; P tmp; P messages]); + ] + + let dispatcher = function + | After_rules -> + flag ["menhir"; "parser"; "menhir_trace"] (A"--trace"); + flag ["menhir"; "parser"; "menhir_table"] (A "--table"); + flag ["menhir"; "parser"; "menhir_canonical"] (A"--canonical"); + rule "menhir: .mly -> .messages" + ~prod:"%.messages" + ~deps:["%.mly"] + menhir_produce_messages; + rule "menhir: .mly & .messages -> _messages.ml" + ~prod:"%_messages.ml" + ~deps:["%.mly"; "%.messages"] + menhir_compile_messages; + rule "menhir: .mly & .messages -> .messages & .messages.update" + ~stamp:"%.messages.update" + ~deps:["%.mly"; "%.messages"] + menhir_update_messages; + | _ -> () +end + +(* Howto: create and maintain parser error-message files + +# If you have no .messages file in your repository, +# create one from foo.mly with the following commands: + +ocamlbuild -use-ocamlfind foo.messages +cp _build/foo.messages . + +# Once you have a foo.messages file, you can get +# an OCaml module Foo_messages with the following command + +ocamlbuild -use-ocamlfind foo_messages.ml + +# (see _build/foo_messages.ml for what this +# auto-generated source file looks like.) +# You don't actually need to run this command and can use Foo_messages +# as an OCaml module in your code, ocamlbuild will build it on-demand + +# Once you have your foo.messages file, you need to fill the error messages +# in it. foo_messages.ml will get updated automatically. However, if your +# foo.mly file changes, foo.messages will not get updated automatically +# (this requires manual error-message adaptation in general), +# so you should manually request the update with using the +# foo.messages.update stamp target: + +ocamlbuild -use-ocamlfind foo.messages.update +cp _build/foo.messages . + +# then check using your version-control system that the changes +# to the .messages file are as you expect + +*) + + +let _ = + dispatch + (fun hook -> + Menhir.dispatcher hook; + ) + +