Commit dfb0ee4d authored by POTTIER Francois's avatar POTTIER Francois

Changed [reduce] to catch the exception [Accept] immediately.

For convenience, this is done using [match/exception].
As a result, ocaml 4.02 is required.
Updated the Makefile to reflect this requirement.
parent d887a486
2014/12/08:
Menhir now requires OCaml 4.02 (instead of 3.09).
2014/12/02: 2014/12/02:
Removed support for the $previouserror keyword. Removed support for the $previouserror keyword.
Removed support for --error-recovery mode. Removed support for --error-recovery mode.
......
REQUIREMENTS REQUIREMENTS
You need Objective Caml 3.09 or later, ocamlbuild, and GNU make. You need Objective Caml 4.02 or later, ocamlbuild, and GNU make.
HOW TO INSTALL HOW TO INSTALL
......
Package: godi-menhir Package: godi-menhir
Version: VERSION Version: VERSION
Revision: 0 Revision: 0
Depends: godi-ocaml (>= 3.09) Depends: godi-ocaml (>= 4.02)
Build-Depends: Build-Depends:
Sources: http://gallium.inria.fr/~fpottier/menhir/menhir-VERSION.tar.gz Sources: http://gallium.inria.fr/~fpottier/menhir/menhir-VERSION.tar.gz
Homepage: http://gallium.inria.fr/~fpottier/menhir/ Homepage: http://gallium.inria.fr/~fpottier/menhir/
......
...@@ -45,7 +45,7 @@ bootstrap: .versioncheck stage1 stage2 stage3 ...@@ -45,7 +45,7 @@ bootstrap: .versioncheck stage1 stage2 stage3
.versioncheck: .versioncheck:
@ echo Checking that Objective Caml is recent enough... @ echo Checking that Objective Caml is recent enough...
@$(OCAMLBUILD) -build-dir _stage1 checkOCamlVersion.byte @$(OCAMLBUILD) -build-dir _stage1 checkOCamlVersion.byte
@ _stage1/checkOCamlVersion.byte --verbose --gt "3.09" @ _stage1/checkOCamlVersion.byte --verbose --gt "4.02"
@ touch $@ @ touch $@
# ---------------------------------------------------------------------------- # ----------------------------------------------------------------------------
......
...@@ -26,6 +26,7 @@ module Make (T : TABLE) = struct ...@@ -26,6 +26,7 @@ module Make (T : TABLE) = struct
type result = type result =
| InputNeeded of env | InputNeeded of env
| Accepted of semantic_value
| Rejected | Rejected
(* --------------------------------------------------------------------------- *) (* --------------------------------------------------------------------------- *)
...@@ -90,8 +91,9 @@ module Make (T : TABLE) = struct ...@@ -90,8 +91,9 @@ module Make (T : TABLE) = struct
else else
check_for_default_reduction env check_for_default_reduction env
(* [discard env triple] stores [triple] into [env.triple], overwriting (* [discard env triple] stores [triple] into [env], overwriting the previous
the previous token. *) token. It is invoked by [offer], which itself is invoked by the user in
response to an [InputNeeded] result. *)
and discard env triple = and discard env triple =
if log then begin if log then begin
...@@ -203,20 +205,16 @@ module Make (T : TABLE) = struct ...@@ -203,20 +205,16 @@ module Make (T : TABLE) = struct
(* If the semantic action terminates normally, it returns a new stack, (* If the semantic action terminates normally, it returns a new stack,
which becomes the current stack. *) which becomes the current stack. *)
(* If the semantic action raises [Error], we catch it immediately and (* If the semantic action raises [Accept], we catch it and produce an
initiate error handling. *) [Accepted] result. *)
(* The apparently weird idiom used here is an encoding for a (* If the semantic action raises [Error], we catch it and initiate error
[let/unless] construct, which does not exist in ocaml. *) handling. *)
let success = (* This [match/with/exception] construct requires OCaml 4.02. *)
try
Some (T.semantic_action prod env) match T.semantic_action prod env with
with Error -> | stack ->
None
in
match success with
| Some stack ->
(* By our convention, the semantic action has produced an updated (* By our convention, the semantic action has produced an updated
stack. The state now found in the top stack cell is the return stack. The state now found in the top stack cell is the return
...@@ -230,7 +228,10 @@ module Make (T : TABLE) = struct ...@@ -230,7 +228,10 @@ module Make (T : TABLE) = struct
let env = { env with stack; current } in let env = { env with stack; current } in
run env false run env false
| None -> | exception Accept v ->
Accepted v
| exception Error ->
initiate env initiate env
(* --------------------------------------------------------------------------- *) (* --------------------------------------------------------------------------- *)
...@@ -311,6 +312,26 @@ module Make (T : TABLE) = struct ...@@ -311,6 +312,26 @@ module Make (T : TABLE) = struct
(* --------------------------------------------------------------------------- *) (* --------------------------------------------------------------------------- *)
(* [offer result triple] is supposed to be invoked by the user in response
to [result], which must be an [InputNeeded] result. *)
(* [offer] checks that the result is indeed of the form [InputNeeded env],
then passes control to [discard], resuming the suspended computation.
This runtime check prevents the user from passing an environment that
does not make sense here. *)
(* TEMPORARY using a phantom type parameter would be safer / more efficient. *)
let offer result triple =
match result with
| InputNeeded env ->
discard env triple
| _ ->
(* User error. *)
raise (Invalid_argument "[offer] expects [InputNeeded _]")
(* TEMPORARY comment *)
let start let start
(s : state) (s : state)
(read : unit -> token * Lexing.position * Lexing.position) (read : unit -> token * Lexing.position * Lexing.position)
...@@ -339,20 +360,18 @@ module Make (T : TABLE) = struct ...@@ -339,20 +360,18 @@ module Make (T : TABLE) = struct
let rec loop result = let rec loop result =
match result with match result with
| InputNeeded env -> | InputNeeded _ ->
let triple = read() in let triple = read() in
loop (discard env triple) loop (offer result triple)
| Accepted v ->
v
| Rejected -> | Rejected ->
raise Error raise Error
in in
(* Catch [Accept], which represents normal termination. Let [Error] escape. *) (* Let the exception [Error] escape. *)
try loop (run env true)
loop (run env true)
with
| Accept v ->
v
(* --------------------------------------------------------------------------- *) (* --------------------------------------------------------------------------- *)
......
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