X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FTyCon.lhs;h=7d114820c206acefb6d2dd09ab183adf8d3843d2;hb=34429d31b0d48352e4ffd29186e919b6248cdd5c;hp=9aa0fe56905521090b09792872513e51ff781e9a;hpb=fb6249251d425b076c47013e5cf5c849cac31b46;p=ghc-hetmet.git

diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index 9aa0fe5..7d11482 100644
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -6,6 +6,13 @@
 The @TyCon@ datatype
 
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module TyCon(
 	TyCon, FieldLabel,
 
@@ -18,12 +25,15 @@ module TyCon(
 	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,
-	isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo_maybe,
+	isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConEtadRhs, newTyConCo_maybe,
 	isHiBootTyCon, isSuperKindTyCon,
         isCoercionTyCon_maybe, isCoercionTyCon,
         isImplicitTyCon,
@@ -240,10 +250,14 @@ data AlgTyConRhs
 				--  = the representation type of the tycon
 				-- The free tyvars of this type are the tyConTyVars
       
-        nt_co :: Maybe TyCon,   -- The coercion used to create the newtype
+        nt_co :: Maybe TyCon,   -- A CoercionTyCon used to create the newtype
                                 -- from the representation
-                                -- optional for non-recursive newtypes
+                                -- Optional for non-recursive newtypes
 				-- See Note [Newtype coercions]
+				-- Invariant: arity = #tvs in nt_etad_rhs;
+				--	See Note [Newtype eta]
+				-- Watch out!  If any newtypes become transparent
+				-- again check Trac #1072.
 
 	nt_etad_rhs :: ([TyVar], Type) ,
 			-- The same again, but this time eta-reduced
@@ -323,7 +337,6 @@ data SynTyConRhs
 
 Note [Newtype coercions]
 ~~~~~~~~~~~~~~~~~~~~~~~~
-
 The NewTyCon field nt_co is a a TyCon (a coercion constructor in fact)
 which is used for coercing from the representation type of the
 newtype, to the newtype itself. For example,
@@ -387,6 +400,14 @@ we get:
 	w2 = w1
 And now Lint complains unless Foo T == Foo [], and that requires T==[]
 
+This point carries over to the newtype coercion, because we need to
+say 
+	w2 = w1 `cast` Foo CoT
+
+so the coercion tycon CoT must have 
+	kind:    T ~ []
+ and	arity:   0
+
 
 Note [Indexed data types] (aka data type families)
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -456,6 +477,7 @@ data PrimRep
   | AddrRep		-- a pointer, but not to a Haskell value
   | FloatRep
   | DoubleRep
+  deriving( Eq )
 
 -- Size of a PrimRep, in bytes
 sizeofPrimRep :: PrimRep -> Int
@@ -642,19 +664,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
@@ -684,6 +702,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
@@ -796,7 +817,7 @@ tcExpandTyCon_maybe, coreExpandTyCon_maybe
 		  Type,			-- Body type (not yet substituted)
 		  [Type])		-- Leftover args
 
--- For the *typechecker* view, we expand synonyms only
+-- For the *typechecker* view, we expand (closed) synonyms only
 tcExpandTyCon_maybe (SynTyCon {tyConTyVars = tvs, 
 			       synTcRhs = SynonymTyCon rhs }) tys
    = expand tvs rhs tys
@@ -869,6 +890,10 @@ newTyConRhs :: TyCon -> ([TyVar], Type)
 newTyConRhs (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rhs = rhs }}) = (tvs, rhs)
 newTyConRhs tycon = pprPanic "newTyConRhs" (ppr tycon)
 
+newTyConEtadRhs :: TyCon -> ([TyVar], Type)
+newTyConEtadRhs (AlgTyCon {algTcRhs = NewTyCon { nt_etad_rhs = tvs_rhs }}) = tvs_rhs
+newTyConEtadRhs tycon = pprPanic "newTyConEtadRhs" (ppr tycon)
+
 newTyConRep :: TyCon -> ([TyVar], Type)
 newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rep = rep }}) = (tvs, rep)
 newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon)