Mercurial > urweb

comparison src/elaborate.sml @ 220:2b665e822e9a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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