[add several error checking functions dealing with class and instance declarations
John Meacham <john@repetae.net>**20061025042451] hunk ./FrontEnd/Class.hs 349
-    (_,(className,[th@(TAp _ cvar)])) = qtToClassHead kt qualType
+    (_,(className,[th@(~(TAp _ cvar))])) = qtToClassHead kt qualType
hunk ./FrontEnd/HsErrors.hs 5
-module FrontEnd.HsErrors(hsType,hsDecl,checkDeriving) where
+module FrontEnd.HsErrors(
+    hsType,
+    hsDeclTopLevel,
+    hsDeclLocal
+    ) where
hunk ./FrontEnd/HsErrors.hs 36
-data Context = InClass | InInstance | TopLevel
+data Context = InClass [HsType] | InInstance [HsType] | TopLevel | Local
hunk ./FrontEnd/HsErrors.hs 39
+
+
hunk ./FrontEnd/HsErrors.hs 42
-    show InClass = "in a class declaration"
-    show InInstance = "in an instance declaration"
+    show InClass {} = "in a class declaration"
+    show InInstance {} = "in an instance declaration"
hunk ./FrontEnd/HsErrors.hs 45
+    show Local = "in local declaration block"
+
hunk ./FrontEnd/HsErrors.hs 48
+hsDeclTopLevel,hsDeclLocal :: MonadWarn m => HsDecl -> m ()
+hsDeclTopLevel = hsDecl TopLevel
+hsDeclLocal = hsDecl Local
hunk ./FrontEnd/HsErrors.hs 52
-hsDecl :: MonadWarn m => HsDecl -> m ()
-hsDecl decl = f TopLevel decl where
+
+
+hsDecl :: MonadWarn m => Context -> HsDecl -> m ()
+hsDecl cntx decl = f cntx decl where
hunk ./FrontEnd/HsErrors.hs 68
-    f context decl@HsTypeDecl { hsDeclTArgs = as }
-        | context `elem` [TopLevel, InClass], any (not . isHsTyVar) as = warn (srcLoc decl) "invalid-decl" $ "complex type arguments not allowed " ++ show context
+    f context@TopLevel decl@HsTypeDecl { hsDeclTArgs = as } | any (not . isHsTyVar) as = warn (srcLoc decl) "invalid-decl" $ "complex type arguments not allowed " ++ show context
+    f context@(InClass ts) decl@HsTypeDecl { hsDeclTArgs = as }
+        | any (not . isHsTyVar) as = warn (srcLoc decl) "invalid-decl" $ "complex type arguments not allowed " ++ show context
+    --    | length as < length ts || or (zipWith (/=) as ts) = warn (srcLoc decl) "invalid-assoc" $ "arguments to associated type must match class decl" ++ show (as,ts)
+    f context@(InInstance ts) decl@HsTypeDecl { hsDeclTArgs = as }
+    --    | length as < length ts || or (zipWith (==) as ts) = warn (srcLoc decl) "invalid-assoc" $ "arguments to associated type must match instance head"
+        | any (not . isHsTyVar) (drop (length ts) as) = warn (srcLoc decl) "invalid-decl" $ "extra complex type arguments not allowed " ++ show context
hunk ./FrontEnd/HsErrors.hs 77
-    f TopLevel decl@HsClassDecl {} = return ()
-    f TopLevel decl@HsInstDecl {} = return ()
+    f TopLevel decl@HsClassDecl { hsDeclQualType = qt, hsDeclDecls = decls } = do args <- fetchQtArgs (srcLoc decl) qt; mapM_ (f (InClass args)) decls
+    f TopLevel decl@HsInstDecl { hsDeclQualType = qt, hsDeclDecls = decls } = do args <- fetchQtArgs (srcLoc decl) qt; mapM_ (f (InInstance args)) decls
hunk ./FrontEnd/HsErrors.hs 84
+fetchQtArgs sl HsQualType { hsQualTypeType = t } | (HsTyCon {},args@(_:_)) <- fromHsTypeApp t = return args
+fetchQtArgs sl _ = warn sl "invalid-decl" "invalid head in class or instance decl" >> return []
+
hunk ./FrontEnd/HsErrors.hs 93
+fromHsTypeApp t = f t [] where
+    f (HsTyApp a b) rs = f a (b:rs)
+    f t rs = (t,rs)
hunk ./FrontEnd/HsSyn.hs 150
-	 | HsClassDecl	 SrcLoc HsQualType [HsDecl]
-	 | HsInstDecl	 SrcLoc HsQualType [HsDecl]
+	 | HsClassDecl	 { hsDeclSrcLoc :: SrcLoc, hsDeclQualType :: HsQualType, hsDeclDecls :: [HsDecl] }
+	 | HsInstDecl    { hsDeclSrcLoc :: SrcLoc, hsDeclQualType :: HsQualType, hsDeclDecls :: [HsDecl] }
hunk ./FrontEnd/Rename.hs 80
-import FrontEnd.HsErrors as HsErrors
hunk ./FrontEnd/Rename.hs 93
+import qualified FrontEnd.HsErrors as HsErrors
hunk ./FrontEnd/Rename.hs 250
-        decls' <-  renameHsDecls (hsModuleDecls tidy) subTable' ; return decls'
+        decls' <-  renameHsDeclsTL (hsModuleDecls tidy) subTable' ; return decls'
hunk ./FrontEnd/Rename.hs 266
-renameHsDecls decls subtable = do
+renameHsDecls  decls subtable = do
+    ans <- mapRename renameHsDecl (expandTypeSigs decls) subtable
+    mapM_ HsErrors.hsDeclLocal ans
+    return ans
+
+renameHsDeclsTL :: [HsDecl] -> SubTable -> ScopeSM ([HsDecl])
+renameHsDeclsTL  decls subtable = do
+    ans <- mapRename renameHsDecl (expandTypeSigs decls) subtable
+    mapM_ HsErrors.hsDeclTopLevel ans
+    return ans
+
+renameHsDeclsN :: [HsDecl] -> SubTable -> ScopeSM ([HsDecl])
+renameHsDeclsN  decls subtable = do
hunk ./FrontEnd/Rename.hs 280
-    mapM_ HsErrors.hsDecl ans
hunk ./FrontEnd/Rename.hs 376
-    hsDecls' <- renameHsDecls hsDecls subTable
+    hsDecls' <- renameHsDeclsN hsDecls subTable
hunk ./FrontEnd/Rename.hs 382
-    hsDecls' <- renameHsDecls hsDecls subTable'
+    hsDecls' <- renameHsDeclsN hsDecls subTable'
hunk ./FrontEnd/Warning.hs 84
+    "invalid-assoc",