X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FTyCon.lhs;h=1471f57c5403b62e4bb36c681011f93ce2eb14e1;hb=474b582b68ea9289f3da4355da816164138604b0;hp=85881b695e9524a2eafba4478745722a145fa3b3;hpb=6777144f7522d8db5935737e12fa451ca3211e6d;p=ghc-hetmet.git

diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index 85881b6..1471f57 100644
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -11,14 +11,17 @@ module TyCon(
 
 	PrimRep(..),
 	tyConPrimRep,
+        sizeofPrimRep,
 
 	AlgTyConRhs(..), visibleDataCons, 
         TyConParent(..), 
 	SynTyConRhs(..),
 
 	isFunTyCon, isUnLiftedTyCon, isProductTyCon, 
-	isAlgTyCon, isDataTyCon, isNewTyCon, isClosedNewTyCon, isSynTyCon,
-	isClosedSynTyCon, isPrimTyCon, 
+	isAlgTyCon, isDataTyCon, 
+	isNewTyCon, unwrapNewTyCon_maybe, 
+	isSynTyCon, isClosedSynTyCon, 
+	isPrimTyCon, 
 	isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon,
 	assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss,
 	isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
@@ -76,6 +79,7 @@ import PrelNames
 import Maybes
 import Outputable
 import FastString
+import Constants
 \end{code}
 
 %************************************************************************
@@ -454,6 +458,18 @@ data PrimRep
   | AddrRep		-- a pointer, but not to a Haskell value
   | FloatRep
   | DoubleRep
+
+-- Size of a PrimRep, in bytes
+sizeofPrimRep :: PrimRep -> Int
+sizeofPrimRep IntRep   = wORD_SIZE
+sizeofPrimRep WordRep  = wORD_SIZE
+sizeofPrimRep Int64Rep = wORD64_SIZE
+sizeofPrimRep Word64Rep= wORD64_SIZE
+sizeofPrimRep FloatRep = 4
+sizeofPrimRep DoubleRep= 8
+sizeofPrimRep AddrRep  = wORD_SIZE
+sizeofPrimRep PtrRep   = wORD_SIZE
+sizeofPrimRep VoidRep  = 0
 \end{code}
 
 %************************************************************************
@@ -628,19 +644,15 @@ isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
 isDataTyCon other = False
 
 isNewTyCon :: TyCon -> Bool
-isNewTyCon (AlgTyCon {algTcRhs = rhs}) = 
-  case rhs of
-    NewTyCon {}  -> True
-    _	         -> False
-isNewTyCon other		       = False
-
--- This is an important refinement as typical newtype optimisations do *not*
--- hold for newtype families.  Why?  Given a type `T a', if T is a newtype
--- family, there is no unique right hand side by which `T a' can be replaced
--- by a cast.
---
-isClosedNewTyCon :: TyCon -> Bool
-isClosedNewTyCon tycon = isNewTyCon tycon && not (isOpenTyCon tycon)
+isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True
+isNewTyCon other		               = False
+
+unwrapNewTyCon_maybe :: TyCon -> Maybe ([TyVar], Type, Maybe TyCon)
+unwrapNewTyCon_maybe (AlgTyCon { tyConTyVars = tvs, 
+				 algTcRhs = NewTyCon { nt_co = mb_co, 
+						       nt_rhs = rhs }})
+			   = Just (tvs, rhs, mb_co)
+unwrapNewTyCon_maybe other = Nothing
 
 isProductTyCon :: TyCon -> Bool
 -- A "product" tycon