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

diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index 070079e..f2bf9d3 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -18,7 +18,7 @@ module HsDecls (
 	DeprecDecl(..),  LDeprecDecl,
 	HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups,
 	tcdName, tyClDeclNames, tyClDeclTyVars,
-	isClassDecl, isSynDecl, isDataDecl, 
+	isClassDecl, isTFunDecl, isSynDecl, isTEqnDecl, isDataDecl, 
 	countTyClDecls,
 	conDetailsTys,
 	instDeclATs,
@@ -359,8 +359,15 @@ data TyClDecl name
 			-- are non-empty for the newtype-deriving case
     }
 
+  | TyFunction {tcdLName  :: Located name,	        -- type constructor
+		tcdTyVars :: [LHsTyVarBndr name],	-- type variables
+		tcdIso    :: Bool,	                -- injective type?
+		tcdKindSig:: Maybe Kind			-- result kind
+    }
+
   | TySynonym {	tcdLName  :: Located name,	        -- type constructor
 		tcdTyVars :: [LHsTyVarBndr name],	-- type variables
+		tcdTyPats :: Maybe [LHsType name],	-- Type patterns
 		tcdSynRhs :: LHsType name	        -- synonym expansion
     }
 
@@ -384,10 +391,20 @@ data NewOrData
 Simple classifiers
 
 \begin{code}
-isDataDecl, isSynDecl, isClassDecl :: TyClDecl name -> Bool
+isTFunDecl, isDataDecl, isSynDecl, isTEqnDecl, isClassDecl :: 
+  TyClDecl name -> Bool
+
+-- type function kind signature
+isTFunDecl (TyFunction {}) = True
+isTFunDecl other	   = False
+
+-- vanilla Haskell type synonym
+isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
+isSynDecl other		                    = False
 
-isSynDecl (TySynonym {}) = True
-isSynDecl other		 = False
+-- type equation (of a type function)
+isTEqnDecl (TySynonym {tcdTyPats = Just _}) = True
+isTEqnDecl other		            = False
 
 isDataDecl (TyData {}) = True
 isDataDecl other       = False
@@ -408,8 +425,11 @@ tyClDeclNames :: Eq name => TyClDecl name -> [Located name]
 -- For record fields, the first one counts as the SrcLoc
 -- We use the equality to filter out duplicate field names
 
-tyClDeclNames (TySynonym   {tcdLName = name})  = [name]
-tyClDeclNames (ForeignType {tcdLName = name})  = [name]
+tyClDeclNames (TyFunction  {tcdLName = name})    = [name]
+tyClDeclNames (TySynonym   {tcdLName = name,
+			    tcdTyPats= Nothing}) = [name]
+tyClDeclNames (TySynonym   {}                  ) = []     -- type equation
+tyClDeclNames (ForeignType {tcdLName = name})    = [name]
 
 tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats})
   = cls_name : 
@@ -418,18 +438,22 @@ tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats})
 tyClDeclNames (TyData {tcdLName = tc_name, tcdCons = cons})
   = tc_name : conDeclsNames (map unLoc cons)
 
-tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
-tyClDeclTyVars (TyData    {tcdTyVars = tvs}) = tvs
-tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
-tyClDeclTyVars (ForeignType {})		     = []
+tyClDeclTyVars (TyFunction  {tcdTyVars = tvs}) = tvs
+tyClDeclTyVars (TySynonym   {tcdTyVars = tvs}) = tvs
+tyClDeclTyVars (TyData      {tcdTyVars = tvs}) = tvs
+tyClDeclTyVars (ClassDecl   {tcdTyVars = tvs}) = tvs
+tyClDeclTyVars (ForeignType {})		       = []
 \end{code}
 
 \begin{code}
-countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int)
-	-- class, data, newtype, synonym decls
+countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
+	-- class, synonym decls, type function signatures,
+	-- type function equations, data, newtype
 countTyClDecls decls 
  = (count isClassDecl     decls,
     count isSynDecl       decls,
+    count isTFunDecl      decls,
+    count isTEqnDecl      decls,
     count isDataTy        decls,
     count isNewTy         decls) 
  where
@@ -447,8 +471,22 @@ instance OutputableBndr name
     ppr (ForeignType {tcdLName = ltycon})
 	= hsep [ptext SLIT("foreign import type dotnet"), ppr ltycon]
 
-    ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdSynRhs = mono_ty})
-      = hang (ptext SLIT("type") <+> pp_decl_head [] ltycon tyvars Nothing <+> equals)
+    ppr (TyFunction {tcdLName = ltycon, tcdTyVars = tyvars, tcdIso = iso, 
+		     tcdKindSig = mb_sig})
+      = typeMaybeIso <+> pp_decl_head [] ltycon tyvars Nothing <+> 
+	ppr_sig mb_sig
+        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 <+> 
+	      equals)
 	     4 (ppr mono_ty)
 
     ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,