Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

[cleanup] qml level typer: Cleanup in obscure options never set.

By the way, removed optionnal arguments and put instead required with labels
fot some pretty non-trivial arguments. However, experience shows that creation
of the typer is always done with the same value for these arguments (gamma,
annotmap and qml db scheme). I wonder if we should not internalize these
parameters as fixed values of the typer creation function.
  • Loading branch information...
commit 5e2359f2bef50327cb2abd8c2608caa338381472 1 parent f29b273
@fpessaux fpessaux authored
View
73 libqmlcompil/qmlMakeTyper.ml
@@ -108,24 +108,17 @@ sig
(** All default values are specified on the right (empty or dummy version for bypass_typer) *)
val initial :
- ?gamma:gamma -> (** gamma empty *)
- ?schema:schema -> (** schema empty *)
- ?annotmap:Q.annotmap -> (** IntMap.empty *)
- ?bypass_typer:bypass_typer -> (** fun _ -> None *)
- ?handle_exception:bool -> (** true *)
- ?fatal_mode:bool -> (** true *)
+ gamma: gamma -> schema: schema -> annotmap: Q.annotmap ->
+ bypass_typer: bypass_typer ->
?exception_handler:(env -> exn -> unit) -> (** fun _ e -> raise e *)
- ?unique_types:bool -> (** false *)
?display:bool -> (** false *)
- ?concrete_abstract: bool -> (** false *)
explicit_instantiation : bool ->
- value_restriction : [`disabled|`normal|`strict] ->
(** not an optional argument, because it has to be the same
as the OPA compilation option of the same name, it's called
in many places in OPA, and the default value in OPA changes
(so we risk getting out of sync with OPA and having obscure errors
or inefficiencies, if we have a (different) default value here, too) *)
- ?multiargument_arrow: bool -> (** true *)
+ value_restriction : [`disabled|`normal|`strict] ->
(** The set of toplevel identifiers that are visible outside the package.
It will be used to raise an error if a value has a type containing a
@private type and this value is not marked also by a @private. This
@@ -133,10 +126,6 @@ sig
exported_values_idents: IdentSet.t ->
unit -> env
- (** Fatal mode : if an exception if raised, don't catch it and fail
- other-wise, will ignore all failure definition (keep the previous env in this case only)
- Default value for fatal-mode is true *)
-
val map_expr : env -> Q.expr -> Q.ty
val map_elt : env -> Q.code_elt -> QT.typed_code_elt
val map : env -> Q.code -> QT.typed_code_elt list
@@ -207,19 +196,11 @@ struct
type env = public_env
let initial
- ?(gamma=QT.Env.empty)
- ?(schema=QmlDbGen.Schema.initial)
- ?(annotmap=QmlAnnotMap.empty)
- ?(bypass_typer=(fun _ -> None))
- ?(handle_exception=true)
- ?(fatal_mode=true)
+ ~gamma ~schema ~annotmap ~bypass_typer
?(exception_handler=(fun _ e -> raise e))
- ?(unique_types=false)
?(display=false)
- ?(concrete_abstract=false)
~explicit_instantiation
~value_restriction
- ?(multiargument_arrow=QT.default_options.QT.multiargument_arrow)
~exported_values_idents
()
=
@@ -230,31 +211,20 @@ struct
schema ;
annotmap ;
bypass_typer ;
- fatal_mode ;
- handle_exception ;
exception_handler ;
- unique_types ;
had_error = false ;
display ;
- options =
- {
- concrete_abstract;
- explicit_instantiation;
- value_restriction;
- multiargument_arrow;
- } ;
+ options = {
+ explicit_instantiation;
+ value_restriction;
+ } ;
}
let exception_handler env (code_elt, (e, x)) =
match e with
| QmlTyperException.Exception _ ->
- if env.QT.fatal_mode then
- if env.QT.handle_exception then
- env.QT.exception_handler env (QT.Exception (QT.TyperError (code_elt, (e, x))))
- else
- raise e
- (* silently ignore typing exceptions, if that's what the user wants *)
- else ()
+ env.QT.exception_handler
+ env (QT.Exception (QT.TyperError (code_elt, (e, x))))
| _ ->
(* reraise any non-typer exceptions (assert failures, etc.) *)
raise e
@@ -273,20 +243,15 @@ struct
(fun { Q.ty_def_name = ti; Q.ty_def_params = vars;
Q.ty_def_body = te ; Q.ty_def_visibility = visibility } ->
let add_ti ti visibility = [(ti, (vars, te), visibility)] in
- if env.QT.unique_types && QT.Env.TypeIdent.mem ti gamma then
- let (ti, _) =
- QT.Env.TypeIdent.findi ~visibility_applies: true ti gamma in
- add_ti ti visibility
- else
- match te with
- | _ when TypeIdent.is_already_known ti -> add_ti ti visibility
- | Q.TypeAbstract ->
- add_ti (TypeIdent.new_abstract ~extern: true ti) visibility
- | _ ->
- (* [TODO] Attention, here the body of the definition is
- allowed to use only type constructors that are visible
- from the currently compiled package. *)
- add_ti (TypeIdent.new_concrete ti) visibility)
+ match te with
+ | _ when TypeIdent.is_already_known ti -> add_ti ti visibility
+ | Q.TypeAbstract ->
+ add_ti (TypeIdent.new_abstract ~extern: true ti) visibility
+ | _ ->
+ (* [TODO] Attention, here the body of the definition is
+ allowed to use only type constructors that are visible
+ from the currently compiled package. *)
+ add_ti (TypeIdent.new_concrete ti) visibility)
ty_defs in
let tirec = List.map (fun (ti, (vars, _), _) -> (ti, vars)) l in
let (more_gamma, gamma), l =
View
7 libqmlcompil/qmlTypes.ml
@@ -78,18 +78,14 @@ type gamma = {
type options =
{
- concrete_abstract : bool;
explicit_instantiation : bool;
value_restriction : [`disabled|`normal|`strict];
- multiargument_arrow : bool;
}
let default_options =
{
- concrete_abstract = false; (* safest choice *)
explicit_instantiation = true; (* in case Explicit Instantiation used *)
value_restriction = `disabled; (* in case value restriction used *)
- multiargument_arrow = true; (* in case some code not updated *)
}
module type QML_LOW_LEVEL_TYPER =
@@ -793,9 +789,6 @@ type 'schema public_env =
schema : 'schema ;
annotmap : Q.annotmap ;
bypass_typer : bypass_typer ;
- fatal_mode : bool ; (** true by default *)
- handle_exception : bool ; (** true by default *)
- unique_types : bool ; (** false by default *)
had_error : bool ;
exception_handler : 'schema public_env -> exn -> unit ;
display : bool ; (** false by default *)
View
16 libqmlcompil/qmlTypes.mli
@@ -66,23 +66,11 @@ type bypass_typer = BslKey.t -> QmlAst.ty option
type options =
{
(*** general options about the behaviour of the typer *)
- (** A flag to allow (if set to true) abstract (local) types to
- be considered as concrete; useful for some passes where
- generated code is typed; should not be used for the initial
- typing of user code *)
- concrete_abstract : bool;
-
(** see the OPA option --explicit-instantiation *)
explicit_instantiation : bool;
(** see the OPA option --value-restriction *)
value_restriction : [`disabled|`normal|`strict];
-
- (** the list, which is the first argument of TypeArrow is used
- for types of arguments of lambdas and each series of applications
- is checked to exactly match the arity of TypeArrow of the function
- (that is the length of the list) *)
- multiargument_arrow : bool;
}
(** the safest, most complete (and slowest) set of options *)
@@ -406,10 +394,6 @@ type 'schema public_env =
schema : 'schema ;
annotmap : QmlAst.annotmap ;
bypass_typer : bypass_typer ;
- fatal_mode : bool ; (** true by default *)
- handle_exception : bool ; (** true by default *)
- unique_types : bool ; (** false by default; if true means that type redefinitions
- overwrite old types; dangerous, but useful for OPA *)
had_error : bool ;
exception_handler : 'schema public_env -> exn -> unit ;
display : bool ; (** false by default *)
View
10 opa/s3Passes.ml
@@ -619,18 +619,14 @@ let pass_SaToQml =
BslLib.BSL.ByPassMap.bypass_typer
~typeident:type_renamer env.P.sa_bsl.BslLib.bymap in
QmlTyper.OfficialTyper.initial
- (* ~gamma default is None *)
- (* ~schema default is None *)
- ~bypass_typer
+ ~gamma: QmlTypes.Env.empty ~schema: QmlDbGen.Schema.initial
+ ~annotmap: QmlAnnotMap.empty ~bypass_typer
~exception_handler:
QmlTyperErrHandling.typechecking_exception_handler
~explicit_instantiation: options.O.explicit_instantiation
~value_restriction: options.O.value_restriction
~display: options.O.show_types
- ~multiargument_arrow: true
- ~exported_values_idents: env.P.sa_exported_values_idents
- ()
- in
+ ~exported_values_idents: env.P.sa_exported_values_idents () in
let env_Gen =
{ P.
View
6 opatop/opaTopEnv.ml
@@ -745,8 +745,10 @@ let restart () =
let bypass_typer = OpaTopBsl.bypass_typer bypass_map in
let env_types =
- Typer.initial ~bypass_typer ~explicit_instantiation:true
- ~value_restriction:(P.value_restriction_get ())
+ Typer.initial
+ ~gamma: QmlTypes.Env.empty ~schema: QmlDbGen.Schema.initial
+ ~annotmap: QmlAnnotMap.empty ~bypass_typer ~explicit_instantiation:true
+ ~value_restriction: (P.value_restriction_get ())
~exported_values_idents: IdentSet.empty () in
let env_values = IdentMap.empty in
(* Reset (in fact, init to "empty") the type of exceptions. *)
View
13 qmlcompilers/qmlCompilers.ml
@@ -314,15 +314,14 @@ struct
let transform pass_env =
let env_bsl, qml = pass_env.PassHandler.env in
(** construction of bypass_typer *)
- let bypass_typer = BslLib.BSL.ByPassMap.bypass_typer env_bsl.BslLib.bymap in
+ let bypass_typer =
+ BslLib.BSL.ByPassMap.bypass_typer env_bsl.BslLib.bymap in
let env_typer =
HighTyper.initial
- ~explicit_instantiation:false
- ~bypass_typer
- ~value_restriction:`disabled
- ~exported_values_idents:IdentSet.empty
- ()
- in
+ ~gamma: QmlTypes.Env.empty ~schema: QmlDbGen.Schema.initial
+ ~annotmap: QmlAnnotMap.empty ~bypass_typer
+ ~explicit_instantiation: false ~value_restriction: `disabled
+ ~exported_values_idents: IdentSet.empty () in
let env_typer, code =
let code = Option.default [] qml.init_code @ qml.user_code in
let fct () =
Please sign in to comment.
Something went wrong with that request. Please try again.