X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypes%2FType.lhs;h=33d59baccce269a37b9408466934742e98bc16c1;hb=111cee3f1ad93816cb828e38b38521d85c3bcebb;hp=cba55fbcb6bfe9aa92332ad5fdd4a5ad35eb1c01;hpb=290e7896a6785ba5dcfbc7045438f382afd447ff;p=ghc-hetmet.git

diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs
index cba55fb..33d59ba 100644
--- a/ghc/compiler/types/Type.lhs
+++ b/ghc/compiler/types/Type.lhs
@@ -29,14 +29,16 @@ module Type (
 
 	mkAppTy, mkAppTys, splitAppTy, splitAppTys, splitAppTy_maybe,
 
-	mkFunTy, mkFunTys, splitFunTy_maybe, splitFunTys, splitFunTysN,
+	mkFunTy, mkFunTys, splitFunTy, splitFunTy_maybe, splitFunTys, splitFunTysN,
 	funResultTy, funArgTy, zipFunTys,
 
 	mkTyConApp, mkTyConTy, splitTyConApp_maybe,
 	splitAlgTyConApp_maybe, splitAlgTyConApp, 
 	mkDictTy, mkPredTy, splitPredTy_maybe, splitDictTy_maybe, isDictTy,
 
-	mkSynTy, isSynTy, deNoteType, repType, splitNewType_maybe,
+	mkSynTy, isSynTy, deNoteType, 
+
+	repType, splitRepFunTys, splitNewType_maybe, typePrimRep,
 
         UsageAnn(..), mkUsgTy, isUsgTy{- dont use -}, isNotUsgTy, splitUsgTy, unUsgTy, tyUsg,
         mkUsForAllTy, mkUsForAllTys, splitUsForAllTys, substUsTy,
@@ -52,7 +54,6 @@ module Type (
 
 	-- Lifting and boxity
 	isUnLiftedType, isUnboxedType, isUnboxedTupleType, isAlgType, isDataType, isNewType,
-	typePrimRep,
 
 	-- Free variables
 	tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
@@ -78,12 +79,12 @@ import TypeRep
 
 -- Other imports:
 
-import {-# SOURCE #-}	DataCon( DataCon, dataConType )
+import {-# SOURCE #-}	DataCon( DataCon, dataConRepType )
 import {-# SOURCE #-}	PprType( pprType, pprPred )	-- Only called in debug messages
 import {-# SOURCE #-}   Subst  ( mkTyVarSubst, substTy )
 
 -- friends:
-import Var	( TyVar, IdOrTyVar, UVar,
+import Var	( TyVar, Var, UVar,
 		  tyVarKind, tyVarName, setTyVarName, isId, idType,
 		)
 import VarEnv
@@ -235,6 +236,10 @@ mkFunTy arg res = FunTy arg res
 mkFunTys :: [Type] -> Type -> Type
 mkFunTys tys ty = foldr FunTy ty tys
 
+splitFunTy :: Type -> (Type, Type)
+splitFunTy (FunTy arg res) = (arg, res)
+splitFunTy (NoteTy _ ty)   = splitFunTy ty
+
 splitFunTy_maybe :: Type -> Maybe (Type, Type)
 splitFunTy_maybe (FunTy arg res) = Just (arg, res)
 splitFunTy_maybe (NoteTy _ ty)   = splitFunTy_maybe ty
@@ -418,6 +423,8 @@ The reason is that we then get better (shorter) type signatures in
 interfaces.  Notably this plays a role in tcTySigs in TcBinds.lhs.
 
 
+		Representation types
+		~~~~~~~~~~~~~~~~~~~~
 
 repType looks through 
 	(a) for-alls, and
@@ -432,6 +439,12 @@ repType (ForAllTy _ ty)   		  = repType ty
 repType (TyConApp tc tys) | isNewTyCon tc = repType (new_type_rep tc tys)
 repType other_ty	  		  = other_ty
 
+
+typePrimRep :: Type -> PrimRep
+typePrimRep ty = case splitTyConApp_maybe (repType ty) of
+		   Just (tc, ty_args) -> tyConPrimRep tc
+		   other	      -> PtrRep
+
 splitNewType_maybe :: Type -> Maybe Type
 -- Find the representation of a newtype, if it is one
 -- Looks through multiple levels of newtype
@@ -449,8 +462,15 @@ new_type_rep :: TyCon -> [Type] -> Type
 -- Looks through one layer only
 new_type_rep tc tys 
   = ASSERT( isNewTyCon tc )
-    case splitFunTy_maybe (applyTys (dataConType (head (tyConDataCons tc))) tys) of
+    case splitFunTy_maybe (applyTys (dataConRepType (head (tyConDataCons tc))) tys) of
 	Just (rep_ty, _) -> rep_ty
+
+splitRepFunTys :: Type -> ([Type], Type)
+-- Like splitFunTys, but looks through newtypes and for-alls
+splitRepFunTys ty = split [] (repType ty)
+  where
+    split args (FunTy arg res)  = split (arg:args) (repType res)
+    split args ty               = (reverse args, ty)
 \end{code}
 
 
@@ -609,7 +629,7 @@ splitForAllTys ty = case splitUsgTy_maybe ty of
 it is given a type variable or a term variable.
 
 \begin{code}
-mkPiType :: IdOrTyVar -> Type -> Type	-- The more polymorphic version doesn't work...
+mkPiType :: Var -> Type -> Type		-- The more polymorphic version doesn't work...
 mkPiType v ty | isId v    = mkFunTy (idType v) ty
 	      | otherwise = mkForAllTy v ty
 \end{code}
@@ -941,11 +961,6 @@ isNewType ty = case splitTyConApp_maybe ty of
 			Just (tc, ty_args) -> ASSERT( length ty_args == tyConArity tc )
 					      isNewTyCon tc
 			other		   -> False
-
-typePrimRep :: Type -> PrimRep
-typePrimRep ty = case splitTyConApp_maybe (repType ty) of
-		   Just (tc, ty_args) -> tyConPrimRep tc
-		   other	      -> PtrRep
 \end{code}