Commit b2b6511b authored by POTTIER Francois's avatar POTTIER Francois

Removed the [error_token] hack (based on Obj.magic).

This costs one more field in the [env] record.
The speed difference is actually not measureable.
Maybe it would be measureable in an application where the [env] records
  are stored and move to the major heap. Never mind.
parent b0f2ef19
...@@ -20,11 +20,6 @@ ...@@ -20,11 +20,6 @@
* Update the demos to use ocamlbuild; remove Makefile.shared; * Update the demos to use ocamlbuild; remove Makefile.shared;
remove ocamldep.wrapper? remove OMakefiles remove ocamldep.wrapper? remove OMakefiles
* Chronométrer la version sans error_token magique
* Voir si ça coûte cher de stocker la taille de la pile dans
chaque cellule
* engine.ml: initial call to [run env true] should be [run env false] * engine.ml: initial call to [run env true] should be [run env false]
if the initial state has a default reduction on # if the initial state has a default reduction on #
i.e. if only the empty word is accepted! i.e. if only the empty word is accepted!
......
...@@ -32,23 +32,6 @@ module Make (T : TABLE) = struct ...@@ -32,23 +32,6 @@ module Make (T : TABLE) = struct
(* --------------------------------------------------------------------------- *) (* --------------------------------------------------------------------------- *)
(* OK, OK. I said I would stop using [Obj.magic], yet here we go again. I
need to extend the type [T.token] with an extra element, which represents
the [error] pseudo-token. I don't want to pay an extra box in memory or
an extra field in the [env] record. (I have measured the cost of moving
from 5 to 6 fields in this record to be 30%. This is more than I
expected!) I don't want to add a branch to the type [T.token] because
that would bother the user (that would be an incompatible change) and
that would make some exhaustive case analyses appear non-exhaustive. So,
here we go. We allocate a dummy box in memory and use its address as a
unique value which cannot possibly be confused with a legit inhabitant of
the type [token]. (Right?) *)
let error_token : token =
Obj.magic (ref 0xDEADBEEF)
(* --------------------------------------------------------------------------- *)
(* In the code-based back-end, the [run] function is sometimes responsible (* In the code-based back-end, the [run] function is sometimes responsible
for pushing a new cell on the stack. This is motivated by code sharing for pushing a new cell on the stack. This is motivated by code sharing
concerns. In this interpreter, there is no such concern; [run]'s caller concerns. In this interpreter, there is no such concern; [run]'s caller
...@@ -106,7 +89,7 @@ module Make (T : TABLE) = struct ...@@ -106,7 +89,7 @@ module Make (T : TABLE) = struct
let (token, startp, endp) = triple in let (token, startp, endp) = triple in
Log.lookahead_token (T.token2terminal token) startp endp Log.lookahead_token (T.token2terminal token) startp endp
end; end;
let env = { env with triple } in let env = { env with error = false; triple } in
check_for_default_reduction env check_for_default_reduction env
and check_for_default_reduction env = and check_for_default_reduction env =
...@@ -128,7 +111,7 @@ module Make (T : TABLE) = struct ...@@ -128,7 +111,7 @@ module Make (T : TABLE) = struct
(* Peeking at the first input token, without taking it off the input (* Peeking at the first input token, without taking it off the input
stream, is done by reading [env.triple]. We are careful to first stream, is done by reading [env.triple]. We are careful to first
check whether this is the [error] token. *) check [env.error]. *)
(* Note that, if [please_discard] was true, then we have just called (* Note that, if [please_discard] was true, then we have just called
[discard], so the lookahead token cannot be [error]. *) [discard], so the lookahead token cannot be [error]. *)
...@@ -136,13 +119,13 @@ module Make (T : TABLE) = struct ...@@ -136,13 +119,13 @@ module Make (T : TABLE) = struct
(* Returning [HandlingError env] is equivalent to calling [error env] (* Returning [HandlingError env] is equivalent to calling [error env]
directly, except it allows the user to regain control. *) directly, except it allows the user to regain control. *)
let (token, _, _) = env.triple in if env.error then begin
if token == error_token then begin
if log then if log then
Log.resuming_error_handling(); Log.resuming_error_handling();
HandlingError env HandlingError env
end end
else else
let (token, _, _) = env.triple in
(* We consult the two-dimensional action table, indexed by the (* We consult the two-dimensional action table, indexed by the
current state and the current lookahead token, in order to current state and the current lookahead token, in order to
...@@ -253,15 +236,13 @@ module Make (T : TABLE) = struct ...@@ -253,15 +236,13 @@ module Make (T : TABLE) = struct
and initiate env = and initiate env =
Log.initiating_error_handling(); Log.initiating_error_handling();
let (_, startp, endp) = env.triple in let env = { env with error = true } in
let triple = (error_token, startp, endp) in
let env = { env with triple } in
HandlingError env HandlingError env
(* [error] handles errors. *) (* [error] handles errors. *)
and error env = and error env =
assert (let (token, _, _) = env.triple in token == error_token); assert env.error;
(* Consult the column associated with the [error] pseudo-token in the (* Consult the column associated with the [error] pseudo-token in the
action table. *) action table. *)
...@@ -346,7 +327,8 @@ module Make (T : TABLE) = struct ...@@ -346,7 +327,8 @@ module Make (T : TABLE) = struct
(* Build an initial environment. *) (* Build an initial environment. *)
let env = { let env = {
triple = (error_token, Lexing.dummy_pos, Lexing.dummy_pos); (* dummy *) error = false;
triple = (Obj.magic (), Lexing.dummy_pos, Lexing.dummy_pos); (* dummy *)
stack = empty; stack = empty;
current = s; current = s;
} in } in
......
...@@ -49,10 +49,15 @@ type ('state, 'semantic_value) stack = { ...@@ -49,10 +49,15 @@ type ('state, 'semantic_value) stack = {
type ('state, 'semantic_value, 'token) env = { type ('state, 'semantic_value, 'token) env = {
(* If this flag is true, then the first component of [env.triple] should
be ignored, as it has been logically overwritten with the [error]
pseudo-token. *)
error: bool;
(* The last token that was obtained from the lexer, together with its start (* The last token that was obtained from the lexer, together with its start
and end positions. In principle, this should be a legit token, but the and end positions. Warning: before the first call to the lexer has taken
engine disguises the [error] pseudo-token as an illegal inhabitant of the place, a dummy (and possibly invalid) token is stored here. *)
type [token]. Do not read this field unless you know what are doing! *)
triple: 'token * Lexing.position * Lexing.position; triple: 'token * Lexing.position * Lexing.position;
......
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