X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypes%2FType.lhs;h=c7e5fa250901254842eab866d7a2e7d0edde5851;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=5cf242c4050c0321ca23a50afcc732ad6e277ce6;hpb=f714e6b642fd614a9971717045ae47c3d871275e;p=ghc-hetmet.git

diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs
index 5cf242c..c7e5fa2 100644
--- a/ghc/compiler/types/Type.lhs
+++ b/ghc/compiler/types/Type.lhs
@@ -12,6 +12,8 @@ module Type (
 	-- Re-exports from Kind
 	module Kind,
 
+	-- Re-exports from TyCon
+	PrimRep(..),
 
 	mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, isTyVarTy,
 
@@ -84,16 +86,14 @@ import Name	( NamedThing(..), mkInternalName, tidyOccName )
 import Class	( Class, classTyCon )
 import TyCon	( TyCon, isRecursiveTyCon, isPrimTyCon,
 		  isUnboxedTupleTyCon, isUnLiftedTyCon,
-		  isFunTyCon, isNewTyCon, newTyConRep,
+		  isFunTyCon, isNewTyCon, newTyConRep, newTyConRhs,
 		  isAlgTyCon, isSynTyCon, tyConArity, 
-	          tyConKind, getSynTyConDefn,
-		  tyConPrimRep, 
+	          tyConKind, getSynTyConDefn, PrimRep(..), tyConPrimRep,
 		)
 
 -- others
 import CmdLineOpts	( opt_DictsStrict )
 import SrcLoc		( noSrcLoc )
-import PrimRep		( PrimRep(..) )
 import Unique		( Uniquable(..) )
 import Util		( mapAccumL, seqList, lengthIs, snocView )
 import Outputable
@@ -391,15 +391,27 @@ repType (NewTcApp tc tys) = ASSERT( tys `lengthIs` tyConArity tc )
 repType ty	 	  = ty
 
 
+-- ToDo: this could be moved to the code generator, using splitTyConApp instead
+-- of inspecting the type directly.
 typePrimRep :: Type -> PrimRep
 typePrimRep ty = case repType ty of
 		   TyConApp tc _ -> tyConPrimRep tc
 		   FunTy _ _	 -> PtrRep
-		   AppTy _ _	 -> PtrRep	-- ??
+		   AppTy _ _	 -> PtrRep	-- See note below
 		   TyVarTy _	 -> PtrRep
 		   other	 -> pprPanic "typePrimRep" (ppr ty)
-\end{code}
+	-- Types of the form 'f a' must be of kind *, not *#, so
+	-- we are guaranteed that they are represented by pointers.
+	-- The reason is that f must have kind *->*, not *->*#, because
+	-- (we claim) there is no way to constrain f's kind any other
+	-- way.
 
+-- new_type_rep doesn't ask any questions: 
+-- it just expands newtype, whether recursive or not
+new_type_rep new_tycon tys = ASSERT( tys `lengthIs` tyConArity new_tycon )
+			     case newTyConRep new_tycon of
+				 (tvs, rep_ty) -> substTyWith tvs tys rep_ty
+\end{code}
 
 
 ---------------------------------------------------------------------
@@ -512,6 +524,8 @@ mkPredTys preds = map PredTy preds
 predTypeRep :: PredType -> Type
 -- Convert a PredType to its "representation type";
 -- the post-type-checking type used by all the Core passes of GHC.
+-- Unwraps only the outermost level; for example, the result might
+-- be a NewTcApp; c.f. newTypeRep
 predTypeRep (IParam _ ty)     = ty
 predTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
 	-- Result might be a NewTcApp, but the consumer will
@@ -529,23 +543,33 @@ predTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
 splitRecNewType_maybe :: Type -> Maybe Type
 -- Newtypes are always represented by a NewTcApp
 -- Sometimes we want to look through a recursive newtype, and that's what happens here
+-- It only strips *one layer* off, so the caller will usually call itself recursively
 -- Only applied to types of kind *, hence the newtype is always saturated
 splitRecNewType_maybe (NoteTy _ ty) = splitRecNewType_maybe ty  
+splitRecNewType_maybe (PredTy p)    = splitRecNewType_maybe (predTypeRep p)
 splitRecNewType_maybe (NewTcApp tc tys)
   | isRecursiveTyCon tc
   = ASSERT( tys `lengthIs` tyConArity tc && isNewTyCon tc )
-	-- The assert should hold because repType should
-	-- only be applied to *types* (of kind *)
-    Just (new_type_rep tc tys)
+	-- The assert should hold because splitRecNewType_maybe
+	-- should only be applied to *types* (of kind *)
+    Just (new_type_rhs tc tys)
 splitRecNewType_maybe other = Nothing
 			
 -----------------------------
 newTypeRep :: TyCon -> [Type] -> Type
 -- A local helper function (not exported)
--- Expands a newtype application to 
+-- Expands *the outermoset level of* a newtype application to 
 --	*either* a vanilla TyConApp (recursive newtype, or non-saturated)
---	*or*     the newtype representation (otherwise)
--- Either way, the result is not a NewTcApp
+--	*or*     the newtype representation (otherwise), meaning the
+--			type written in the RHS of the newtype decl,
+--			which may itself be a newtype
+--
+-- Example: newtype R = MkR S
+--	    newtype S = MkS T
+--	    newtype T = MkT (T -> T)
+--   newTypeRep on R gives NewTcApp S
+--		on S gives NewTcApp T
+--		on T gives TyConApp T
 --
 -- NB: the returned TyConApp is always deconstructed immediately by the 
 --     caller... a TyConApp with a newtype type constructor never lives
@@ -553,17 +577,16 @@ newTypeRep :: TyCon -> [Type] -> Type
 newTypeRep tc tys
   | not (isRecursiveTyCon tc),		-- Not recursive and saturated
     tys `lengthIs` tyConArity tc 	-- treat as equivalent to expansion
-  = new_type_rep tc tys
+  = new_type_rhs tc tys
   | otherwise
   = TyConApp tc tys
 	-- ToDo: Consider caching this substitution in a NType
 
-----------------------------
--- new_type_rep doesn't ask any questions: 
--- it just expands newtype, whether recursive or not
-new_type_rep new_tycon tys = ASSERT( tys `lengthIs` tyConArity new_tycon )
-			     case newTyConRep new_tycon of
-				 (tvs, rep_ty) -> substTyWith tvs tys rep_ty
+-- new_type_rhs doesn't ask any questions: 
+-- it just expands newtype one level, whether recursive or not
+new_type_rhs tc tys 
+  = case newTyConRhs tc of
+	(tvs, rep_ty) -> substTyWith tvs tys rep_ty
 \end{code}