Commit 40a92fa1 authored by POTTIER Francois's avatar POTTIER Francois

In the code back-end, modified [discard] to re-allocate

the environment record instead of updating it. This makes
the code back-end TWICE FASTER.
parent c3cb8565
......@@ -38,15 +38,14 @@ open Interface
difference in terms of code size, and makes our life easier, so we
do not attempt to eliminate this redundancy.)
The first thing in [run] is to discard a token, if the state was
entered through a shift transition, and to peek at the lookahead
token. When the current token is to be discarded, the [discard]
function is invoked. It discards the current token, invokes the
lexer to obtain a new token, and returns the latter. When we only
wish to peek at the current token, without discarding it, we simply
read [env.token]. (We have to be careful in cases where the current
lookahead token might be [error], since, in those cases,
[env.token] is meaningless; see below.)
The first thing in [run] is to discard a token, if the state was entered
through a shift transition, and to peek at the lookahead token. When the
current token is to be discarded, the [discard] function is invoked. It
discards the current token, invokes the lexer to obtain a new token, and
returns an updated environment. When we only wish to peek at the current
token, without discarding it, we simply read [env.token]. (We have to be
careful in cases where the current lookahead token might be [error],
since, in those cases, [env.token] is meaningless; see below.)
Once the lookahead token is obtained, [run] performs a case analysis of
the lookahead token. Each branch performs one of the following. In shift
......@@ -525,15 +524,15 @@ let envtypedef = {
(* The last token that was read from the lexer. This is the
head of the token stream, unless [env.error] is set. *)
field true ftoken ttoken;
field false ftoken ttoken;
(* The start position of the above token. *)
field true fstartp tposition;
field false fstartp tposition;
(* The end position of the above token. *)
field true fendp tposition;
field false fendp tposition;
(* A flag which tells whether we currently have an [error] token
at the head of the stream. When this flag is set, the head
......@@ -946,14 +945,20 @@ let gettoken s defred e =
(* There is some other default reduction. Discard the first
input token. *)
blet ([ PWildcard, EApp (EVar discard, [ EVar env ]) ], e)
blet ([
PVar env, EApp (EVar discard, [ EVar env ])
(* Note that we do not read [env.token]. *)
], e)
| (Some (Symbol.T _) | None), None ->
(* There is no default reduction. Discard the first input token
and peek at the next one. *)
blet ([ PVar token, EApp (EVar discard, [ EVar env ]) ], e)
blet ([
PVar env, EApp (EVar discard, [ EVar env ]);
PVar token, ERecordAccess (EVar env, ftoken)
], e)
| Some (Symbol.N _), Some _ ->
......@@ -1008,6 +1013,10 @@ let defaultreductioncomment toks e =
cause error handling to be resumed. The next call to [discard] will take
the [error] token off the input stream and clear [env.error]. *)
(* It seems convenient for [env.error] to be a mutable field, as this allows
us to generate compact code. Re-allocating the whole record would produce
less compact code. And speed is not an issue in this error-handling code. *)
let errorbookkeeping e =
tracecomment
"Initiating error handling"
......@@ -1533,32 +1542,48 @@ let printtokendef =
the case when the lexer calls itself recursively, instead of simply
recognizing an atomic pattern and returning immediately). However,
we are 100% compatible with ocamlyacc here, and there is no better
solution anyway. *)
solution anyway.
As of 2014/12/12, we re-allocate the environment record instead of
updating it. Perhaps surprisingly, this makes the code TWICE FASTER
overall. The write barrier is really costly! *)
let discardbody =
let lexer = "lexer"
and lexbuf = "lexbuf"
and startp = "startp"
and endp = "endp" in
EFun (
[ PVar env ],
blet ([
PVar lexer, ERecordAccess (EVar env, flexer);
PVar lexbuf, ERecordAccess (EVar env, flexbuf);
PVar token, EApp (EVar lexer, [ EVar lexbuf ]);
PVar startp, ERecordAccess (EVar lexbuf, "Lexing.lex_start_p");
PVar endp, ERecordAccess (EVar lexbuf, "Lexing.lex_curr_p")
] @
trace "Lookahead token is now %s (%d-%d)"
[ EApp (EVar print_token, [ EVar token ]);
ERecordAccess (EVar startp, "Lexing.pos_cnum");
ERecordAccess (EVar endp, "Lexing.pos_cnum") ],
ERecord [
flexer, EVar lexer;
flexbuf, EVar lexbuf;
ftoken, EVar token;
fstartp, EVar startp;
fendp, EVar endp;
ferror, efalse
]
)
)
let discarddef = {
valpublic = false;
valpat = PVar discard;
valval =
let lexbuf = "lexbuf" in
EAnnot (
EFun (
[ PVar env ],
blet ([
PVar lexbuf, ERecordAccess (EVar env, flexbuf);
PVar token, EApp (ERecordAccess (EVar env, flexer), [ EVar lexbuf ]);
PUnit, ERecordWrite (EVar env, ftoken, EVar token);
PUnit, ERecordWrite (EVar env, fstartp, ERecordAccess (EVar lexbuf, "Lexing.lex_start_p"));
PUnit, ERecordWrite (EVar env, fendp, ERecordAccess (EVar lexbuf, "Lexing.lex_curr_p")) ] @
trace "Lookahead token is now %s (%d-%d)"
[ EApp (EVar print_token, [ EVar token ]);
ERecordAccess (ERecordAccess (EVar env, fstartp), "Lexing.pos_cnum");
ERecordAccess (ERecordAccess (EVar env, fendp), "Lexing.pos_cnum") ] @ [
PUnit, ERecordWrite (EVar env, ferror, efalse)
],
EVar token
)
),
type2scheme (arrow tenv ttoken)
discardbody,
type2scheme (arrow tenv tenv)
)
}
......
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