Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100755 154 lines (114 sloc) 6.31 kB
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18
19 (** See file qmlMakeTyper.ml *)
20
21
22 (* ************************************************************************** *)
23 (** {b Descr}: This file provides some instances of typecheckers built
24 from low level typecheckers. In particular, it provides the currently
25 used W-based typechecker.
26 The effective current typechecker module is referenced via the module
27 [OfficialTyper], this indirection making easier changing the current
28 typechecker without having to change its name everywhere in the remaining
29 of the compiler. *)
30 (* ************************************************************************** *)
31
32 (**
33 TODO :
34 The interfaces cmi of all modules implementing a typer are hidden to be sure
35 that there is not at all any dependency to a particular typer
36 (like it is done in dbGen_private and schema_private)
37
38 Precisely, that means that Typer_new_subtyping.cmi is not copied in
39 MLSTATELIBS/libqmlcompil
40 *)
41
42 type env = QmlMakeTyper.public_env
43
44 (* module NonRecTyper = QmlMakeTyper.Make ( Typer_un_rec.Main ) *)
45
46
47
48 (* ************************************************************************** *)
49 (** {b Descr}: Typechecker based on unification in place, generalization by
50 binding level, etc. *)
51 (* ************************************************************************** *)
52 module WTyper = QmlMakeTyper.Make ( Typer_w.Main )
53
54
55
56 module NoTyperLowLevel = struct
57 let type_of_expr ?options:_ ?(annotmap=QmlAnnotMap.empty)
58 ~bypass_typer:_ ~gamma expr =
59 let f_gen annot annotmap expr =
60 QmlAnnotMap.add_ty (annot expr) QmlAst.typeNull annotmap in
61 let fe = f_gen QmlAst.QAnnot.expr in
62 let fp = f_gen QmlAst.QAnnot.pat in
63 let annotmap = QmlAstWalk.ExprPatt.fold fe fp annotmap expr in
64 (gamma, annotmap, QmlAst.typeNull)
65 end
66 module NoTyper = QmlMakeTyper.Make ( NoTyperLowLevel )
67
68
69
70 (* ************************************************************************** *)
71 (** {b Descr}: The name of the module representing the typechecker really
72 called by {b s3Passes} to trigger typechecking. Having this indirection
73 allows to change the underlying high-level typer without changing
74 everywhere in the remaining of the code. *)
75 (* ************************************************************************** *)
76 module OfficialTyper = (WTyper : QmlMakeTyper.HIGH_LEVEL_TYPER)
77
78
79
80 (* ************************************************************************** *)
81 (** {b Descr}: Type describing the available typecheckers. Add here a new
82 typechecker if you need it. Attention: must be in accordance with the
83 list of typecheckers names [available_typer_list] below: adding a type
84 constructor representing a typechecker must be collerated with adding a
85 name in the list [available_typer_list] below. *)
86 (* ************************************************************************** *)
87 type available_typer = [ `off | `w_based ]
88
89
90
91 (* ************************************************************************** *)
92 (** {b Descr}: The list of available typecheckers names as a list of strings.
93 Attention: must be in accordance with the type [available_typer]
94 above: adding a typechecker name must be collerated with adding a type
95 constructor in the type [available_typer] above. *)
96 (* ************************************************************************** *)
97 let available_typer_list = ["off"; "w_based" ]
98
99
100
101 (* ************************************************************************** *)
102 (** {b Descr}: Returns an optional type of typechecker corresponding to the
103 name received as argument. If no available typechecker exists with this
104 name, returns [None]. *)
105 (* ************************************************************************** *)
106 let available_typer_of_string : string -> available_typer option = function
107 | "off" -> Some `off
108 | "w_based" -> Some `w_based
109 | _ -> None
110
111
112
113 (* ************************************************************************** *)
114 (** {b Descr}: Returns the name a a typechecker corresponding to the type of
115 typechecker received as argument.
116 Attention: relies on consistence between the type describing available
117 typecheckers and names of available typecheckers. *)
118 (* ************************************************************************** *)
119 let string_of_available_typer : available_typer -> string = function
120 | `off -> "off"
121 | `w_based -> "w_based"
122
123
124
125 (** New : Dynamic Typer *)
126 module DynamicallyChangeableTyper :
127 sig
128 val switch_typer : available_typer -> unit
129 val get_current_typer : unit -> available_typer
130 module HighTyper : QmlMakeTyper.HIGH_LEVEL_TYPER
131 end =
132 struct
133
134 let _current_typer : available_typer ref = ref `w_based
135 let switch_typer e = _current_typer := e
136 let get_current_typer () = !_current_typer
137
138 module LowLevelDynamicTyper : QmlTypes.QML_LOW_LEVEL_TYPER =
139 struct
140 let type_of_expr ?(options=QmlTypes.default_options) ?(annotmap=QmlAnnotMap.empty) ~bypass_typer =
141 match !_current_typer with
142 | `off ->
143 NoTyperLowLevel.type_of_expr ~options ~annotmap ~bypass_typer
144 | `w_based ->
145 (* Select the W-based typechecker, i.e. not constraints-based
146 inference engine. *)
147 Typer_w.type_of_expr ~options ~annotmap ~bypass_typer
148 end
149
150 module HighTyper = QmlMakeTyper.Make ( LowLevelDynamicTyper )
151 end
152
153 module DyTyper = DynamicallyChangeableTyper
Something went wrong with that request. Please try again.