Mercurial > urweb
comparison src/elaborate.sml @ 833:9a1026e2b3f5
Expose resolveClass from Elaborate
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 31 May 2009 15:25:27 -0400 |
parents | d07980bf1444 |
children | 74e9e7642f08 |
comparison
equal
deleted
inserted
replaced
832:249740301a0a | 833:9a1026e2b3f5 |
---|---|
3761 | _ => raise Fail "Unable to hnormSgn in functor application") | 3761 | _ => raise Fail "Unable to hnormSgn in functor application") |
3762 | _ => (strError env (NotFunctor sgn1); | 3762 | _ => (strError env (NotFunctor sgn1); |
3763 (strerror, sgnerror, [])) | 3763 (strerror, sgnerror, [])) |
3764 end | 3764 end |
3765 | 3765 |
3766 fun resolveClass env = E.resolveClass (hnormCon env) (consEq env) env | |
3767 | |
3766 fun elabFile basis topStr topSgn env file = | 3768 fun elabFile basis topStr topSgn env file = |
3767 let | 3769 let |
3768 val () = mayDelay := true | 3770 val () = mayDelay := true |
3769 val () = delayedUnifs := [] | 3771 val () = delayedUnifs := [] |
3770 val () = delayedExhaustives := [] | 3772 val () = delayedExhaustives := [] |
3813 raise Fail "Unresolved constraint in top.ur")) | 3815 raise Fail "Unresolved constraint in top.ur")) |
3814 | TypeClass (env, c, r, loc) => | 3816 | TypeClass (env, c, r, loc) => |
3815 let | 3817 let |
3816 val c = normClassKey env c | 3818 val c = normClassKey env c |
3817 in | 3819 in |
3818 case E.resolveClass (hnormCon env) (consEq env) env c of | 3820 case resolveClass env c of |
3819 SOME e => r := SOME e | 3821 SOME e => r := SOME e |
3820 | NONE => expError env (Unresolvable (loc, c)) | 3822 | NONE => expError env (Unresolvable (loc, c)) |
3821 end) gs | 3823 end) gs |
3822 | 3824 |
3823 val () = subSgn env' topSgn' topSgn | 3825 val () = subSgn env' topSgn' topSgn |
3886 let | 3888 let |
3887 fun default () = (SOME g, solved) | 3889 fun default () = (SOME g, solved) |
3888 | 3890 |
3889 val c = normClassKey env c | 3891 val c = normClassKey env c |
3890 in | 3892 in |
3891 case E.resolveClass (hnormCon env) (consEq env) env c of | 3893 case resolveClass env c of |
3892 SOME e => (r := SOME e; | 3894 SOME e => (r := SOME e; |
3893 (NONE, true)) | 3895 (NONE, true)) |
3894 | NONE => | 3896 | NONE => |
3895 case #1 (hnormCon env c) of | 3897 case #1 (hnormCon env c) of |
3896 L'.CApp (f, x) => | 3898 L'.CApp (f, x) => |