/
qmlTyper.ml
executable file
·153 lines (114 loc) · 6.16 KB
/
qmlTyper.ml
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 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, 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