Remove checkTopTypeD

[ghc-hetmet.git] / compiler / parser / RdrHsSyn.lhs

diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index 980c7f7..b66c759 100644 (file)
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -38,7 +38,7 @@ module RdrHsSyn (
        checkTyClHdr,         -- LHsContext RdrName -> LHsType RdrName -> P (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName], [LHsType RdrName])
        checkTyVars,          -- [LHsType RdrName] -> Bool -> P ()
        checkSynHdr,          -- LHsType RdrName -> P (Located RdrName, [LHsTyVarBndr RdrName], Maybe [LHsType RdrName])
-       checkTopTypeD,        -- LTyClDecl RdrName -> P (HsDecl RdrName)
+       checkKindSigs,        -- [LTyClDecl RdrName] -> P ()
        checkInstType,        -- HsType -> P HsType
        checkPattern,         -- HsExp -> P HsPat
        checkPatterns,        -- SrcLoc -> [HsExp] -> P [HsPat]
@@ -213,7 +213,7 @@ cvBindsAndSigs :: OrdList (LHsDecl RdrName)
   -> (Bag (LHsBind RdrName), [LSig RdrName], [LTyClDecl RdrName])
 -- Input decls contain just value bindings and signatures
 -- and in case of class or instance declarations also
--- associated data or synonym definitions
+-- associated type declarations
 cvBindsAndSigs  fb = go (fromOL fb)
   where
     go []                 = (emptyBag, [], [])
@@ -506,21 +506,16 @@ extractTyVars tvs = collects [] tvs
                            tvs' <- collects tvs ts
                            collect tvs' t
 
--- Wrap a toplevel type or data declaration into 'TyClD' and ensure for 
--- data declarations that all type parameters are variables only (which is in
--- contrast to type functions and associated type declarations).
+-- Check that associated type declarations of a class are all kind signatures.
 --
-checkTopTypeD :: LTyClDecl RdrName -> P (HsDecl RdrName)
-checkTopTypeD (L _ d@TyData {tcdTyPats = Just typats}) = 
-  do
-    -- `tcdTyPats' will only be of the form `Just typats' if `typats' contains
-    -- a non-variable pattern.  We call `checkTyPats' instead of raising an
-    -- error straight away, as `checkTyPats' raises the error at the location
-    -- of that non-variable pattern.
-    --
-    checkTyVars typats False
-    panic "checkTopTypeD: check on previous line should fail w/ a parse error"
-checkTopTypeD (L _ d) = return $ TyClD d
+checkKindSigs :: [LTyClDecl RdrName] -> P ()
+checkKindSigs = mapM_ check
+  where
+    check (L l tydecl) 
+      | isKindSigDecl tydecl
+        || isSynDecl tydecl  = return ()
+      | otherwise           = 
+       parseError l "Type declaration in a class must be a kind signature or synonym default"
 
 checkContext :: LHsType RdrName -> P (LHsContext RdrName)
 checkContext (L l t)