Revised kind signatures

Tue Aug  1 14:10:39 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
  * Revised kind signatures

compiler/hsSyn/HsDecls.lhs

@@ -362,7 +362,9 @@ data TyClDecl name
 		tcdTyVars :: [LHsTyVarBndr name], 	-- Type variables
 		tcdTyPats :: Maybe [LHsType name],	-- Type patterns
 		tcdKindSig:: Maybe Kind,		-- Optional kind sig; 
-							-- (only for the 'where' form)
+							-- (only for the 
+							-- 'where' form and
+							-- indexed type sigs)
 
 		tcdCons	  :: [LConDecl name],	 	-- Data constructors
 			-- For data T a = T1 | T2 a          the LConDecls all have ResTyH98
@@ -380,7 +382,7 @@ data TyClDecl name
   | TyFunction {tcdLName  :: Located name,	        -- type constructor
 		tcdTyVars :: [LHsTyVarBndr name],	-- type variables
 		tcdIso    :: Bool,	                -- injective type?
-		tcdKindSig:: Maybe Kind			-- result kind
+		tcdKind   :: Kind			-- result kind
     }
 
   | TySynonym {	tcdLName  :: Located name,	        -- type constructor
@@ -493,17 +495,14 @@ instance OutputableBndr name
 	= hsep [ptext SLIT("foreign import type dotnet"), ppr ltycon]
 
     ppr (TyFunction {tcdLName = ltycon, tcdTyVars = tyvars, tcdIso = iso, 
-		     tcdKindSig = mb_sig})
+		     tcdKind = kind})
       = typeMaybeIso <+> pp_decl_head [] ltycon tyvars Nothing <+> 
-	ppr_sig mb_sig
+	dcolon <+> pprKind kind
         where
 	  typeMaybeIso = if iso 
 			 then ptext SLIT("type iso") 
 			 else ptext SLIT("type")
 
-	  ppr_sig Nothing     = empty
-	  ppr_sig (Just kind) = dcolon <+> pprKind kind
-
     ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
 		    tcdSynRhs = mono_ty})
       = hang (ptext SLIT("type") <+> pp_decl_head [] ltycon tyvars typats <+> 

compiler/parser/Parser.y.pp

@@ -444,7 +444,8 @@ topdecls :: { OrdList (LHsDecl RdrName) }
 
 topdecl :: { OrdList (LHsDecl RdrName) }
   	: cl_decl			{ unitOL (L1 (TyClD (unLoc $1))) }
-  	| ty_decl			{% checkTopTyClD $1 >>= return.unitOL.L1 }
+  	| ty_decl			{% checkTopTypeD $1 >>=
+					   return.unitOL.L1 }
 	| 'instance' inst_type where
 		{ let (binds, sigs, ats) = cvBindsAndSigs (unLoc $3)
 		  in unitOL (L (comb3 $1 $2 $3) 
@@ -478,7 +479,7 @@ cl_decl :: { LTyClDecl RdrName }
 ty_decl :: { LTyClDecl RdrName }
         -- type function signature and equations (w/ type synonyms as special
         -- case); we need to handle all this in one rule to avoid a large
-        -- number of shift/reduce conflicts (due to the generality of `type')
+        -- number of shift/reduce conflicts
         : 'type' opt_iso type kind_or_ctype
 	        --
 		-- Note the use of type for the head; this allows
@@ -497,16 +498,28 @@ ty_decl :: { LTyClDecl RdrName }
 		          ; return (L (comb3 $1 $3 kind) 
 				      (TyFunction tc tvs $2 (unLoc kind)))
 		          } 
-		     Right ty  -> 
+		     Right ty | not $2 -> 
 		       do { (tc, tvs, typats) <- checkSynHdr $3 True
 		          ; return (L (comb2 $1 ty) 
 				      (TySynonym tc tvs typats ty)) }
+		     Right ty | otherwise -> 
+		       parseError (comb2 $1 ty) 
+		         "iso tag is only allowed in kind signatures"
                 }
 
+        -- kind signature of indexed type
+        | data_or_newtype tycl_hdr '::' kind
+		{% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
+                      ; checkTyVars tparms False  -- no type pattern
+		      ; return $
+			  L (comb3 $1 $2 $4)
+			    (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing) 
+			     (Just (unLoc $4)) [] Nothing) } }
+
         -- data type or newtype declaration
 	| data_or_newtype tycl_hdr constrs deriving
 		{% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
-                      ; tpats <- checkTyVars tparms True -- can have type pats
+                      ; tpats <- checkTyVars tparms True  -- can have type pats
 		      ; return $
 			  L (comb4 $1 $2 $3 $4)
 			           -- We need the location on tycl_hdr in case 
@@ -529,10 +542,9 @@ opt_iso :: { Bool }
 	:       { False }
 	| 'iso'	{ True  }
 
-kind_or_ctype :: { Either (Located (Maybe Kind)) (LHsType RdrName) }
-	: 		{ Left  (noLoc Nothing)           }
-        | '::' kind	{ Left  (LL    (Just (unLoc $2))) }
-	| '=' ctype	{ Right (LL    (unLoc $2))        }
+kind_or_ctype :: { Either (Located Kind) (LHsType RdrName) }
+        : '::' kind     { Left  (LL (unLoc $2)) }
+	| '=' ctype	{ Right (LL (unLoc $2)) }
 		-- Note ctype, not sigtype, on the right of '='
 		-- We allow an explicit for-all but we don't insert one
 		-- in 	type Foo a = (b,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])
-	checkTopTyClD,	      -- LTyClDecl RdrName -> P (HsDecl RdrName)
+	checkTopTypeD,	      -- LTyClDecl RdrName -> P (HsDecl RdrName)
 	checkInstType,	      -- HsType -> P HsType
 	checkPattern,	      -- HsExp -> P HsPat
 	checkPatterns,	      -- SrcLoc -> [HsExp] -> P [HsPat]
@@ -433,7 +433,7 @@ checkTyClHdr :: LHsContext RdrName -> LHsType RdrName
 -- result.  Eg, for
 --      T Int [a]
 -- we return
---      ('()', 'T', ['a'], Just ['Int', '[a]'])
+--      ('()', 'T', ['a'], ['Int', '[a]'])
 checkTyClHdr (L l cxt) ty
   = do (tc, tvs, parms) <- gol ty []
        mapM_ chk_pred cxt
@@ -506,16 +506,21 @@ extractTyVars tvs = collects [] tvs
 			    tvs' <- collects tvs ts
 			    collect tvs' t
 
--- Wrap a toplevel type or class declaration into 'TyClDecl' after ensuring
--- that all type parameters are variables only (which is in contrast to
--- associated type declarations).
+-- 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).
 --
-checkTopTyClD :: LTyClDecl RdrName -> P (HsDecl RdrName)
-checkTopTyClD (L _ d@TyData {tcdTyPats = Just typats}) = 
+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
-    return $ TyClD d {tcdTyPats = Nothing}
-checkTopTyClD (L _ d)                             = return $ TyClD d
+    panic "checkTopTypeD: check on previous line should fail w/ a parse error"
+checkTopTypeD (L _ d) = return $ TyClD d
 
 checkContext :: LHsType RdrName -> P (LHsContext RdrName)
 checkContext (L l t)