Skip to content
This repository
tag: v1488
Fetching contributors…

Cannot retrieve contributors at this time

file 153 lines (114 sloc) 6.338 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
(*
Copyright © 2011, 2012 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 <http://www.gnu.org/licenses/>.
*)

(** See file qmlMakeTyper.ml *)


(* ************************************************************************** *)
(** {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. *)
(* ************************************************************************** *)

(**
TODO :
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
MLSTATELIBS/libqmlcompil
*)

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, QmlTypes.Env.empty), annotmap, QmlAst.typeNull)
end
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 :
sig
  val switch_typer : available_typer -> unit
  val get_current_typer : unit -> available_typer
  module HighTyper : QmlMakeTyper.HIGH_LEVEL_TYPER
end =
struct

  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 =
  struct
    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
  end

  module HighTyper = QmlMakeTyper.Make ( LowLevelDynamicTyper )
end

module DyTyper = DynamicallyChangeableTyper
Something went wrong with that request. Please try again.