[fix obscure error message for invalid instance reported by roman
John Meacham <john@repetae.net>**20120209114221
 Ignore-this: 98d60e20cb63caaebbe1269887160b9f
] hunk ./src/FrontEnd/Class.hs 255
-    = unzip $ map (methodToTopDecls ch kt [] crecord qualType) $ methodGroups where
+    = unzip $ concatMap (methodToTopDecls kt [] crecord qualType) $ methodGroups where
hunk ./src/FrontEnd/Class.hs 276
-methodToTopDecls ::
-    ClassHierarchy
-    -> KindEnv         -- ^ the kindenv
+methodToTopDecls :: Monad m
+    => KindEnv         -- ^ the kindenv
hunk ./src/FrontEnd/Class.hs 282
-    -> (HsDecl,Assump)
-
-methodToTopDecls _  kt preds crecord qt (methodName, methodDecls)
-   = (renamedMethodDecls,(newMethodName, instantiatedSig)) where
-    (cntxt,(className,[argType])) = chToClassHead kt qt
-    newMethodName = instanceName methodName (getTypeHead argType)
-    sigFromClass = case [ s | (n, s) <- classAssumps crecord, n == methodName] of
-        [x] -> x
-        _ -> error $ "sigFromClass: " ++ (pprint className <+> pprint (classAssumps crecord))
-                                      ++ " " ++ show  methodName
-    instantiatedSig = newMethodSig' kt methodName (preds ++ cntxt) sigFromClass argType
-    renamedMethodDecls = renameOneDecl newMethodName methodDecls
+    -> m (HsDecl,Assump)
+methodToTopDecls kt preds crecord qt (methodName, methodDecls) = do
+    let (cntxt,(className,[argType])) = chToClassHead kt qt
+	newMethodName = instanceName methodName (getTypeHead argType)
+    sigFromClass <- case [ s | (n, s) <- classAssumps crecord, n == methodName] of
+	    [x] -> return x
+	    _ -> fail $ "sigFromClass: " ++ (pprint className <+> pprint (classAssumps crecord))
+					  ++ " " ++ show  methodName
+    let instantiatedSig = newMethodSig' kt methodName (preds ++ cntxt) sigFromClass argType
+	renamedMethodDecls = renameOneDecl newMethodName methodDecls
+    return (renamedMethodDecls,(newMethodName, instantiatedSig))
hunk ./src/FrontEnd/Tc/Main.hs 7
+import Text.Printf
hunk ./src/FrontEnd/Tc/Main.hs 26
+import FrontEnd.Utils
hunk ./src/FrontEnd/Tc/Main.hs 28
+import FrontEnd.Warning
hunk ./src/FrontEnd/Tc/Main.hs 628
-    f i@HsInstDecl {} = tcClassHead (hsDeclClassHead i)
+    f HsInstDecl { .. } = do
+	tcClassHead hsDeclClassHead
+        ch <- getClassHierarchy
+        let as = asksClassRecord ch (hsClassHead hsDeclClassHead) classAssumps
+	forM_ hsDeclDecls $ \d -> do
+	    case maybeGetDeclName d of
+		Just n -> when (n `notElem` fsts as) $ do
+		    addWarn InvalidDecl $ printf "Cannot declare '%s' in instance because it is not a method of class '%s'" (show n) (show $ hsClassHead hsDeclClassHead)
+		Nothing -> return ()
+	return []
+