Commit 30a41885 authored by POTTIER Francois's avatar POTTIER Francois

Arrange to read the positions at the same time as we read the next token.

This requires storing a triple in [env.token], which becomes [env.triple].
The ratio table/code seems to go from 2.0 up to 2.1.
parent 08e40d41
...@@ -85,14 +85,17 @@ module Make (T : TABLE) = struct ...@@ -85,14 +85,17 @@ module Make (T : TABLE) = struct
check_for_default_reduction env check_for_default_reduction env
(* [discard] takes a token off the input stream, queries the lexer (* [discard] takes a token off the input stream, queries the lexer
for a new one, and stores it into [env.token], overwriting the for a new one, and stores it into [env.triple], overwriting the
previous token. *) previous token. *)
and discard env = and discard env =
let lexbuf = env.lexbuf in let lexbuf = env.lexbuf in
let token = env.lexer lexbuf in let token = env.lexer lexbuf in
let env = { env with token } in let startp = lexbuf.Lexing.lex_start_p
Log.lookahead_token lexbuf (T.token2terminal token); and endp = lexbuf.Lexing.lex_curr_p in
let triple = (startp, token, endp) in
Log.lookahead_token startp (T.token2terminal token) endp;
let env = { env with triple } in
check_for_default_reduction env check_for_default_reduction env
and check_for_default_reduction env = and check_for_default_reduction env =
...@@ -113,40 +116,31 @@ module Make (T : TABLE) = struct ...@@ -113,40 +116,31 @@ module Make (T : TABLE) = struct
so as to determine which action should be taken. *) so as to determine which action should be taken. *)
(* 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.token]. 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 whether this is the [error] token. *)
(* 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]. *)
if env.token == error_token then begin let (_, token, _) = env.triple in
if token == error_token then begin
Log.resuming_error_handling(); Log.resuming_error_handling();
error env error env
end end
else else
action env
(* --------------------------------------------------------------------------- *) (* We consult the two-dimensional action table, indexed by the
current state and the current lookahead token, in order to
(* When [action] is invoked, we know that the current state does not have determine which action should be taken. *)
a default reduction. We also know that the current lookahead token is
not [error]: it is a real token, stored in [env.token]. *)
and action env : void =
(* We consult the two-dimensional action table, indexed by the T.action
current state and the current lookahead token, in order to env.current (* determines a row *)
determine which action should be taken. *) (T.token2terminal token) (* determines a column *)
(T.token2value token)
let token = env.token in shift (* shift continuation *)
T.action reduce (* reduce continuation *)
env.current (* determines a row *) initiate (* failure continuation *)
(T.token2terminal token) (* determines a column *) env
(T.token2value token)
shift (* shift continuation *)
reduce (* reduce continuation *)
initiate (* failure continuation *)
env
(* --------------------------------------------------------------------------- *) (* --------------------------------------------------------------------------- *)
...@@ -154,7 +148,7 @@ module Make (T : TABLE) = struct ...@@ -154,7 +148,7 @@ module Make (T : TABLE) = struct
(Goto transitions are taken care of within [reduce] below.) The symbol (Goto transitions are taken care of within [reduce] below.) The symbol
can be either an actual token or the [error] pseudo-token. *) can be either an actual token or the [error] pseudo-token. *)
(* Here, [env.token] CAN be [error_token]. *) (* Here, the lookahead token CAN be [error]. *)
and shift env and shift env
(please_discard : bool) (please_discard : bool)
...@@ -170,12 +164,12 @@ module Make (T : TABLE) = struct ...@@ -170,12 +164,12 @@ module Make (T : TABLE) = struct
(* Push a new cell onto the stack, containing the identity of the (* Push a new cell onto the stack, containing the identity of the
state that we are leaving. *) state that we are leaving. *)
let lexbuf = env.lexbuf in let (startp, _, endp) = env.triple in
let stack = { let stack = {
state = env.current; state = env.current;
semv = value; semv = value;
startp = lexbuf.Lexing.lex_start_p; startp;
endp = lexbuf.Lexing.lex_curr_p; endp;
next = env.stack; next = env.stack;
} in } in
...@@ -189,7 +183,7 @@ module Make (T : TABLE) = struct ...@@ -189,7 +183,7 @@ module Make (T : TABLE) = struct
(* This function takes care of reductions. *) (* This function takes care of reductions. *)
(* Here, [env.token] CAN be [error_token]. *) (* Here, the lookahead token CAN be [error]. *)
and reduce env (prod : production) : void = and reduce env (prod : production) : void =
...@@ -241,17 +235,19 @@ module Make (T : TABLE) = struct ...@@ -241,17 +235,19 @@ module Make (T : TABLE) = struct
(* [initiate] initiates or resumes error handling. *) (* [initiate] initiates or resumes error handling. *)
(* Here, [env.token] CAN be [error_token]. *) (* Here, the lookahead token CAN be [error]. *)
and initiate env : void = and initiate env : void =
Log.initiating_error_handling(); Log.initiating_error_handling();
let env = { env with token = error_token } in let (startp, _, endp) = env.triple in
let triple = (startp, error_token, endp) in
let env = { env with triple } in
error env error env
(* [error] handles errors. *) (* [error] handles errors. *)
and error env : void = and error env : void =
assert (env.token == error_token); assert (let (_, token, _) = env.triple in token == error_token);
(* 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. *)
...@@ -323,27 +319,28 @@ module Make (T : TABLE) = struct ...@@ -323,27 +319,28 @@ module Make (T : TABLE) = struct
let rec empty = { let rec empty = {
state = s; (* dummy *) state = s; (* dummy *)
semv = T.error_value; (* dummy *) semv = T.error_value; (* dummy *)
startp = lexbuf.Lexing.lex_start_p; (* dummy *) startp = Lexing.dummy_pos; (* dummy *)
endp = lexbuf.Lexing.lex_curr_p; (* dummy *) endp = Lexing.dummy_pos; (* dummy *)
next = empty; next = empty;
} in } in
(* Perform an initial call to the lexer. *) (* Perform an initial call to the lexer. *)
let token : token = let token = lexer lexbuf in
lexer lexbuf let startp = lexbuf.Lexing.lex_start_p
in and endp = lexbuf.Lexing.lex_curr_p in
(* Log our first lookahead token. *) (* Log our first lookahead token. *)
Log.lookahead_token lexbuf (T.token2terminal token); Log.lookahead_token startp (T.token2terminal token) endp;
(* Build an initial environment. *) (* Build an initial environment. *)
let triple = (startp, token, endp) in
let env = { let env = {
lexer = lexer; lexer;
lexbuf = lexbuf; lexbuf;
token = token; triple;
stack = empty; stack = empty;
current = s; current = s;
} in } in
......
...@@ -58,12 +58,12 @@ type ('state, 'semantic_value, 'token) env = { ...@@ -58,12 +58,12 @@ type ('state, 'semantic_value, 'token) env = {
lexbuf: Lexing.lexbuf; lexbuf: Lexing.lexbuf;
(* The last token that was obtained from the lexer. In principle, this (* The last token that was obtained from the lexer, together with its start
should be a legit token, but the engine disguises the [error] and end positions. In principle, this should be a legit token, but the
pseudo-token as an illegal inhabitant of this type. Do not read this engine disguises the [error] pseudo-token as an illegal inhabitant of the
field unless you know what are doing! *) type [token]. Do not read this field unless you know what are doing! *)
token: 'token; triple: Lexing.position * 'token * Lexing.position;
(* The stack. In [CodeBackend], it is passed around on its own, (* The stack. In [CodeBackend], it is passed around on its own,
whereas, here, it is accessed via the environment. *) whereas, here, it is accessed via the environment. *)
...@@ -255,7 +255,7 @@ module type TABLE = sig ...@@ -255,7 +255,7 @@ module type TABLE = sig
(* Lookahead token is now <terminal> (<pos>-<pos>) *) (* Lookahead token is now <terminal> (<pos>-<pos>) *)
val lookahead_token: Lexing.lexbuf -> terminal -> unit val lookahead_token: Lexing.position -> terminal -> Lexing.position -> unit
(* Initiating error handling *) (* Initiating error handling *)
......
...@@ -202,12 +202,12 @@ module T = struct ...@@ -202,12 +202,12 @@ module T = struct
fprintf stderr "Reducing production %s" (Production.print prod) fprintf stderr "Reducing production %s" (Production.print prod)
) )
let lookahead_token lexbuf tok = let lookahead_token startp tok endp =
maybe (fun () -> maybe (fun () ->
fprintf stderr "Lookahead token is now %s (%d-%d)" fprintf stderr "Lookahead token is now %s (%d-%d)"
(Terminal.print tok) (Terminal.print tok)
lexbuf.Lexing.lex_start_p.Lexing.pos_cnum startp.Lexing.pos_cnum
lexbuf.Lexing.lex_curr_p.Lexing.pos_cnum endp.Lexing.pos_cnum
) )
let initiating_error_handling () = let initiating_error_handling () =
......
...@@ -127,13 +127,13 @@ module Make (T : TableFormat.TABLES) ...@@ -127,13 +127,13 @@ module Make (T : TableFormat.TABLES)
| None -> | None ->
() ()
let lookahead_token lexbuf token = let lookahead_token startp token endp =
match T.trace with match T.trace with
| Some (terminals, _) -> | Some (terminals, _) ->
fprintf stderr "Lookahead token is now %s (%d-%d)\n%!" fprintf stderr "Lookahead token is now %s (%d-%d)\n%!"
terminals.(token) terminals.(token)
lexbuf.Lexing.lex_start_p.Lexing.pos_cnum startp.Lexing.pos_cnum
lexbuf.Lexing.lex_curr_p.Lexing.pos_cnum endp.Lexing.pos_cnum
| None -> | None ->
() ()
......
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