adam@1303
|
1 (* Copyright (c) 2008-2010, Adam Chlipala
|
adamc@329
|
2 * All rights reserved.
|
adamc@329
|
3 *
|
adamc@329
|
4 * Redistribution and use in source and binary forms, with or without
|
adamc@329
|
5 * modification, are permitted provided that the following conditions are met:
|
adamc@329
|
6 *
|
adamc@329
|
7 * - Redistributions of source code must retain the above copyright notice,
|
adamc@329
|
8 * this list of conditions and the following disclaimer.
|
adamc@329
|
9 * - Redistributions in binary form must reproduce the above copyright notice,
|
adamc@329
|
10 * this list of conditions and the following disclaimer in the documentation
|
adamc@329
|
11 * and/or other materials provided with the distribution.
|
adamc@329
|
12 * - The names of contributors may not be used to endorse or promote products
|
adamc@329
|
13 * derived from this software without specific prior written permission.
|
adamc@329
|
14 *
|
adamc@329
|
15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
adamc@329
|
16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
adamc@329
|
17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
adamc@329
|
18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
|
adamc@329
|
19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
adamc@329
|
20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
adamc@329
|
21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
adamc@329
|
22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
adamc@329
|
23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
adamc@329
|
24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
adamc@329
|
25 * POSSIBILITY OF SUCH DAMAGE.
|
adamc@329
|
26 *)
|
adamc@329
|
27
|
adamc@329
|
28 structure ElabErr :> ELAB_ERR = struct
|
adamc@329
|
29
|
adamc@329
|
30 structure L = Source
|
adamc@329
|
31 open Elab
|
adamc@329
|
32
|
adamc@329
|
33 structure E = ElabEnv
|
adamc@329
|
34 structure U = ElabUtil
|
adamc@329
|
35
|
adamc@329
|
36 open Print
|
adamc@329
|
37 structure P = ElabPrint
|
adamc@329
|
38
|
adamc@623
|
39 val simplCon = U.Con.mapB {kind = fn _ => fn k => k,
|
adamc@329
|
40 con = fn env => fn c =>
|
adamc@329
|
41 let
|
adamc@329
|
42 val c = (c, ErrorMsg.dummySpan)
|
adamc@628
|
43 val c' = ElabOps.hnormCon env c
|
adamc@329
|
44 in
|
adamc@329
|
45 (*prefaces "simpl" [("c", P.p_con env c),
|
adamc@329
|
46 ("c'", P.p_con env c')];*)
|
adamc@329
|
47 #1 c'
|
adamc@329
|
48 end,
|
adamc@623
|
49 bind = fn (env, U.Con.RelC (x, k)) => E.pushCRel env x k
|
adamc@792
|
50 | (env, U.Con.NamedC (x, n, k, co)) => E.pushCNamedAs env x n k co
|
adamc@623
|
51 | (env, _) => env}
|
adamc@329
|
52
|
adamc@329
|
53 val p_kind = P.p_kind
|
adamc@623
|
54
|
adamc@623
|
55 datatype kind_error =
|
adamc@623
|
56 UnboundKind of ErrorMsg.span * string
|
adamc@623
|
57
|
adamc@623
|
58 fun kindError env err =
|
adamc@623
|
59 case err of
|
adamc@623
|
60 UnboundKind (loc, s) =>
|
adamc@623
|
61 ErrorMsg.errorAt loc ("Unbound kind variable " ^ s)
|
adamc@329
|
62
|
adamc@329
|
63 datatype kunify_error =
|
adamc@329
|
64 KOccursCheckFailed of kind * kind
|
adamc@329
|
65 | KIncompatible of kind * kind
|
adamc@329
|
66
|
adamc@623
|
67 fun kunifyError env err =
|
adamc@329
|
68 case err of
|
adamc@329
|
69 KOccursCheckFailed (k1, k2) =>
|
adamc@329
|
70 eprefaces "Kind occurs check failed"
|
adamc@623
|
71 [("Kind 1", p_kind env k1),
|
adamc@623
|
72 ("Kind 2", p_kind env k2)]
|
adamc@329
|
73 | KIncompatible (k1, k2) =>
|
adamc@329
|
74 eprefaces "Incompatible kinds"
|
adamc@623
|
75 [("Kind 1", p_kind env k1),
|
adamc@623
|
76 ("Kind 2", p_kind env k2)]
|
adamc@329
|
77
|
adamc@329
|
78
|
adamc@329
|
79 fun p_con env c = P.p_con env (simplCon env c)
|
adamc@329
|
80
|
adamc@329
|
81 datatype con_error =
|
adamc@329
|
82 UnboundCon of ErrorMsg.span * string
|
adamc@329
|
83 | UnboundDatatype of ErrorMsg.span * string
|
adamc@329
|
84 | UnboundStrInCon of ErrorMsg.span * string
|
adamc@329
|
85 | WrongKind of con * kind * kind * kunify_error
|
adamc@329
|
86 | DuplicateField of ErrorMsg.span * string
|
adamc@329
|
87 | ProjBounds of con * int
|
adamc@329
|
88 | ProjMismatch of con * kind
|
adamc@329
|
89
|
adamc@329
|
90 fun conError env err =
|
adamc@329
|
91 case err of
|
adamc@329
|
92 UnboundCon (loc, s) =>
|
adamc@329
|
93 ErrorMsg.errorAt loc ("Unbound constructor variable " ^ s)
|
adamc@329
|
94 | UnboundDatatype (loc, s) =>
|
adamc@329
|
95 ErrorMsg.errorAt loc ("Unbound datatype " ^ s)
|
adamc@329
|
96 | UnboundStrInCon (loc, s) =>
|
adamc@329
|
97 ErrorMsg.errorAt loc ("Unbound structure " ^ s)
|
adamc@329
|
98 | WrongKind (c, k1, k2, kerr) =>
|
adamc@329
|
99 (ErrorMsg.errorAt (#2 c) "Wrong kind";
|
adamc@329
|
100 eprefaces' [("Constructor", p_con env c),
|
adamc@623
|
101 ("Have kind", p_kind env k1),
|
adamc@623
|
102 ("Need kind", p_kind env k2)];
|
adamc@623
|
103 kunifyError env kerr)
|
adamc@329
|
104 | DuplicateField (loc, s) =>
|
adamc@329
|
105 ErrorMsg.errorAt loc ("Duplicate record field " ^ s)
|
adamc@329
|
106 | ProjBounds (c, n) =>
|
adamc@329
|
107 (ErrorMsg.errorAt (#2 c) "Out of bounds constructor projection";
|
adamc@329
|
108 eprefaces' [("Constructor", p_con env c),
|
adamc@329
|
109 ("Index", Print.PD.string (Int.toString n))])
|
adamc@329
|
110 | ProjMismatch (c, k) =>
|
adamc@329
|
111 (ErrorMsg.errorAt (#2 c) "Projection from non-tuple constructor";
|
adamc@329
|
112 eprefaces' [("Constructor", p_con env c),
|
adamc@623
|
113 ("Kind", p_kind env k)])
|
adamc@329
|
114
|
adamc@329
|
115 datatype cunify_error =
|
adamc@329
|
116 CKind of kind * kind * kunify_error
|
adamc@329
|
117 | COccursCheckFailed of con * con
|
adamc@329
|
118 | CIncompatible of con * con
|
adamc@329
|
119 | CExplicitness of con * con
|
adamc@413
|
120 | CKindof of kind * con * string
|
adam@1359
|
121 | CRecordFailure of con * con * (con * con * con * cunify_error option) option
|
adam@1303
|
122 | TooLifty of ErrorMsg.span * ErrorMsg.span
|
adam@1303
|
123 | TooUnify of con * con
|
adam@1306
|
124 | TooDeep
|
adamc@329
|
125
|
adamc@329
|
126 fun cunifyError env err =
|
adamc@329
|
127 case err of
|
adamc@329
|
128 CKind (k1, k2, kerr) =>
|
adamc@329
|
129 (eprefaces "Kind unification failure"
|
adamc@623
|
130 [("Kind 1", p_kind env k1),
|
adamc@623
|
131 ("Kind 2", p_kind env k2)];
|
adamc@623
|
132 kunifyError env kerr)
|
adamc@329
|
133 | COccursCheckFailed (c1, c2) =>
|
adamc@329
|
134 eprefaces "Constructor occurs check failed"
|
adamc@329
|
135 [("Con 1", p_con env c1),
|
adamc@329
|
136 ("Con 2", p_con env c2)]
|
adamc@329
|
137 | CIncompatible (c1, c2) =>
|
adamc@329
|
138 eprefaces "Incompatible constructors"
|
adamc@329
|
139 [("Con 1", p_con env c1),
|
adamc@329
|
140 ("Con 2", p_con env c2)]
|
adamc@329
|
141 | CExplicitness (c1, c2) =>
|
adamc@329
|
142 eprefaces "Differing constructor function explicitness"
|
adamc@329
|
143 [("Con 1", p_con env c1),
|
adamc@329
|
144 ("Con 2", p_con env c2)]
|
adamc@413
|
145 | CKindof (k, c, expected) =>
|
adamc@413
|
146 eprefaces ("Unexpected kind for kindof calculation (expecting " ^ expected ^ ")")
|
adamc@623
|
147 [("Kind", p_kind env k),
|
adamc@329
|
148 ("Con", p_con env c)]
|
adamc@1071
|
149 | CRecordFailure (c1, c2, fo) =>
|
adam@1359
|
150 (eprefaces "Can't unify record constructors"
|
adam@1359
|
151 (("Summary 1", p_con env c1)
|
adam@1359
|
152 :: ("Summary 2", p_con env c2)
|
adam@1359
|
153 :: (case fo of
|
adam@1359
|
154 NONE => []
|
adam@1359
|
155 | SOME (nm, t1, t2, _) =>
|
adam@1359
|
156 [("Field", p_con env nm),
|
adam@1359
|
157 ("Value 1", p_con env t1),
|
adam@1359
|
158 ("Value 2", p_con env t2)]));
|
adam@1359
|
159 case fo of
|
adam@1359
|
160 SOME (_, _, _, SOME err') => cunifyError env err'
|
adam@1359
|
161 | _ => ())
|
adam@1303
|
162 | TooLifty (loc1, loc2) =>
|
adam@1303
|
163 (ErrorMsg.errorAt loc1 "Can't unify two unification variables that both have suspended liftings";
|
adam@1303
|
164 eprefaces' [("Other location", Print.PD.string (ErrorMsg.spanToString loc2))])
|
adam@1303
|
165 | TooUnify (c1, c2) =>
|
adam@1303
|
166 (ErrorMsg.errorAt (#2 c1) "Substitution in constructor is blocked by a too-deep unification variable";
|
adam@1303
|
167 eprefaces' [("Replacement", p_con env c1),
|
adam@1303
|
168 ("Body", p_con env c2)])
|
adam@1306
|
169 | TooDeep => ErrorMsg.error "Can't reverse-engineer unification variable lifting"
|
adamc@329
|
170
|
adamc@329
|
171 datatype exp_error =
|
adamc@329
|
172 UnboundExp of ErrorMsg.span * string
|
adamc@329
|
173 | UnboundStrInExp of ErrorMsg.span * string
|
adamc@329
|
174 | Unify of exp * con * con * cunify_error
|
adamc@339
|
175 | Unif of string * ErrorMsg.span * con
|
adamc@329
|
176 | WrongForm of string * exp * con
|
adamc@329
|
177 | IncompatibleCons of con * con
|
adamc@329
|
178 | DuplicatePatternVariable of ErrorMsg.span * string
|
adamc@329
|
179 | PatUnify of pat * con * con * cunify_error
|
adamc@329
|
180 | UnboundConstructor of ErrorMsg.span * string list * string
|
adamc@329
|
181 | PatHasArg of ErrorMsg.span
|
adamc@329
|
182 | PatHasNoArg of ErrorMsg.span
|
adamc@819
|
183 | Inexhaustive of ErrorMsg.span * pat
|
adamc@329
|
184 | DuplicatePatField of ErrorMsg.span * string
|
adamc@329
|
185 | Unresolvable of ErrorMsg.span * con
|
adamc@329
|
186 | OutOfContext of ErrorMsg.span * (exp * con) option
|
adamc@329
|
187 | IllegalRec of string * exp
|
adamc@329
|
188
|
adamc@329
|
189 val p_exp = P.p_exp
|
adamc@329
|
190 val p_pat = P.p_pat
|
adamc@329
|
191
|
adamc@329
|
192 fun expError env err =
|
adamc@329
|
193 case err of
|
adamc@329
|
194 UnboundExp (loc, s) =>
|
adamc@329
|
195 ErrorMsg.errorAt loc ("Unbound expression variable " ^ s)
|
adamc@329
|
196 | UnboundStrInExp (loc, s) =>
|
adamc@329
|
197 ErrorMsg.errorAt loc ("Unbound structure " ^ s)
|
adamc@329
|
198 | Unify (e, c1, c2, uerr) =>
|
adamc@329
|
199 (ErrorMsg.errorAt (#2 e) "Unification failure";
|
adamc@329
|
200 eprefaces' [("Expression", p_exp env e),
|
adamc@329
|
201 ("Have con", p_con env c1),
|
adamc@329
|
202 ("Need con", p_con env c2)];
|
adamc@329
|
203 cunifyError env uerr)
|
adamc@339
|
204 | Unif (action, loc, c) =>
|
adamc@339
|
205 (ErrorMsg.errorAt loc ("Unification variable blocks " ^ action);
|
adamc@329
|
206 eprefaces' [("Con", p_con env c)])
|
adamc@329
|
207 | WrongForm (variety, e, t) =>
|
adamc@329
|
208 (ErrorMsg.errorAt (#2 e) ("Expression is not a " ^ variety);
|
adamc@329
|
209 eprefaces' [("Expression", p_exp env e),
|
adamc@329
|
210 ("Type", p_con env t)])
|
adamc@329
|
211 | IncompatibleCons (c1, c2) =>
|
adamc@329
|
212 (ErrorMsg.errorAt (#2 c1) "Incompatible constructors";
|
adamc@329
|
213 eprefaces' [("Con 1", p_con env c1),
|
adamc@329
|
214 ("Con 2", p_con env c2)])
|
adamc@329
|
215 | DuplicatePatternVariable (loc, s) =>
|
adamc@329
|
216 ErrorMsg.errorAt loc ("Duplicate pattern variable " ^ s)
|
adamc@329
|
217 | PatUnify (p, c1, c2, uerr) =>
|
adamc@329
|
218 (ErrorMsg.errorAt (#2 p) "Unification failure for pattern";
|
adamc@329
|
219 eprefaces' [("Pattern", p_pat env p),
|
adamc@329
|
220 ("Have con", p_con env c1),
|
adamc@329
|
221 ("Need con", p_con env c2)];
|
adamc@329
|
222 cunifyError env uerr)
|
adamc@329
|
223 | UnboundConstructor (loc, ms, s) =>
|
adamc@329
|
224 ErrorMsg.errorAt loc ("Unbound constructor " ^ String.concatWith "." (ms @ [s]) ^ " in pattern")
|
adamc@329
|
225 | PatHasArg loc =>
|
adamc@329
|
226 ErrorMsg.errorAt loc "Constructor expects no argument but is used with argument"
|
adamc@329
|
227 | PatHasNoArg loc =>
|
adamc@329
|
228 ErrorMsg.errorAt loc "Constructor expects argument but is used with no argument"
|
adamc@819
|
229 | Inexhaustive (loc, p) =>
|
adamc@819
|
230 (ErrorMsg.errorAt loc "Inexhaustive 'case'";
|
adamc@819
|
231 eprefaces' [("Missed case", p_pat env p)])
|
adamc@329
|
232 | DuplicatePatField (loc, s) =>
|
adamc@329
|
233 ErrorMsg.errorAt loc ("Duplicate record field " ^ s ^ " in pattern")
|
adamc@329
|
234 | OutOfContext (loc, co) =>
|
adamc@329
|
235 (ErrorMsg.errorAt loc "Type class wildcard occurs out of context";
|
adamc@329
|
236 Option.app (fn (e, c) => eprefaces' [("Function", p_exp env e),
|
adamc@329
|
237 ("Type", p_con env c)]) co)
|
adamc@329
|
238 | Unresolvable (loc, c) =>
|
adamc@329
|
239 (ErrorMsg.errorAt loc "Can't resolve type class instance";
|
adamc@850
|
240 eprefaces' [("Class constraint", p_con env c)(*,
|
adamc@711
|
241 ("Class database", p_list (fn (c, rules) =>
|
adamc@711
|
242 box [P.p_con env c,
|
adamc@711
|
243 PD.string ":",
|
adamc@711
|
244 space,
|
adamc@711
|
245 p_list (fn (c, e) =>
|
adamc@711
|
246 box [p_exp env e,
|
adamc@711
|
247 PD.string ":",
|
adamc@711
|
248 space,
|
adamc@711
|
249 P.p_con env c]) rules])
|
adamc@850
|
250 (E.listClasses env))*)])
|
adamc@329
|
251 | IllegalRec (x, e) =>
|
adamc@329
|
252 (ErrorMsg.errorAt (#2 e) "Illegal 'val rec' righthand side (must be a function abstraction)";
|
adamc@329
|
253 eprefaces' [("Variable", PD.string x),
|
adamc@329
|
254 ("Expression", p_exp env e)])
|
adamc@329
|
255
|
adamc@329
|
256
|
adamc@329
|
257 datatype decl_error =
|
adamc@329
|
258 KunifsRemain of decl list
|
adamc@329
|
259 | CunifsRemain of decl list
|
adamc@329
|
260 | Nonpositive of decl
|
adamc@329
|
261
|
adamc@329
|
262 fun lspan [] = ErrorMsg.dummySpan
|
adamc@329
|
263 | lspan ((_, loc) :: _) = loc
|
adamc@329
|
264
|
adamc@329
|
265 val p_decl = P.p_decl
|
adamc@329
|
266
|
adamc@329
|
267 fun declError env err =
|
adamc@329
|
268 case err of
|
adamc@329
|
269 KunifsRemain ds =>
|
adam@1521
|
270 (ErrorMsg.errorAt (lspan ds) "Some kind unification variables are undetermined in declaration\n(look for them as \"<UNIF:...>\")";
|
adamc@329
|
271 eprefaces' [("Decl", p_list_sep PD.newline (p_decl env) ds)])
|
adamc@329
|
272 | CunifsRemain ds =>
|
adam@1521
|
273 (ErrorMsg.errorAt (lspan ds) "Some constructor unification variables are undetermined in declaration\n(look for them as \"<UNIF:...>\")";
|
adamc@329
|
274 eprefaces' [("Decl", p_list_sep PD.newline (p_decl env) ds)])
|
adamc@329
|
275 | Nonpositive d =>
|
adamc@329
|
276 (ErrorMsg.errorAt (#2 d) "Non-strictly-positive datatype declaration (could allow non-termination)";
|
adamc@329
|
277 eprefaces' [("Decl", p_decl env d)])
|
adamc@329
|
278
|
adamc@329
|
279 datatype sgn_error =
|
adamc@329
|
280 UnboundSgn of ErrorMsg.span * string
|
adamc@1000
|
281 | UnmatchedSgi of ErrorMsg.span * sgn_item
|
adamc@1000
|
282 | SgiWrongKind of ErrorMsg.span * sgn_item * kind * sgn_item * kind * kunify_error
|
adamc@1000
|
283 | SgiWrongCon of ErrorMsg.span * sgn_item * con * sgn_item * con * cunify_error
|
adamc@1000
|
284 | SgiMismatchedDatatypes of ErrorMsg.span * sgn_item * sgn_item
|
adamc@1000
|
285 * (con * con * cunify_error) option
|
adamc@1000
|
286 | SgnWrongForm of ErrorMsg.span * sgn * sgn
|
adamc@329
|
287 | UnWhereable of sgn * string
|
adamc@329
|
288 | WhereWrongKind of kind * kind * kunify_error
|
adamc@329
|
289 | NotIncludable of sgn
|
adamc@329
|
290 | DuplicateCon of ErrorMsg.span * string
|
adamc@329
|
291 | DuplicateVal of ErrorMsg.span * string
|
adamc@329
|
292 | DuplicateSgn of ErrorMsg.span * string
|
adamc@329
|
293 | DuplicateStr of ErrorMsg.span * string
|
adamc@329
|
294 | NotConstraintsable of sgn
|
adamc@329
|
295
|
adamc@329
|
296 val p_sgn_item = P.p_sgn_item
|
adamc@329
|
297 val p_sgn = P.p_sgn
|
adamc@329
|
298
|
adamc@329
|
299 fun sgnError env err =
|
adamc@329
|
300 case err of
|
adamc@329
|
301 UnboundSgn (loc, s) =>
|
adamc@329
|
302 ErrorMsg.errorAt loc ("Unbound signature variable " ^ s)
|
adamc@1000
|
303 | UnmatchedSgi (loc, sgi) =>
|
adamc@329
|
304 (ErrorMsg.errorAt loc "Unmatched signature item";
|
adamc@329
|
305 eprefaces' [("Item", p_sgn_item env sgi)])
|
adamc@1000
|
306 | SgiWrongKind (loc, sgi1, k1, sgi2, k2, kerr) =>
|
adamc@1000
|
307 (ErrorMsg.errorAt loc "Kind unification failure in signature matching:";
|
adamc@329
|
308 eprefaces' [("Have", p_sgn_item env sgi1),
|
adamc@329
|
309 ("Need", p_sgn_item env sgi2),
|
adamc@623
|
310 ("Kind 1", p_kind env k1),
|
adamc@623
|
311 ("Kind 2", p_kind env k2)];
|
adamc@623
|
312 kunifyError env kerr)
|
adamc@1000
|
313 | SgiWrongCon (loc, sgi1, c1, sgi2, c2, cerr) =>
|
adamc@1000
|
314 (ErrorMsg.errorAt loc "Constructor unification failure in signature matching:";
|
adamc@329
|
315 eprefaces' [("Have", p_sgn_item env sgi1),
|
adamc@329
|
316 ("Need", p_sgn_item env sgi2),
|
adamc@329
|
317 ("Con 1", p_con env c1),
|
adamc@329
|
318 ("Con 2", p_con env c2)];
|
adamc@329
|
319 cunifyError env cerr)
|
adamc@1000
|
320 | SgiMismatchedDatatypes (loc, sgi1, sgi2, cerro) =>
|
adamc@1000
|
321 (ErrorMsg.errorAt loc "Mismatched 'datatype' specifications:";
|
adamc@329
|
322 eprefaces' [("Have", p_sgn_item env sgi1),
|
adamc@329
|
323 ("Need", p_sgn_item env sgi2)];
|
adamc@329
|
324 Option.app (fn (c1, c2, ue) =>
|
adamc@329
|
325 (eprefaces "Unification error"
|
adamc@329
|
326 [("Con 1", p_con env c1),
|
adamc@329
|
327 ("Con 2", p_con env c2)];
|
adamc@329
|
328 cunifyError env ue)) cerro)
|
adamc@1000
|
329 | SgnWrongForm (loc, sgn1, sgn2) =>
|
adamc@1000
|
330 (ErrorMsg.errorAt loc "Incompatible signatures:";
|
adamc@329
|
331 eprefaces' [("Sig 1", p_sgn env sgn1),
|
adamc@329
|
332 ("Sig 2", p_sgn env sgn2)])
|
adamc@329
|
333 | UnWhereable (sgn, x) =>
|
adamc@329
|
334 (ErrorMsg.errorAt (#2 sgn) "Unavailable field for 'where'";
|
adamc@329
|
335 eprefaces' [("Signature", p_sgn env sgn),
|
adamc@329
|
336 ("Field", PD.string x)])
|
adamc@329
|
337 | WhereWrongKind (k1, k2, kerr) =>
|
adamc@329
|
338 (ErrorMsg.errorAt (#2 k1) "Wrong kind for 'where'";
|
adamc@623
|
339 eprefaces' [("Have", p_kind env k1),
|
adamc@623
|
340 ("Need", p_kind env k2)];
|
adamc@623
|
341 kunifyError env kerr)
|
adamc@329
|
342 | NotIncludable sgn =>
|
adamc@329
|
343 (ErrorMsg.errorAt (#2 sgn) "Invalid signature to 'include'";
|
adamc@329
|
344 eprefaces' [("Signature", p_sgn env sgn)])
|
adamc@329
|
345 | DuplicateCon (loc, s) =>
|
adamc@329
|
346 ErrorMsg.errorAt loc ("Duplicate constructor " ^ s ^ " in signature")
|
adamc@329
|
347 | DuplicateVal (loc, s) =>
|
adamc@329
|
348 ErrorMsg.errorAt loc ("Duplicate value " ^ s ^ " in signature")
|
adamc@329
|
349 | DuplicateSgn (loc, s) =>
|
adamc@329
|
350 ErrorMsg.errorAt loc ("Duplicate signature " ^ s ^ " in signature")
|
adamc@329
|
351 | DuplicateStr (loc, s) =>
|
adamc@329
|
352 ErrorMsg.errorAt loc ("Duplicate structure " ^ s ^ " in signature")
|
adamc@329
|
353 | NotConstraintsable sgn =>
|
adamc@329
|
354 (ErrorMsg.errorAt (#2 sgn) "Invalid signature for 'open constraints'";
|
adamc@329
|
355 eprefaces' [("Signature", p_sgn env sgn)])
|
adamc@329
|
356
|
adamc@329
|
357 datatype str_error =
|
adamc@329
|
358 UnboundStr of ErrorMsg.span * string
|
adamc@329
|
359 | NotFunctor of sgn
|
adamc@329
|
360 | FunctorRebind of ErrorMsg.span
|
adamc@329
|
361 | UnOpenable of sgn
|
adamc@706
|
362 | NotType of ErrorMsg.span * kind * (kind * kind * kunify_error)
|
adamc@329
|
363 | DuplicateConstructor of string * ErrorMsg.span
|
adamc@329
|
364 | NotDatatype of ErrorMsg.span
|
adamc@329
|
365
|
adamc@329
|
366 fun strError env err =
|
adamc@329
|
367 case err of
|
adamc@329
|
368 UnboundStr (loc, s) =>
|
adamc@329
|
369 ErrorMsg.errorAt loc ("Unbound structure variable " ^ s)
|
adamc@329
|
370 | NotFunctor sgn =>
|
adamc@329
|
371 (ErrorMsg.errorAt (#2 sgn) "Application of non-functor";
|
adamc@329
|
372 eprefaces' [("Signature", p_sgn env sgn)])
|
adamc@329
|
373 | FunctorRebind loc =>
|
adamc@329
|
374 ErrorMsg.errorAt loc "Attempt to rebind functor"
|
adamc@329
|
375 | UnOpenable sgn =>
|
adamc@329
|
376 (ErrorMsg.errorAt (#2 sgn) "Un-openable structure";
|
adamc@329
|
377 eprefaces' [("Signature", p_sgn env sgn)])
|
adamc@706
|
378 | NotType (loc, k, (k1, k2, ue)) =>
|
adamc@706
|
379 (ErrorMsg.errorAt loc "'val' type kind is not 'Type'";
|
adamc@623
|
380 eprefaces' [("Kind", p_kind env k),
|
adamc@623
|
381 ("Subkind 1", p_kind env k1),
|
adamc@623
|
382 ("Subkind 2", p_kind env k2)];
|
adamc@623
|
383 kunifyError env ue)
|
adamc@329
|
384 | DuplicateConstructor (x, loc) =>
|
adamc@329
|
385 ErrorMsg.errorAt loc ("Duplicate datatype constructor " ^ x)
|
adamc@329
|
386 | NotDatatype loc =>
|
adamc@329
|
387 ErrorMsg.errorAt loc "Trying to import non-datatype as a datatype"
|
adamc@329
|
388
|
adamc@329
|
389 end
|