diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-08-16 17:35:28 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-08-16 17:35:28 -0400 |
| commit | 631b4b46de98cae2e6d207dc596fbd57a0a1beeb (patch) | |
| tree | 9901b62d9a5999fd32bc762e08076758550a8785 /src/elaborate.sml | |
| parent | fbebdf5fa84afd716dea471e3995b6d3a7878e37 (diff) | |
SQL boolean operators
Diffstat (limited to 'src/elaborate.sml')
| -rw-r--r-- | src/elaborate.sml | 12 |
1 files changed, 7 insertions, 5 deletions
diff --git a/src/elaborate.sml b/src/elaborate.sml index dc630e0e..58918dbd 100644 --- a/src/elaborate.sml +++ b/src/elaborate.sml @@ -986,7 +986,7 @@ datatype exp_error = | Inexhaustive of ErrorMsg.span | DuplicatePatField of ErrorMsg.span * string | Unresolvable of ErrorMsg.span * L'.con - | OutOfContext of ErrorMsg.span + | OutOfContext of ErrorMsg.span * (L'.exp * L'.con) option fun expError env err = case err of @@ -1029,8 +1029,10 @@ fun expError env err = ErrorMsg.errorAt loc "Inexhaustive 'case'" | DuplicatePatField (loc, s) => ErrorMsg.errorAt loc ("Duplicate record field " ^ s ^ " in pattern") - | OutOfContext loc => - ErrorMsg.errorAt loc "Type class wildcard occurs out of context" + | OutOfContext (loc, co) => + (ErrorMsg.errorAt loc "Type class wildcard occurs out of context"; + Option.app (fn (e, c) => eprefaces' [("Function", p_exp env e), + ("Type", p_con env c)]) co) | Unresolvable (loc, c) => (ErrorMsg.errorAt loc "Can't resolve type class instance"; eprefaces' [("Class constraint", p_con env c)]) @@ -1466,10 +1468,10 @@ fun elabExp (env, denv) (eAll as (e, loc)) = (eerror, cerror, [])) | SOME pf => ((L'.EApp (e1', pf), loc), ran, gs1 @ gs2 @ gs3 @ gs4) end - | _ => (expError env (OutOfContext loc); + | _ => (expError env (OutOfContext (loc, SOME (e1', t1))); (eerror, cerror, [])) end - | L.EWild => (expError env (OutOfContext loc); + | L.EWild => (expError env (OutOfContext (loc, NONE)); (eerror, cerror, [])) | L.EApp (e1, e2) => |