X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FHsDecls.lhs;h=8078e7a2a86f1bc16334608161e87025179bb531;hb=108361d05dfb0aa37871c2c6a4ddec45a1b68010;hp=f2bf9d3904e6388716397e2ba555b9bb597ff038;hpb=72264dbcb05c7045dff28aa88b55634fa6c1ddf0;p=ghc-hetmet.git

diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index f2bf9d3..8078e7a 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -18,7 +18,8 @@ module HsDecls (
 	DeprecDecl(..),  LDeprecDecl,
 	HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups,
 	tcdName, tyClDeclNames, tyClDeclTyVars,
-	isClassDecl, isTFunDecl, isSynDecl, isTEqnDecl, isDataDecl, 
+	isClassDecl, isTFunDecl, isSynDecl, isDataDecl, isKindSigDecl,
+	isIdxTyDecl,
 	countTyClDecls,
 	conDetailsTys,
 	instDeclATs,
@@ -38,20 +39,19 @@ import HsPat		( HsConDetails(..), hsConArgs )
 import HsImpExp		( pprHsVar )
 import HsTypes
 import NameSet          ( NameSet )
-import HscTypes		( DeprecTxt )
 import CoreSyn		( RuleName )
-import Kind		( Kind, pprKind )
-import BasicTypes	( Activation(..) )
+import {- Kind parts of -} Type		( Kind, pprKind )
+import BasicTypes	( Activation(..), DeprecTxt )
 import ForeignCall	( CCallTarget(..), DNCallSpec, CCallConv, Safety,
 			  CExportSpec(..), CLabelString ) 
 
 -- others:
-import FunDeps		( pprFundeps )
-import Class		( FunDep )
+import Class		( FunDep, pprFundeps )
 import Outputable	
 import Util		( count )
 import SrcLoc		( Located(..), unLoc, noLoc )
 import FastString
+import Maybe            ( isJust )
 \end{code}
 
 
@@ -329,6 +329,31 @@ Interface file code:
 -- for a module.  That's why (despite the misnomer) IfaceSig and ForeignType
 -- are both in TyClDecl
 
+-- Representation of indexed types
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Kind signatures of indexed types come in two flavours:
+--
+-- * kind signatures for type functions: variant `TyFunction' and
+--
+-- * kind signatures for indexed data types and newtypes : variant `TyData'
+--   iff a kind is present in `tcdKindSig' and there are no constructors in
+--   `tcdCons'.
+--
+-- Indexed types are represented by 'TyData' and 'TySynonym' using the field
+-- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
+--
+--   * If it is 'Nothing', we have a *vanilla* data type declaration or type
+--     synonym declaration and 'tcdVars' contains the type parameters of the
+--     type constructor.
+--
+--   * If it is 'Just pats', we have the definition of an indexed type Then,
+--     'pats' are type patterns for the type-indexes of the type constructor
+--     and 'tcdVars' are the variables in those patterns.  Hence, the arity of
+--     the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
+--     *not* 'length tcdVars'.
+--
+-- In both cases, 'tcdVars' collects all variables we need to quantify over.
+
 type LTyClDecl name = Located (TyClDecl name)
 
 data TyClDecl name
@@ -344,7 +369,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
@@ -362,12 +389,14 @@ 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
 		tcdTyVars :: [LHsTyVarBndr name],	-- type variables
 		tcdTyPats :: Maybe [LHsType name],	-- Type patterns
+							-- 'Nothing' => vanilla
+							--   type synonym
 		tcdSynRhs :: LHsType name	        -- synonym expansion
     }
 
@@ -378,7 +407,8 @@ data TyClDecl name
 		tcdSigs    :: [LSig name],		-- Methods' signatures
 		tcdMeths   :: LHsBinds name,		-- Default methods
 		tcdATs	   :: [LTyClDecl name]		-- Associated types; ie
-							--   only 'TyData'
+							--   only 'TyData',
+							--   'TyFunction',
 							--   and 'TySynonym'
     }
 
@@ -391,7 +421,7 @@ data NewOrData
 Simple classifiers
 
 \begin{code}
-isTFunDecl, isDataDecl, isSynDecl, isTEqnDecl, isClassDecl :: 
+isTFunDecl, isDataDecl, isSynDecl, isClassDecl, isKindSigDecl, isIdxTyDecl ::
   TyClDecl name -> Bool
 
 -- type function kind signature
@@ -411,6 +441,17 @@ isDataDecl other       = False
 
 isClassDecl (ClassDecl {}) = True
 isClassDecl other	   = False
+
+-- kind signature (for an indexed type)
+isKindSigDecl (TyFunction {}                   ) = True
+isKindSigDecl (TyData     {tcdKindSig = Just _,
+			   tcdCons    = []    }) = True
+isKindSigDecl other                              = False
+
+-- definition of an instance of an indexed type
+isIdxTyDecl tydecl
+   | isSynDecl tydecl || isDataDecl tydecl = isJust (tcdTyPats tydecl)
+   | otherwise				   = False
 \end{code}
 
 Dealing with names
@@ -426,9 +467,7 @@ tyClDeclNames :: Eq name => TyClDecl name -> [Located name]
 -- We use the equality to filter out duplicate field names
 
 tyClDeclNames (TyFunction  {tcdLName = name})    = [name]
-tyClDeclNames (TySynonym   {tcdLName = name,
-			    tcdTyPats= Nothing}) = [name]
-tyClDeclNames (TySynonym   {}                  ) = []     -- type equation
+tyClDeclNames (TySynonym   {tcdLName = name})    = [name]
 tyClDeclNames (ForeignType {tcdLName = name})    = [name]
 
 tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats})
@@ -472,17 +511,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 <+> 
@@ -653,7 +689,8 @@ data InstDecl name
 				-- figures out the quantified type variables for us.
 		(LHsBinds name)
 		[LSig name]	-- User-supplied pragmatic info
-		[LTyClDecl name]-- Associated types
+		[LTyClDecl name]-- Associated types (ie, 'TyData' and
+				-- 'TySynonym' only)
 
 instance (OutputableBndr name) => Outputable (InstDecl name) where