Commit a4611cf8 authored by POTTIER Francois's avatar POTTIER Francois

Always generate a definition of the [token] type, either as ADT or as alias.

This fixes the bug where --table and --external-tokens did not work together.
parent 6ce61536
2015/10/05:
Fixed a bug where inconsistent OCaml code was generated when --table
and --external-tokens were used together. (Reported by Darin Morrison.)
2015/10/05: 2015/10/05:
In --infer mode, leave the .ml file around (instead of removing it) if In --infer mode, leave the .ml file around (instead of removing it) if
ocamlc fails, so we have a chance to understand what's wrong. ocamlc fails, so we have a chance to understand what's wrong.
......
...@@ -13,41 +13,63 @@ open CodeBits ...@@ -13,41 +13,63 @@ open CodeBits
let tctoken = let tctoken =
"token" "token"
let ttoken =
TypApp (tctoken, [])
(* This is the conventional name of the token GADT, which describes (* This is the conventional name of the token GADT, which describes
the tokens. Same setup as above. *) the tokens. Same setup as above. *)
let tctokengadt = let tctokengadt =
"terminal" "terminal"
let ttokengadt a =
TypApp (tctokengadt, [ a ])
(* This is the conventional name of the data constructors of (* This is the conventional name of the data constructors of
the token GADT. *) the token GADT. *)
let ttokengadtdata token = let ttokengadtdata token =
"T_" ^ token "T_" ^ token
(* This is the definition of the type of tokens. (Regardless of (* This is the definition of the type of tokens. It is defined as an algebraic
[Settings.token_type_mode], which is examined below.) *) data type, unless [--external-tokens M] is set, in which case it is defined
as an abbreviation for the type [M.token]. *)
let tokentypedef grammar = let tokentypedef grammar =
let datadefs = let typerhs =
List.map (fun (token, typo) -> { match Settings.token_type_mode with
dataname = token; | Settings.TokenTypeOnly
datavalparams = (match typo with None -> [] | Some t -> [ TypTextual t ]); | Settings.TokenTypeAndCode ->
datatypeparams = None
}) (typed_tokens grammar) (* Algebraic data type. *)
TDefSum (
List.map (fun (tok, typo) -> {
dataname = tok;
datavalparams = (match typo with None -> [] | Some t -> [ TypTextual t ]);
datatypeparams = None
}) (typed_tokens grammar)
)
| Settings.CodeOnly m ->
(* Type abbreviation. *)
TAbbrev (TypApp (m ^ "." ^ tctoken, []))
in in
[ [
IIComment "The type of tokens."; IIComment "The type of tokens.";
IITypeDecls [{ IITypeDecls [{
typename = tctoken; typename = tctoken;
typeparams = []; typeparams = [];
typerhs = TDefSum datadefs; typerhs;
typeconstraint = None typeconstraint = None
}] }]
] ]
(* This is the definition of the token GADT. Here, the data (* This is the definition of the token GADT. Here, the data constructors have
constructors have no value argument, but have a type index. *) no value argument, but have a type index. *)
(* The token GADT is produced only when [Settings.inspection] is true. Thus, (* The token GADT is produced only when [Settings.inspection] is true. Thus,
when [Settings.inspection] is false, we remain compatible with old versions when [Settings.inspection] is false, we remain compatible with old versions
...@@ -58,34 +80,56 @@ let tokentypedef grammar = ...@@ -58,34 +80,56 @@ let tokentypedef grammar =
[error] token (because this GADT must describe all of the tokens that are [error] token (because this GADT must describe all of the tokens that are
allowed to appear in a production). *) allowed to appear in a production). *)
(* It is defined as a generalized algebraic data type, unless
[--external-tokens M] is set, in which case it is defined as an
abbreviation for the type ['a M.tokengadt]. *)
let tokengadtdef grammar = let tokengadtdef grammar =
assert Settings.inspection; assert Settings.inspection;
let errordata = { let param, typerhs =
dataname = ttokengadtdata "error"; match Settings.token_type_mode with
datavalparams = []; | Settings.TokenTypeOnly
datatypeparams = Some [ tunit ] | Settings.TokenTypeAndCode ->
(* the [error] token has a semantic value of type [unit] *)
} in (* Generalized algebraic data type. *)
let datadefs =
(* The ordering of this list matters. We want the data constructors let param = "_" in
to respect the internal ordering (as determined by [typed_tokens] param,
in [UnparameterizedSyntax]) of the terminal symbols. This may be TDefSum (
exploited in the table back-end to allow an unsafe conversion (* The ordering of this list matters. We want the data constructors
of a data constructor to an integer code. See [t2i] in to respect the internal ordering (as determined by [typed_tokens]
[InspectionTableInterpreter]. *) in [UnparameterizedSyntax]) of the terminal symbols. This may be
errordata :: exploited in the table back-end to allow an unsafe conversion
List.map (fun (token, typo) -> { of a data constructor to an integer code. See [t2i] in
dataname = ttokengadtdata token; [InspectionTableInterpreter]. *)
datavalparams = []; {
datatypeparams = Some [ match typo with None -> tunit | Some t -> TypTextual t ] dataname = ttokengadtdata "error";
}) (typed_tokens grammar) datavalparams = [];
datatypeparams = Some [ tunit ]
(* the [error] token has a semantic value of type [unit] *)
} ::
List.map (fun (token, typo) -> {
dataname = ttokengadtdata token;
datavalparams = [];
datatypeparams = Some [ match typo with None -> tunit | Some t -> TypTextual t ]
}) (typed_tokens grammar)
)
| Settings.CodeOnly m ->
(* Type abbreviation. *)
let param = "a" in
param,
TAbbrev (TypApp (m ^ "." ^ tctokengadt, [ TypVar param ]))
in in
[ [
IIComment "The indexed type of terminal symbols."; IIComment "The indexed type of terminal symbols.";
IITypeDecls [{ IITypeDecls [{
typename = tctokengadt; typename = tctokengadt;
typeparams = [ "_" ]; typeparams = [ param ];
typerhs = TDefSum datadefs; typerhs;
typeconstraint = None typeconstraint = None
}] }]
] ]
...@@ -134,29 +178,10 @@ let produce_tokentypes grammar = ...@@ -134,29 +178,10 @@ let produce_tokentypes grammar =
| Settings.TokenTypeAndCode -> | Settings.TokenTypeAndCode ->
() ()
(* Define [tokentypedef] and [tokengadtdef], [tokenprefix]. *) (* The token type and the token GADTs can be referred to via a short
(unqualified) name, regardless of how they have been defined (either
let tokentypedef grammar = directly or as an abbreviation). However, their data constructors must
match Settings.token_type_mode with be qualified if [--external-tokens] is set. *)
| Settings.CodeOnly _ ->
[]
| Settings.TokenTypeAndCode ->
tokentypedef grammar
| Settings.TokenTypeOnly ->
(* This should not happen, as [produce_tokentype] should
have been called first. *)
assert false
let tokengadtdef grammar =
match Settings.token_type_mode with
| Settings.CodeOnly _ ->
[]
| Settings.TokenTypeAndCode ->
tokengadtdef grammar
| Settings.TokenTypeOnly ->
(* This should not happen, as [produce_tokentype] should
have been called first. *)
assert false
let tokenprefix id = let tokenprefix id =
match Settings.token_type_mode with match Settings.token_type_mode with
...@@ -167,24 +192,9 @@ let tokenprefix id = ...@@ -167,24 +192,9 @@ let tokenprefix id =
| Settings.TokenTypeOnly -> | Settings.TokenTypeOnly ->
id (* irrelevant, really *) id (* irrelevant, really *)
(* Redefine the name of the [token] type to take a possible
prefix into account. *)
let tctoken =
tokenprefix tctoken
let ttoken =
TypApp (tctoken, [])
let tokendata = let tokendata =
tokenprefix tokenprefix
let tctokengadt =
tokenprefix tctokengadt
let ttokengadt a =
TypApp (tctokengadt, [ a ])
let tokengadtdata token = let tokengadtdata token =
tokenprefix (ttokengadtdata token) tokenprefix (ttokengadtdata token)
...@@ -11,12 +11,12 @@ ...@@ -11,12 +11,12 @@
(* In this module, we also deal with [--only-tokens] and [--external-tokens]. (* In this module, we also deal with [--only-tokens] and [--external-tokens].
If [--only-tokens] is specified on the command line, [produce_tokentypes] If [--only-tokens] is specified on the command line, [produce_tokentypes]
emits the type definition(s) and exit. If [--external-tokens] is specified, emits the type definition(s) and exit. If [--external-tokens M] is set,
then the list [tokentypedefs] is empty, and [tokenprefix] produces a then the token type and the token GADT are defined as abbreviations for
nontrivial prefix. *) [M.token] and ['a M.terminal]. *)
(* The conventional name of the [token] type, for use by the code (* The conventional name of the [token] type, for use by the code
generators. If [--external-tokens] is set, this type is qualified. *) generators. *)
val ttoken: IL.typ val ttoken: IL.typ
...@@ -28,8 +28,7 @@ val tokendata: string -> string ...@@ -28,8 +28,7 @@ val tokendata: string -> string
(* The conventional name of the [terminal] type, a.k.a. the token GADT. This (* The conventional name of the [terminal] type, a.k.a. the token GADT. This
is an indexed type (i.e., it has one type parameter). Its data constructors is an indexed type (i.e., it has one type parameter). Its data constructors
carry zero value arguments. If [--external-tokens] is set, this type is carry zero value arguments. *)
qualified. *)
val tctokengadt: string val tctokengadt: string
val ttokengadt: IL.typ -> IL.typ val ttokengadt: IL.typ -> IL.typ
...@@ -40,10 +39,7 @@ val ttokengadt: IL.typ -> IL.typ ...@@ -40,10 +39,7 @@ val ttokengadt: IL.typ -> IL.typ
val tokengadtdata: string -> string val tokengadtdata: string -> string
(* The definitions of the token type and of the token GADT, for use by the (* The definitions of the token type and of the token GADT, for use by the
code generators. Each of these lists may define zero or one type. Indeed, code generators. Each of these lists defines zero or one type. *)
both lists are empty when [--external-tokens] is set. Otherwise, only the
type [token] is defined always, and the type [terminal] is defined only in
[--inspection] mode. *)
val tokentypedef: UnparameterizedSyntax.grammar -> IL.interface val tokentypedef: UnparameterizedSyntax.grammar -> IL.interface
val tokengadtdef: UnparameterizedSyntax.grammar -> IL.interface val tokengadtdef: UnparameterizedSyntax.grammar -> IL.interface
......
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