[bugfixes
mail@stefanwehr.de**20050525051433] {
hunk ./Entailment.hs 39
-matchConstraint (id, t) (ClassConstraint id' t') | id /= id' 
+matchConstraint (id, t) (ClassConstraint id' t') 
+    | id /= id' 
hunk ./Entailment.hs 42
-                                                 | otherwise
-    = do debug ("matchConstraint `" ++ showPpr id ++ " " ++ showPpr t ++ "', `"
-                ++ showPpr id' ++ " " ++ showPpr t' ++ "'")
-         eqEnv <- getEqEnv
+    | otherwise
+    = do eqEnv <- getEqEnv
hunk ./Entailment.hs 67
-       return $ msum candidates
+       case msum candidates of
+         Nothing -> do debug ("constraint " ++ showPpr' p ++ 
+                              " is not satisfied by any instance declaration")
+                       return Nothing
+         Just (ci, goals) ->
+             do debug ("Constraint " ++ showPpr' p ++ " is satisfied by the " ++
+                       "instance declaration " ++ showInstHead ci ++ 
+                       ", provided the following subgoals are satisfied: " ++
+                       showCommaListed goals)
+                return $ Just goals
hunk ./Entailment.hs 82
-                       return $ Just (map (applySubst u') (inst_constraints ci))
+                       return $ Just (ci, 
+                                      map (applySubst u') (inst_constraints ci))
hunk ./Entailment.hs 151
-    do ps' <- toHnfs ps
-       simplify ps'
+    do debug ("performing context reduction on " ++ showCommaListed ps)
+       ps' <- toHnfs ps
+       debug ("constraints for context reduction are now in HNF: " ++
+              showCommaListed ps')
+       res <- simplify ps'
+       debug ("reduced " ++ showCommaListed ps ++ " to " ++ showCommaListed res)
+       return res
hunk ./ParseSyntax.hs 560
+showInstHead :: ClassInst -> String
+showInstHead ci = 
+    show (ppr (inst_class ci) <+> pprPrec maxPrec (inst_type ci))
+
+showClassHead :: ClassDec -> String
+showClassHead cd = 
+    show (ppr (class_name cd) <+> pprPrec maxPrec (class_param cd))
hunk ./Parser.y 69
-    'letrec'    { T _ (ReservedIdT "letrec") }
hunk ./ParserHelper.hs 66
-
+mkClassInst (cs, t) _ _ = 
+    phasefail ("illegal instance type: " ++ showPpr' t)
hunk ./Symtab.hs 32
-  findTypeDef, getEqEnv, findSuperClasses, findDataConstructor,
-  findMethodSig,
+  findTypeDef, getEqEnv, findSuperClasses, findAllSuperClasses,
+  findDataConstructor, findMethodSig,
hunk ./Symtab.hs 96
+
+-- the transitive hull of `findSuperClasses'
+-- If class hierarchy is cyclic, this function loops
+findAllSuperClasses :: ClassId -> ST [ClassId]
+findAllSuperClasses cid = 
+    do direct <- findSuperClasses cid
+       transitives <- mapM findSuperClasses direct
+       return (direct ++ concat transitives)
hunk ./TypeInference.hs 41
-import WellFormedness ( checkTypeScheme )
hunk ./TypeInference.hs 249
-       debug ("first checking if user-supplied signature is well-formed")
-       liftST $ checkTypeScheme [] sc
hunk ./TypeInference.hs 303
-       debug (dumpAssumps (applySubst s as))
hunk ./Unification.hs 171
-           else do debug ("Trying to use equality scheme " ++ showPpr' sc ++
-                          " for reducing " ++ showPpr' at)
-                   -- instantiate the scheme
+           else do -- instantiate the scheme
hunk ./Unification.hs 185
-                         in do debug ("reduction successful, result: " 
-                                      ++ showPpr' res)
+                         in do debug ("reduced " ++ showPpr' at ++ " to " ++
+                                      showPpr' res ++ " using equality scheme "
+                                      ++ showPpr sc)
hunk ./Unification.hs 233
-                   do debug "occurs check failed"
+                   do debug ("occurs check failed when unifying " ++ showPpr' u
+                             ++ " with " ++ showPpr' t)
hunk ./Unification.hs 311
-       debug ("after return from unify', remaining equations: " ++
-              showEqs u ++ ", substitution: " ++ showSubst r)
hunk ./WellFormedness.hs 39
+       debug "checking type signatures of all methods"
hunk ./WellFormedness.hs 41
+       debug "checking definitions of all associated type synonyms"
hunk ./WellFormedness.hs 43
+       debug ("checking if instances for all superclasses of a instance " ++
+              "declaration are present")
+       mapM checkInstanceForSuperClasses classInsts
+       debug "checking all user-supplied signatures"
+       Gen.everywhereM (Gen.mkM checkTypeScheme') binds
hunk ./WellFormedness.hs 49
+    where checkTypeScheme' sc =
+              do checkTypeScheme [] sc
+                 return sc
hunk ./WellFormedness.hs 102
+
+-- given: instance declaration (Phi => C t)
+-- check if (S t) holds for all superclasses S of C.
+checkInstanceForSuperClasses :: ClassInst -> ST ()
+checkInstanceForSuperClasses ci = 
+    do supers <- findAllSuperClasses (inst_class ci)
+       let constrs = inst_constraints ci
+       mapM (checkEntailment constrs) supers
+       return ()
+    where
+    checkEntailment :: [Constraint] -> ClassId -> ST ()
+    checkEntailment ps cid = 
+        do let c = CC $ ClassConstraint cid (inst_type ci)
+           b <- entail ps c
+           if not b 
+              then phasefail ("no instance for superclass " ++ showPpr cid ++
+                              " found when checking instance declaration " ++
+                              showInstHead ci)
+              else return ()
+
}