Mercurial > urweb

comparison src/elaborate.sml @ 833:9a1026e2b3f5

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