Skip to content


Subversion checkout URL

You can clone with
Download ZIP
Fetching contributors…
Cannot retrieve contributors at this time
executable file 154 lines (114 sloc) 6.16 KB
Copyright © 2011 MLstate
This file is part of OPA.
OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.
OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.
You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <>.
(** See file *)
(* ************************************************************************** *)
(** {b Descr}: This file provides some instances of typecheckers built
from low level typecheckers. In particular, it provides the currently
used W-based typechecker.
The effective current typechecker module is referenced via the module
[OfficialTyper], this indirection making easier changing the current
typechecker without having to change its name everywhere in the remaining
of the compiler. *)
(* ************************************************************************** *)
The interfaces cmi of all modules implementing a typer are hidden to be sure
that there is not at all any dependency to a particular typer
(like it is done in dbGen_private and schema_private)
Precisely, that means that Typer_new_subtyping.cmi is not copied in
type env = QmlMakeTyper.public_env
(* module NonRecTyper = QmlMakeTyper.Make ( Typer_un_rec.Main ) *)
(* ************************************************************************** *)
(** {b Descr}: Typechecker based on unification in place, generalization by
binding level, etc. *)
(* ************************************************************************** *)
module WTyper = QmlMakeTyper.Make ( Typer_w.Main )
module NoTyperLowLevel = struct
let type_of_expr ?options:_ ?(annotmap=QmlAnnotMap.empty)
~bypass_typer:_ ~gamma expr =
let f_gen annot annotmap expr =
QmlAnnotMap.add_ty (annot expr) QmlAst.typeNull annotmap in
let fe = f_gen QmlAst.QAnnot.expr in
let fp = f_gen QmlAst.QAnnot.pat in
let annotmap = QmlAstWalk.ExprPatt.fold fe fp annotmap expr in
(gamma, annotmap, QmlAst.typeNull)
module NoTyper = QmlMakeTyper.Make ( NoTyperLowLevel )
(* ************************************************************************** *)
(** {b Descr}: The name of the module representing the typechecker really
called by {b s3Passes} to trigger typechecking. Having this indirection
allows to change the underlying high-level typer without changing
everywhere in the remaining of the code. *)
(* ************************************************************************** *)
module OfficialTyper = (WTyper : QmlMakeTyper.HIGH_LEVEL_TYPER)
(* ************************************************************************** *)
(** {b Descr}: Type describing the available typecheckers. Add here a new
typechecker if you need it. Attention: must be in accordance with the
list of typecheckers names [available_typer_list] below: adding a type
constructor representing a typechecker must be collerated with adding a
name in the list [available_typer_list] below. *)
(* ************************************************************************** *)
type available_typer = [ `off | `w_based ]
(* ************************************************************************** *)
(** {b Descr}: The list of available typecheckers names as a list of strings.
Attention: must be in accordance with the type [available_typer]
above: adding a typechecker name must be collerated with adding a type
constructor in the type [available_typer] above. *)
(* ************************************************************************** *)
let available_typer_list = ["off"; "w_based" ]
(* ************************************************************************** *)
(** {b Descr}: Returns an optional type of typechecker corresponding to the
name received as argument. If no available typechecker exists with this
name, returns [None]. *)
(* ************************************************************************** *)
let available_typer_of_string : string -> available_typer option = function
| "off" -> Some `off
| "w_based" -> Some `w_based
| _ -> None
(* ************************************************************************** *)
(** {b Descr}: Returns the name a a typechecker corresponding to the type of
typechecker received as argument.
Attention: relies on consistence between the type describing available
typecheckers and names of available typecheckers. *)
(* ************************************************************************** *)
let string_of_available_typer : available_typer -> string = function
| `off -> "off"
| `w_based -> "w_based"
(** New : Dynamic Typer *)
module DynamicallyChangeableTyper :
val switch_typer : available_typer -> unit
val get_current_typer : unit -> available_typer
module HighTyper : QmlMakeTyper.HIGH_LEVEL_TYPER
end =
let _current_typer : available_typer ref = ref `w_based
let switch_typer e = _current_typer := e
let get_current_typer () = !_current_typer
module LowLevelDynamicTyper : QmlTypes.QML_LOW_LEVEL_TYPER =
let type_of_expr ?(options=QmlTypes.default_options) ?(annotmap=QmlAnnotMap.empty) ~bypass_typer =
match !_current_typer with
| `off ->
NoTyperLowLevel.type_of_expr ~options ~annotmap ~bypass_typer
| `w_based ->
(* Select the W-based typechecker, i.e. not constraints-based
inference engine. *)
Typer_w.type_of_expr ~options ~annotmap ~bypass_typer
module HighTyper = QmlMakeTyper.Make ( LowLevelDynamicTyper )
module DyTyper = DynamicallyChangeableTyper
Jump to Line
Something went wrong with that request. Please try again.