[fixed well-formedness check for superclass instances
mail@stefanwehr.de**20050531080736
 
 The check was not working properly for multi-param typeclasses.
] {
hunk ./Symtab.hs 35
-  findDataConstructor, findMethodSig, getAssocIndexCount, isMethod,
-  getMethods,
+  findAllSuperConstraints, findDataConstructor, findMethodSig, 
+  getAssocIndexCount, isMethod, getMethods,
hunk ./Symtab.hs 135
+
+-- Returns the constraint for all superclasses with the parameters
+-- of the constraints reflecting the parameters of the class.
+findAllSuperConstraints :: ClassId -> ST [ClassConstraint]
+findAllSuperConstraints cid = 
+    do cdec <- findClass cid
+       let constrs = class_constraints cdec
+       l <- mapM handleConstraint constrs
+       return $ concat l
+    where
+    handleConstraint cc@(ClassConstraint cid ts) = 
+        do cdec <- findClass cid
+           let subst = substFromAssocs (zip (class_params cdec) ts)
+           constrs <- findAllSuperConstraints cid
+           let constrParams = applySubst subst (map cc_params constrs)
+               supers = map (\ (cc, ps) -> cc { cc_params = ps }) 
+                            (zip constrs constrParams)
+           return $ cc : supers
hunk ./WellFormedness.hs 105
--- {missing_superclass_instance.phc}
+-- {missing_superclass_instance.phc, missing_superclass_instance2.phc}
hunk ./WellFormedness.hs 108
-    do supers <- findAllSuperClasses (inst_class ci)
+    do let cid = inst_class ci
+       cdec <- findClass cid
hunk ./WellFormedness.hs 111
-       mapM (checkEntailment constrs) supers
+           subst = substFromAssocs (zip (class_params cdec) (inst_types ci))
+       supers <- findAllSuperConstraints cid
+       mapM (checkEntailment subst constrs) supers
hunk ./WellFormedness.hs 116
-    checkEntailment :: [Constraint] -> ClassId -> ST ()
-    checkEntailment ps cid = 
-        do let c = CC $ ClassConstraint cid (inst_types ci)
-           b <- entail ps c
+    checkEntailment :: TypeSubst -> [Constraint] -> ClassConstraint -> ST ()
+    checkEntailment subst ps (ClassConstraint cid ts) = 
+        do let cc = CC $ ClassConstraint cid (applySubst subst ts)
+           debug ("checking if context " ++ showPpr' ps ++ " entails " ++
+                  "superclass constraint " ++ showPpr' cc)
+           b <- entail ps cc
}