Skip to content
This repository
Newer
Older
100644 209 lines (166 sloc) 8.825 kb
fccc6851 » MLstate
2011-06-21 Initial open-source release
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 (** Polymorphic map indexed by annotations.
20
21 Here's the semantics of AnnotMaps:
22
23 Fields that the typer HMX uses / fills (may depend on options given to him):
24 + ty: the type ! due to how the typer works, the annotation may
25 sometimes be slightly more general than what one would expect (or not)
26 *)
27
28 type trace = Annot.t AnnotMap.t
29
30 exception AnnotNotFound of string * Annot.t
31 exception ConflictingAnnotations of Annot.t
32
33 type 'a typed_annot =
34 {
35 a_ty : 'a option ;
36 (* TODO: rename a_tsc to a_tsc_gen and perhaps change it's type
37 to [TypeVar.t list] and rename even more *)
38 a_tsc : ('a, unit) QmlGenericScheme.tsc option ;
39 a_tsc_inst : ('a, unit) QmlGenericScheme.tsc option ;
40 }
41
42 type 'a gen_annotmap = ('a typed_annot) AnnotMap.t
43
44 val map : ('a -> 'b) -> 'a gen_annotmap -> 'b gen_annotmap
45 val map_ty_tsc : ty:('a -> 'b) -> tsc:(('a,unit) QmlGenericScheme.tsc -> ('b,unit) QmlGenericScheme.tsc) -> 'a gen_annotmap -> 'b gen_annotmap
46
47 val empty : 'a gen_annotmap
48 val is_empty : 'a gen_annotmap -> bool
49 val size : 'a gen_annotmap -> int
50
51 (**
52 [no_conflict_if_equal=false] by default.
53 *)
54 val merge : ?no_conflict_if_equal:bool -> 'a gen_annotmap -> 'a gen_annotmap -> 'a gen_annotmap
55 val overwrite : 'a gen_annotmap -> 'a gen_annotmap -> 'a gen_annotmap
56 val unsafe_overwrite : 'a gen_annotmap -> 'a gen_annotmap -> 'a gen_annotmap
57
58 (** {6 Add} *)
59 (** *)
60
61 val add : Annot.t -> 'a typed_annot -> 'a gen_annotmap -> 'a gen_annotmap
62 val add_label : Annot.label -> 'a typed_annot -> 'a gen_annotmap -> 'a gen_annotmap
63 val add_ty : Annot.t -> 'a -> 'a gen_annotmap -> 'a gen_annotmap
64 val add_ty_label : Annot.label -> 'a -> 'a gen_annotmap -> 'a gen_annotmap
65
66 (** {b Descr}: Labels an annotation with a type scheme in case this type scheme
67 is created at the annotation's potition. This corresponds to a point
68 in the source where a type scheme is involved and appears by generalization.
69 In other words, this allows to remind the final type scheme obtained after
70 having generalized a type at the annotation's point.
71 {b Note}: In terms of refactoring, this function should be called
72 "add_tsc_gen", by opposition to the function [add_tsc_inst] below. *)
73 val add_tsc :
74 Annot.t -> ('a, unit) QmlGenericScheme.tsc -> 'a gen_annotmap ->
75 'a gen_annotmap
76 val add_tsc_label : Annot.label -> ('a, unit) QmlGenericScheme.tsc -> 'a gen_annotmap ->
77 'a gen_annotmap
78
79 val add_tsc_opt : Annot.t -> ('a, unit) QmlGenericScheme.tsc option -> 'a gen_annotmap -> 'a gen_annotmap
80 val add_tsc_opt_label : Annot.label -> ('a, unit) QmlGenericScheme.tsc option -> 'a gen_annotmap -> 'a gen_annotmap
81
82 (** {b Descr}: Labels an annotation with a type scheme in case this type scheme
83 is instantiated at the annotation's potition. This corresponds to a point
84 in the source where a type scheme is involved and used by instantiation.
85 In other words, this allows to remind the original type scheme that got
86 instantiated at the annotation's point. *)
87 val add_tsc_inst :
88 Annot.t -> ('a, unit) QmlGenericScheme.tsc -> 'a gen_annotmap ->
89 'a gen_annotmap
90 val add_tsc_inst_opt : Annot.t -> ('a, unit) QmlGenericScheme.tsc option -> 'a gen_annotmap -> 'a gen_annotmap
91
92 val add_tsc_inst_label :
93 Annot.label -> ('a, unit) QmlGenericScheme.tsc -> 'a gen_annotmap ->
94 'a gen_annotmap
95 val add_tsc_inst_opt_label : Annot.label -> ('a, unit) QmlGenericScheme.tsc option -> 'a gen_annotmap -> 'a gen_annotmap
96
97 (** {6 Find} *)
98 (** *)
99
100 val find : Annot.t -> 'a gen_annotmap -> 'a typed_annot
101 val find_ty : Annot.t -> 'a gen_annotmap -> 'a
102 val find_tsc : Annot.t -> 'a gen_annotmap -> ('a, unit) QmlGenericScheme.tsc
103 val find_tsc_inst : Annot.t -> 'a gen_annotmap -> ('a, unit) QmlGenericScheme.tsc
104
105 val find_label : Annot.label -> 'a gen_annotmap -> 'a typed_annot
106 val find_ty_label : Annot.label -> 'a gen_annotmap -> 'a
107 val find_tsc_label : Annot.label -> 'a gen_annotmap -> ('a, unit) QmlGenericScheme.tsc
108 val find_tsc_inst_label : Annot.label -> 'a gen_annotmap -> ('a, unit) QmlGenericScheme.tsc
109
110 val find_opt : Annot.t -> 'a gen_annotmap -> 'a typed_annot option
111 val find_ty_opt : Annot.t -> 'a gen_annotmap -> 'a option
112 val find_tsc_opt : Annot.t -> 'a gen_annotmap -> ('a, unit) QmlGenericScheme.tsc option
113 val find_tsc_inst_opt : Annot.t -> 'a gen_annotmap -> ('a, unit) QmlGenericScheme.tsc option
114
115 val find_opt_label : Annot.label -> 'a gen_annotmap -> 'a typed_annot option
116 val find_ty_opt_label : Annot.label -> 'a gen_annotmap -> 'a option
117 val find_tsc_opt_label : Annot.label -> 'a gen_annotmap -> ('a, unit) QmlGenericScheme.tsc option
118 val find_tsc_inst_opt_label : Annot.label -> 'a gen_annotmap -> ('a, unit) QmlGenericScheme.tsc option
119
120 (** {6 Remove} *)
121 (** *)
122 val remove : Annot.t -> 'a gen_annotmap -> 'a gen_annotmap
123
124 val remove_tsc : Annot.t -> 'a gen_annotmap -> 'a gen_annotmap
125 val remove_tsc_inst : Annot.t -> 'a gen_annotmap -> 'a gen_annotmap
126
127 val remove_tsc_label : Annot.label -> 'a gen_annotmap -> 'a gen_annotmap
128 val remove_tsc_inst_label : Annot.label -> 'a gen_annotmap -> 'a gen_annotmap
129
130
131 (* ************************************************************************** *)
132 (** {b Descr}: Iterates on the map's value, applying the functions passed in
133 arguments on the corresponding fields of each annotation map value.
134 Functions are expected to return [unit], their application order is the
135 order the present function takes them in arguments. In other words,
136 functions are applied in the following order:
137 1: [f_for_key], 2: [f_for_ty], 3: [f_for_tsc],
138 4: [f_for_tsc_inst].
139 REMARK: Because the order in which the functions passed as arguments are
140 called is fixed, this is not very flexible. I doubt this iterator can be
141 very useful apart to implement a debug-print function over maps (like the
142 one available in [QmlPrint.debug_QmlAst_annotmap]).
143 {b Args}:
144 - [f_for_key] : Function to apply on the key of the map's binding.
145 - [f_for_ty] : Function to apply on the optional type of the field [a_ty]
146 of the bound ['a typed_annot] value.
147 - [f_for_tsc] : Function to apply on the optional type scheme of the
148 field [a_tsc] of the bound ['a typed_annot] value.
149 - [f_for_tsc_inst] : Function to apply on the optional type scheme of the
150 field [a_tsc_inst] of the bound ['a typed_annot] value.
151 {b Visibility}: Exported outside this module. *)
152 (* ************************************************************************** *)
153 val iteri:
154 f_for_key: (AnnotMap.key -> unit) ->
155 f_for_ty: ('a option -> unit) ->
156 f_for_tsc: (('a, unit) QmlGenericScheme.tsc option -> unit) ->
157 f_for_tsc_inst: (('a, unit) QmlGenericScheme.tsc option -> unit) ->
158 'a gen_annotmap -> unit
159
160
161
162 (** {6 Imperative maps} *)
163 (** *)
164 module Ref :
165 sig
166 (** Functional annotmap are nice, but many want global refs for
167 convenience. But rather than having a global reference for every
168 one, we can have "local" global references for everyone. But then,
169 we want to share some implementation, this is what this functor does.
170
171 USAGE: each time you want to have your own global reference to an annotmap, do:
172
173 module MyRef : QmlAnnotMap.Ref.REF =
174 struct
175 type ty = QmlAst.ty
176 let _global = ref QmlAnnotMap.empty
177 end
178
179 module MyAnnotRef = QmlAnnotMap.Ref.Make (MyRef)
180
181 and then use import/export/etc.
182 **)
183
184 module type REF = sig type ty val _global : (ty gen_annotmap) ref end
185
186 module type ANNOTMAPREF =
187 sig
188 type ty
189
190 (* general functions *)
191 val clear : unit -> unit
192 val import : ty gen_annotmap -> unit
193 val merge : ty gen_annotmap -> unit
194 val overwrite : ty gen_annotmap -> unit
195 val export : unit -> ty gen_annotmap
196 val get_opt : Annot.t -> (ty typed_annot) option
197 val get : Annot.t -> ty typed_annot
198 val set : Annot.t -> ty typed_annot -> unit
199
200 (* specific functions: please add more if useful *)
201 val set_ty : Annot.t -> ty -> unit
202 val get_ty : Annot.t -> ty
203 val get_ty_opt : Annot.t -> ty option
204 val get_tsc_opt : Annot.t -> (ty, unit) QmlGenericScheme.tsc option
205 end
206
207 module Make (Ref: REF) : (ANNOTMAPREF with type ty = Ref.ty)
208
209 end (* module Ref *)
Something went wrong with that request. Please try again.