Mercurial > urweb
comparison src/elaborate.sml @ 220:2b665e822e9a
SQL boolean operators
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sat, 16 Aug 2008 17:35:28 -0400 |
parents | a3413288cce1 |
children | bbe5899a9585 |
comparison
equal
deleted
inserted
replaced
219:5292c0113024 | 220:2b665e822e9a |
---|---|
984 | PatHasArg of ErrorMsg.span | 984 | PatHasArg of ErrorMsg.span |
985 | PatHasNoArg of ErrorMsg.span | 985 | PatHasNoArg of ErrorMsg.span |
986 | Inexhaustive of ErrorMsg.span | 986 | Inexhaustive of ErrorMsg.span |
987 | DuplicatePatField of ErrorMsg.span * string | 987 | DuplicatePatField of ErrorMsg.span * string |
988 | Unresolvable of ErrorMsg.span * L'.con | 988 | Unresolvable of ErrorMsg.span * L'.con |
989 | OutOfContext of ErrorMsg.span | 989 | OutOfContext of ErrorMsg.span * (L'.exp * L'.con) option |
990 | 990 |
991 fun expError env err = | 991 fun expError env err = |
992 case err of | 992 case err of |
993 UnboundExp (loc, s) => | 993 UnboundExp (loc, s) => |
994 ErrorMsg.errorAt loc ("Unbound expression variable " ^ s) | 994 ErrorMsg.errorAt loc ("Unbound expression variable " ^ s) |
1027 ErrorMsg.errorAt loc "Constructor expects argument but is used with no argument" | 1027 ErrorMsg.errorAt loc "Constructor expects argument but is used with no argument" |
1028 | Inexhaustive loc => | 1028 | Inexhaustive loc => |
1029 ErrorMsg.errorAt loc "Inexhaustive 'case'" | 1029 ErrorMsg.errorAt loc "Inexhaustive 'case'" |
1030 | DuplicatePatField (loc, s) => | 1030 | DuplicatePatField (loc, s) => |
1031 ErrorMsg.errorAt loc ("Duplicate record field " ^ s ^ " in pattern") | 1031 ErrorMsg.errorAt loc ("Duplicate record field " ^ s ^ " in pattern") |
1032 | OutOfContext loc => | 1032 | OutOfContext (loc, co) => |
1033 ErrorMsg.errorAt loc "Type class wildcard occurs out of context" | 1033 (ErrorMsg.errorAt loc "Type class wildcard occurs out of context"; |
1034 Option.app (fn (e, c) => eprefaces' [("Function", p_exp env e), | |
1035 ("Type", p_con env c)]) co) | |
1034 | Unresolvable (loc, c) => | 1036 | Unresolvable (loc, c) => |
1035 (ErrorMsg.errorAt loc "Can't resolve type class instance"; | 1037 (ErrorMsg.errorAt loc "Can't resolve type class instance"; |
1036 eprefaces' [("Class constraint", p_con env c)]) | 1038 eprefaces' [("Class constraint", p_con env c)]) |
1037 | 1039 |
1038 fun checkCon (env, denv) e c1 c2 = | 1040 fun checkCon (env, denv) e c1 c2 = |
1464 case E.resolveClass env dom of | 1466 case E.resolveClass env dom of |
1465 NONE => (expError env (Unresolvable (loc, dom)); | 1467 NONE => (expError env (Unresolvable (loc, dom)); |
1466 (eerror, cerror, [])) | 1468 (eerror, cerror, [])) |
1467 | SOME pf => ((L'.EApp (e1', pf), loc), ran, gs1 @ gs2 @ gs3 @ gs4) | 1469 | SOME pf => ((L'.EApp (e1', pf), loc), ran, gs1 @ gs2 @ gs3 @ gs4) |
1468 end | 1470 end |
1469 | _ => (expError env (OutOfContext loc); | 1471 | _ => (expError env (OutOfContext (loc, SOME (e1', t1))); |
1470 (eerror, cerror, [])) | 1472 (eerror, cerror, [])) |
1471 end | 1473 end |
1472 | L.EWild => (expError env (OutOfContext loc); | 1474 | L.EWild => (expError env (OutOfContext (loc, NONE)); |
1473 (eerror, cerror, [])) | 1475 (eerror, cerror, [])) |
1474 | 1476 |
1475 | L.EApp (e1, e2) => | 1477 | L.EApp (e1, e2) => |
1476 let | 1478 let |
1477 val (e1', t1, gs1) = elabExp (env, denv) e1 | 1479 val (e1', t1, gs1) = elabExp (env, denv) e1 |