-
Notifications
You must be signed in to change notification settings - Fork 125
/
qmlTyperException.ml
122 lines (98 loc) · 4.28 KB
/
qmlTyperException.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
(*
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/>.
*)
(**
This file contains all the possible cases of Exception possibly returned by
any Typer.
If you want to add an exception, do it here, and provide the to_string which
goes together.
Remember that this file is the interface between the typer - guys and the
user.
This module has no mli because it would duplicate the definition of the
type t.
*)
(* TODO: this almost the same as QmlError.location; use QmlError and refactor*)
type location =
[`Expr_loc of QmlAst.expr
|`Pat_loc of QmlAst.pat
|`Ty_loc of QmlAst.ty
|`No_loc]
module LocSet : (BaseSetSig.S with type elt = location)
= BaseSet.Make (
struct
type t = location
let compare l1 l2 =
match l1, l2 with
|`Expr_loc e1, `Expr_loc e2 -> Annot.compare (QmlAst.QAnnot.expr e1) (QmlAst.QAnnot.expr e2)
|`Pat_loc e1, `Pat_loc e2 -> Annot.compare (QmlAst.QAnnot.pat e1) (QmlAst.QAnnot.pat e2)
|`Ty_loc e1, `Ty_loc e2 -> Pervasives.compare e1(*.annot*) e2(*.annot*)
|_ -> Pervasives.compare l1 l2
end)
type loc_set = LocSet.t
let loc_set_empty = LocSet.empty
let loc_set_add = LocSet.add
let loc_set_union = LocSet.union
type error_loc =
(* the main location, of the subexpression being typed when error occurred *)
location *
(* any extra related locations, e.g., an application in another let rec
branch, which makes the currently typed application incorrect *)
loc_set
let loc_empty = (`No_loc, LocSet.empty)
let loc_make main set =
let set = LocSet.remove main set in
(main, set)
let loc_add_main main (old_main, set) =
(* [`No_loc] can enter the set, but there'll always be at most one copy *)
let set = LocSet.add old_main set in
loc_make main set
let loc_add_set set (main, old_set) =
let set = LocSet.union old_set set in
loc_make main set
type 'ty t =
| InvalidType of
'ty * [`duplicate_field | `duplicate_field_with_diff_ty_in_sum_cases |
`not_a_record | `record_not_closed | `abstract_in_ty_annotation |
`other]
(* Invalid type
detected while typing:
- coerce failure
- record with several fields with the same name
- several sum cases with a same field having different types
- coerce to "external", i.e. into the constructor [QmlAst.TypeAbstract]
- ... ? *)
| InvalidTypeDefinition of 'ty * 'ty (* Corresponds to the restrictions which
are specific to type definitions e.g. type 'a t = ... 'b t ...,
if a <> b gives InvalidTypeDefinition (['a], t, ... 'b t ...) *)
| InvalidTypeUsage of QmlAst.typeident * QmlAst.typevar list * 'ty list (* The
use of a typename does not agree with its definition (e.g. number of type
parameters). *)
| IdentifierNotFound of Ident.t * Ident.t list
(* [IdentifierNotFound (missing, list_of_identifiers_at_this_point)].
[list_of_identifiers_at_this_point] may be empty if we are in a context
where the list of identifiers is unclear*)
| TypeIdentNotFound of QmlAst.typeident
| DuplicateTypeDefinitions of string (* An exception for QmlBlender and OPA,
not thrown in the normal QML world. *)
type exn_t = error_loc * (QmlAst.ty t)
exception Exception of exn_t
(* val map : ('a -> 'b) -> 'a QmlTyperException.t -> 'b QmlTyperException.t *)
let map f_ty = function
| InvalidType (t,k) -> InvalidType (f_ty t, k)
| InvalidTypeDefinition (ty1, ty2) ->
InvalidTypeDefinition (f_ty ty1, f_ty ty2)
| InvalidTypeUsage (tid, tvl, tyl) ->
InvalidTypeUsage (tid, tvl, List.map f_ty tyl)
| IdentifierNotFound _ as x -> x
| TypeIdentNotFound x -> TypeIdentNotFound x
| DuplicateTypeDefinitions s -> DuplicateTypeDefinitions s