Monadify specialise/Specialise: use do, return, standard monad functions and MonadUnique
[ghc-hetmet.git] / compiler / types / TyCon.lhs
index 90ac71c..c495ebb 100644 (file)
@@ -6,23 +6,34 @@
 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,
 
        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,
-       isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo_maybe,
+       isRecursiveTyCon, newTyConRhs, newTyConEtadRhs, newTyConCo_maybe,
        isHiBootTyCon, isSuperKindTyCon,
         isCoercionTyCon_maybe, isCoercionTyCon,
         isImplicitTyCon,
@@ -76,6 +87,7 @@ import PrelNames
 import Maybes
 import Outputable
 import FastString
+import Constants
 \end{code}
 
 %************************************************************************
@@ -213,16 +225,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 {
@@ -241,31 +250,20 @@ 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) ,
+       nt_etad_rhs :: ([TyVar], Type)
                        -- The same again, but this time eta-reduced
                        -- hence the [TyVar] which may be shorter than the declared 
                        -- arity of the TyCon.  See Note [Newtype eta]
-
-       nt_rep :: Type  -- Cached: the *ultimate* representation type
-                       -- By 'ultimate' I mean that the top-level constructor
-                       -- of the rep type is not itself a newtype or type synonym.
-                       -- The rep type isn't entirely simple:
-                       --  for a recursive newtype we pick () as the rep type
-                       --      newtype T = MkT T
-                       -- 
-                       -- This one does not need to be eta reduced; hence its
-                       -- free type variables are conveniently tyConTyVars
-                       -- Thus:
-                       --      newtype T a = MkT [(a,Int)]
-                       -- The rep type is [(a,Int)]
-                       -- NB: the rep type isn't necessarily the original RHS of the
-                       --     newtype decl, because the rep type looks through other
-    }                  --     newtypes.
+    }
 
 visibleDataCons :: AlgTyConRhs -> [DataCon]
 visibleDataCons AbstractTyCon                = []
@@ -324,7 +322,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,
@@ -388,6 +385,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)
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -457,6 +462,19 @@ data PrimRep
   | AddrRep            -- a pointer, but not to a Haskell value
   | FloatRep
   | DoubleRep
+  deriving( Eq )
+
+-- 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}
 
 %************************************************************************
@@ -631,20 +649,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
@@ -674,6 +687,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
@@ -786,7 +802,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
@@ -840,9 +856,7 @@ tyConFamilySize (AlgTyCon   {algTcRhs = DataTyCon {data_cons = cons}}) =
 tyConFamilySize (AlgTyCon   {algTcRhs = NewTyCon {}})                  = 1
 tyConFamilySize (AlgTyCon   {algTcRhs = OpenTyCon {}})                 = 0
 tyConFamilySize (TupleTyCon {})                                               = 1
-#ifdef DEBUG
 tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
-#endif
 
 tyConSelIds :: TyCon -> [Id]
 tyConSelIds (AlgTyCon {algTcSelIds = fs}) = fs
@@ -859,9 +873,9 @@ newTyConRhs :: TyCon -> ([TyVar], Type)
 newTyConRhs (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rhs = rhs }}) = (tvs, rhs)
 newTyConRhs tycon = pprPanic "newTyConRhs" (ppr tycon)
 
-newTyConRep :: TyCon -> ([TyVar], Type)
-newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rep = rep }}) = (tvs, rep)
-newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon)
+newTyConEtadRhs :: TyCon -> ([TyVar], Type)
+newTyConEtadRhs (AlgTyCon {algTcRhs = NewTyCon { nt_etad_rhs = tvs_rhs }}) = tvs_rhs
+newTyConEtadRhs tycon = pprPanic "newTyConEtadRhs" (ppr tycon)
 
 newTyConCo_maybe :: TyCon -> Maybe TyCon
 newTyConCo_maybe (AlgTyCon {algTcRhs = NewTyCon { nt_co = co }}) = co