diff src/elaborate.sml @ 216:38b299373676

Looking up in a type class from a module
author Adam Chlipala <adamc@hcoop.net>
date Sat, 16 Aug 2008 15:58:25 -0400
parents 0343557355fc
children 56db662ebcfd
line wrap: on
line diff
--- a/src/elaborate.sml	Sat Aug 16 15:09:53 2008 -0400
+++ b/src/elaborate.sml	Sat Aug 16 15:58:25 2008 -0400
@@ -1373,6 +1373,21 @@
         isTotal (combinedCoverage ps, t)
     end
 
+fun normClassConstraint envs c =
+    let
+        val ((c, loc), gs1) = hnormCon envs c
+    in
+        case c of
+            L'.CApp (f, x) =>
+            let
+                val (f, gs2) = hnormCon envs f
+                val (x, gs3) = hnormCon envs x
+            in
+                ((L'.CApp (f, x), loc), gs1 @ gs2 @ gs3)
+            end
+          | _ => ((c, loc), gs1)
+    end
+
 fun elabExp (env, denv) (eAll as (e, loc)) =
     let
         
@@ -1430,10 +1445,14 @@
             in
                 case t1 of
                     (L'.TFun (dom, ran), _) =>
-                    (case E.resolveClass env dom of
-                         NONE => (expError env (Unresolvable (loc, dom));
-                                  (eerror, cerror, []))
-                       | SOME pf => ((L'.EApp (e1', pf), loc), ran, gs1 @ gs2 @ gs3))
+                    let
+                        val (dom, gs4) = normClassConstraint (env, denv) dom
+                    in
+                        case E.resolveClass env dom of
+                            NONE => (expError env (Unresolvable (loc, dom));
+                                     (eerror, cerror, []))
+                          | SOME pf => ((L'.EApp (e1', pf), loc), ran, gs1 @ gs2 @ gs3 @ gs4)
+                    end
                   | _ => (expError env (OutOfContext loc);
                           (eerror, cerror, []))
             end