X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Ftypes%2FTyCon.lhs;h=3a8209987aad9aafeece9264e0889e3d45c15a05;hb=5822cb8d13aa3c05d2b46b4510c13d94b902eb21;hp=50d76cf63c248034440368dd6b70d7c5ff035488;hpb=683a26900e9170ba57c561a2dc94a3a4eb38cfdf;p=ghc-hetmet.git

diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index 50d76cf..3a82099 100644
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -11,14 +11,18 @@ 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, isOpenSynTyCon,
+	isPrimTyCon, 
+
 	isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon,
 	assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss,
 	isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
@@ -76,6 +80,7 @@ import PrelNames
 import Maybes
 import Outputable
 import FastString
+import Constants
 \end{code}
 
 %************************************************************************
@@ -213,16 +218,13 @@ data AlgTyConRhs
 
   | OpenTyCon {
 
-      otArgPoss   :: Maybe [Int],  
+      otArgPoss   :: Maybe [Int]
 	-- Nothing <=> top-level indexed type family
 	-- Just ns <=> associated (not toplevel) family
 	--   In the latter case, for each tyvar in the AT decl, 'ns' gives the
 	--   position of that tyvar in the class argument list (starting from 0).
 	--   NB: Length is less than tyConArity iff higher kind signature.
 	
-      otIsNewtype :: Bool	     
-        -- is a newtype (rather than data type)?
-
     }
 
   | DataTyCon {
@@ -457,6 +459,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}
 
 %************************************************************************
@@ -616,9 +630,14 @@ isDataTyCon :: TyCon -> Bool
 --	True for all @data@ types
 --	False for newtypes
 --		  unboxed tuples
+--		  type families
+-- 
+-- NB: for a data type family, T, only the *instance* tycons are
+--     get an info table etc.  The family tycon does not.
+--     Hence False for OpenTyCon
 isDataTyCon tc@(AlgTyCon {algTcRhs = rhs})  
   = case rhs of
-        OpenTyCon {}  -> not (otIsNewtype rhs)
+        OpenTyCon {}  -> False
 	DataTyCon {}  -> True
 	NewTyCon {}   -> False
 	AbstractTyCon -> False	 -- We don't know, so return False
@@ -626,20 +645,15 @@ isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
 isDataTyCon other = False
 
 isNewTyCon :: TyCon -> Bool
-isNewTyCon (AlgTyCon {algTcRhs = rhs}) = 
-  case rhs of
-    OpenTyCon {} -> otIsNewtype rhs
-    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
@@ -669,6 +683,9 @@ isSynTyCon _		 = False
 isClosedSynTyCon :: TyCon -> Bool
 isClosedSynTyCon tycon = isSynTyCon tycon && not (isOpenTyCon tycon)
 
+isOpenSynTyCon :: TyCon -> Bool
+isOpenSynTyCon tycon = isSynTyCon tycon && isOpenTyCon tycon
+
 isGadtSyntaxTyCon :: TyCon -> Bool
 isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res
 isGadtSyntaxTyCon other				       = False