Substantial improvements to coercion optimisation
[ghc-hetmet.git] / compiler / types / TyCon.lhs
index befc4e6..0959699 100644 (file)
@@ -8,11 +8,12 @@ The @TyCon@ datatype
 \begin{code}
 module TyCon(
         -- * Main TyCon data types
-       TyCon, FieldLabel,
+       TyCon, FieldLabel, 
 
        AlgTyConRhs(..), visibleDataCons, 
         TyConParent(..), 
        SynTyConRhs(..),
+        CoTyConDesc(..),
        AssocFamilyPermutation,
 
         -- ** Constructing TyCons
@@ -20,13 +21,14 @@ module TyCon(
        mkClassTyCon,
        mkFunTyCon,
        mkPrimTyCon,
-       mkVoidPrimTyCon,
+       mkKindTyCon,
        mkLiftedPrimTyCon,
        mkTupleTyCon,
        mkSynTyCon,
         mkSuperKindTyCon,
         mkCoercionTyCon,
         mkForeignTyCon,
+        mkAnyTyCon,
 
         -- ** Predicates on TyCons
         isAlgTyCon,
@@ -35,9 +37,9 @@ module TyCon(
         isPrimTyCon,
         isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, 
         isSynTyCon, isClosedSynTyCon, isOpenSynTyCon,
-        isSuperKindTyCon,
+        isSuperKindTyCon, isDecomposableTyCon,
         isCoercionTyCon, isCoercionTyCon_maybe,
-        isForeignTyCon,
+        isForeignTyCon, isAnyTyCon, tyConHasKind,
 
        isInjectiveTyCon,
        isDataTyCon, isProductTyCon, isEnumerationTyCon, 
@@ -103,7 +105,7 @@ import Data.List( elemIndex )
 %************************************************************************
 
 \begin{code}
--- | Represents type constructors. Type constructors are introduced by things such as:
+-- | TyCons represent type constructors. Type constructors are introduced by things such as:
 --
 -- 1) Data declarations: @data Foo = ...@ creates the @Foo@ type constructor of kind @*@
 --
@@ -123,7 +125,7 @@ data TyCon
     FunTyCon {
        tyConUnique :: Unique,
        tyConName   :: Name,
-       tyConKind   :: Kind,
+       tc_kind   :: Kind,
        tyConArity  :: Arity
     }
 
@@ -132,7 +134,7 @@ data TyCon
   | AlgTyCon {         
        tyConUnique :: Unique,
        tyConName   :: Name,
-       tyConKind   :: Kind,
+       tc_kind   :: Kind,
        tyConArity  :: Arity,
 
        tyConTyVars :: [TyVar],         -- ^ The type variables used in the type constructor.
@@ -150,6 +152,7 @@ data TyCon
                                        -- that doesn't mean it's a true GADT; only that the "where"
                                        --      form was used. This field is used only to guide
                                        --      pretty-printing
+
        algTcStupidTheta :: [PredType], -- ^ The \"stupid theta\" for the data type (always empty for GADTs).
                                        -- A \"stupid theta\" is the context to the left of an algebraic type
                                        -- declaration, e.g. @Eq a@ in the declaration @data Eq a => T a ...@.
@@ -169,7 +172,7 @@ data TyCon
   | TupleTyCon {
        tyConUnique :: Unique,
        tyConName   :: Name,
-       tyConKind   :: Kind,
+       tc_kind   :: Kind,
        tyConArity  :: Arity,
        tyConBoxed  :: Boxity,
        tyConTyVars :: [TyVar],
@@ -181,7 +184,7 @@ data TyCon
   | SynTyCon {
        tyConUnique  :: Unique,
        tyConName    :: Name,
-       tyConKind    :: Kind,
+       tc_kind    :: Kind,
        tyConArity   :: Arity,
 
        tyConTyVars  :: [TyVar],        -- Bound tyvars
@@ -197,33 +200,44 @@ data TyCon
   | PrimTyCon {                        
        tyConUnique   :: Unique,
        tyConName     :: Name,
-       tyConKind     :: Kind,
-       tyConArity    :: Arity,         -- SLPJ Oct06: I'm not sure what the significance
-                                       --             of the arity of a primtycon is!
-
-       primTyConRep  :: PrimRep,
-                       -- ^ Many primitive tycons are unboxed, but some are
-                       -- boxed (represented by pointers). This 'PrimRep' holds
-                       -- that information
-
-       isUnLifted   :: Bool,           -- ^ Most primitive tycons are unlifted (may not contain bottom)
-                                       -- but foreign-imported ones may be lifted
-       tyConExtName :: Maybe FastString        -- ^ @Just e@ for foreign-imported types, holds the name of the imported thing
+       tc_kind       :: Kind,
+       tyConArity    :: Arity,                 -- SLPJ Oct06: I'm not sure what the significance
+                                               --             of the arity of a primtycon is!
+
+       primTyConRep  :: PrimRep,               -- ^ Many primitive tycons are unboxed, but some are
+                                                       --   boxed (represented by pointers). This 'PrimRep' holds
+                                               --   that information.
+                                               -- Only relevant if tc_kind = *
+
+       isUnLifted   :: Bool,                   -- ^ Most primitive tycons are unlifted (may not contain bottom)
+                                               --   but foreign-imported ones may be lifted
+
+       tyConExtName :: Maybe FastString        -- ^ @Just e@ for foreign-imported types, 
+                                                --   holds the name of the imported thing
     }
 
   -- | Type coercions, such as @(~)@, @sym@, @trans@, @left@ and @right@.
-  -- INVARIANT: coercions are always fully applied
-  | CoercionTyCon {    
+  -- INVARIANT: Coercion TyCons are always fully applied
+  --           But note that a CoTyCon can be *over*-saturated in a type.
+  --           E.g.  (sym g1) Int  will be represented as (TyConApp sym [g1,Int])
+  | CoTyCon {  
        tyConUnique :: Unique,
         tyConName   :: Name,
        tyConArity  :: Arity,
-       coKindFun   :: [Type] -> (Type,Type)
-               -- ^ Function that when given a list of the type arguments to the 'TyCon'
-               -- constructs the types that the resulting coercion relates.
-               --
-               -- INVARIANT: 'coKindFun' is always applied to exactly 'tyConArity' args
-               -- E.g. for @trans (c1 :: ta=tb) (c2 :: tb=tc)@, the 'coKindFun' returns 
-               --      the kind as a pair of types: @(ta, tc)@
+       coTcDesc    :: CoTyConDesc
+    }
+
+  -- | Any types.  Like tuples, this is a potentially-infinite family of TyCons
+  --   one for each distinct Kind. They have no values at all.
+  --   Because there are infinitely many of them (like tuples) they are 
+  --   defined in GHC.Prim and have names like "Any(*->*)".  
+  --   Their Unique is derived from the OccName.
+  -- See Note [Any types] in TysPrim
+  | AnyTyCon {
+       tyConUnique  :: Unique,
+       tyConName    :: Name,
+       tc_kind    :: Kind      -- Never = *; that is done via PrimTyCon
+                               -- See Note [Any types] in TysPrim
     }
 
   -- | Super-kinds. These are "kinds-of-kinds" and are never seen in Haskell source programs.
@@ -294,7 +308,7 @@ data AlgTyConRhs
                        
                        -- See Note [Newtype eta]
       
-        nt_co :: Maybe TyCon   -- ^ A 'TyCon' (which is always a 'CoercionTyCon') that can have a 'Coercion' 
+        nt_co :: Maybe TyCon   -- ^ A 'TyCon' (which is always a 'CoTyCon') that can have a 'Coercion' 
                                 -- extracted from it to create the @newtype@ from the representation 'Type'.
                                 --
                                 -- This field is optional for non-recursive @newtype@s only.
@@ -347,7 +361,7 @@ data TyConParent
   --  of the current 'TyCon' (not the family one). INVARIANT: 
   --  the number of types matches the arity of the family 'TyCon'
   --
-  --  3) A 'CoercionTyCon' identifying the representation
+  --  3) A 'CoTyCon' identifying the representation
   --  type with the type instance family
   | FamilyTyCon
        TyCon
@@ -379,6 +393,20 @@ data SynTyConRhs
   | SynonymTyCon Type   -- ^ The synonym mentions head type variables. It acts as a
                        -- template for the expansion when the 'TyCon' is applied to some
                        -- types.
+
+--------------------
+data CoTyConDesc
+  = CoSym   | CoTrans
+  | CoLeft  | CoRight
+  | CoCsel1 | CoCsel2 | CoCselR
+  | CoInst
+
+  | CoAxiom    -- C tvs : F lhs-tys ~ rhs-ty
+      { co_ax_tvs :: [TyVar]
+      , co_ax_lhs :: Type
+      , co_ax_rhs :: Type }
+
+  | CoUnsafe 
 \end{code}
 
 Note [Newtype coercions]
@@ -390,7 +418,7 @@ newtype, to the newtype itself. For example,
    newtype T a = MkT (a -> a)
 
 the NewTyCon for T will contain nt_co = CoT where CoT t : T t ~ t ->
-t.  This TyCon is a CoercionTyCon, so it does not have a kind on its
+t.  This TyCon is a CoTyCon, so it does not have a kind on its
 own; it basically has its own typing rule for the fully-applied
 version.  If the newtype T has k type variables then CoT has arity at
 most k.  In the case that the right hand side is a type application
@@ -408,7 +436,7 @@ and then when we used CoT at a particular type, s, we'd say
        CoT @ s
 which encodes as (TyConApp instCoercionTyCon [TyConApp CoT [], s])
 
-But in GHC we instead make CoT into a new piece of type syntax, CoercionTyCon,
+But in GHC we instead make CoT into a new piece of type syntax, CoTyCon,
 (like instCoercionTyCon, symCoercionTyCon etc), which must always
 be saturated, but which encodes as
        TyConApp CoT [s]
@@ -495,7 +523,7 @@ Then
 %************************************************************************
 
 A PrimRep is somewhat similar to a CgRep (see codeGen/SMRep) and a
-MachRep (see cmm/MachOp), although each of these types has a distinct
+MachRep (see cmm/CmmExpr), although each of these types has a distinct
 and clearly defined purpose:
 
   - A PrimRep is a CgRep + information about signedness + information
@@ -561,7 +589,7 @@ mkFunTyCon name kind
   = FunTyCon { 
        tyConUnique = nameUnique name,
        tyConName   = name,
-       tyConKind   = kind,
+       tc_kind   = kind,
        tyConArity  = 2
     }
 
@@ -581,7 +609,7 @@ mkAlgTyCon name kind tyvars stupid rhs parent is_rec gen_info gadt_syn
   = AlgTyCon { 
        tyConName        = name,
        tyConUnique      = nameUnique name,
-       tyConKind        = kind,
+       tc_kind  = kind,
        tyConArity       = length tyvars,
        tyConTyVars      = tyvars,
        algTcStupidTheta = stupid,
@@ -609,7 +637,7 @@ mkTupleTyCon name kind arity tyvars con boxed gen_info
   = TupleTyCon {
        tyConUnique = nameUnique name,
        tyConName = name,
-       tyConKind = kind,
+       tc_kind = kind,
        tyConArity = arity,
        tyConBoxed = boxed,
        tyConTyVars = tyvars,
@@ -630,7 +658,7 @@ mkForeignTyCon name ext_name kind arity
   = PrimTyCon {
        tyConName    = name,
        tyConUnique  = nameUnique name,
-       tyConKind    = kind,
+       tc_kind    = kind,
        tyConArity   = arity,
        primTyConRep = PtrRep, -- they all do
        isUnLifted   = False,
@@ -643,10 +671,10 @@ mkPrimTyCon :: Name  -> Kind -> Arity -> PrimRep -> TyCon
 mkPrimTyCon name kind arity rep
   = mkPrimTyCon' name kind arity rep True  
 
--- | Create the special void 'TyCon' which is unlifted and has 'VoidRep'
-mkVoidPrimTyCon :: Name -> Kind -> Arity -> TyCon
-mkVoidPrimTyCon name kind arity 
-  = mkPrimTyCon' name kind arity VoidRep True  
+-- | Kind constructors
+mkKindTyCon :: Name -> Kind -> TyCon
+mkKindTyCon name kind
+  = mkPrimTyCon' name kind 0 VoidRep True  
 
 -- | Create a lifted primitive 'TyCon' such as @RealWorld@
 mkLiftedPrimTyCon :: Name  -> Kind -> Arity -> PrimRep -> TyCon
@@ -658,7 +686,7 @@ mkPrimTyCon' name kind arity rep is_unlifted
   = PrimTyCon {
        tyConName    = name,
        tyConUnique  = nameUnique name,
-       tyConKind    = kind,
+       tc_kind    = kind,
        tyConArity   = arity,
        primTyConRep = rep,
        isUnLifted   = is_unlifted,
@@ -671,7 +699,7 @@ mkSynTyCon name kind tyvars rhs parent
   = SynTyCon { 
        tyConName = name,
        tyConUnique = nameUnique name,
-       tyConKind = kind,
+       tc_kind = kind,
        tyConArity = length tyvars,
        tyConTyVars = tyvars,
        synTcRhs = rhs,
@@ -679,14 +707,21 @@ mkSynTyCon name kind tyvars rhs parent
     }
 
 -- | Create a coercion 'TyCon'
-mkCoercionTyCon :: Name -> Arity -> ([Type] -> (Type,Type)) -> TyCon
-mkCoercionTyCon name arity kindRule
-  = CoercionTyCon {
-        tyConName = name,
+mkCoercionTyCon :: Name -> Arity 
+                -> CoTyConDesc
+                -> TyCon
+mkCoercionTyCon name arity desc
+  = CoTyCon {
+        tyConName   = name,
         tyConUnique = nameUnique name,
-        tyConArity = arity,
-        coKindFun = kindRule
-    }
+        tyConArity  = arity,
+        coTcDesc    = desc }
+
+mkAnyTyCon :: Name -> Kind -> TyCon
+mkAnyTyCon name kind 
+  = AnyTyCon {  tyConName = name,
+               tc_kind = kind,
+               tyConUnique = nameUnique name }
 
 -- | Create a super-kind 'TyCon'
 mkSuperKindTyCon :: Name -> TyCon -- Super kinds always have arity zero
@@ -800,6 +835,13 @@ isClosedSynTyCon tycon = isSynTyCon tycon && not (isOpenTyCon tycon)
 isOpenSynTyCon :: TyCon -> Bool
 isOpenSynTyCon tycon = isSynTyCon tycon && isOpenTyCon tycon
 
+isDecomposableTyCon :: TyCon -> Bool
+-- True iff we can deocmpose (T a b c) into ((T a b) c)
+-- Specifically NOT true of synonyms (open and otherwise) and coercions
+isDecomposableTyCon (SynTyCon {}) = False
+isDecomposableTyCon (CoTyCon {})  = False
+isDecomposableTyCon _other        = True
+
 -- | Is this an algebraic 'TyCon' declared with the GADT syntax?
 isGadtSyntaxTyCon :: TyCon -> Bool
 isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res
@@ -808,6 +850,7 @@ isGadtSyntaxTyCon _                                    = False
 -- | Is this an algebraic 'TyCon' which is just an enumeration of values?
 isEnumerationTyCon :: TyCon -> Bool
 isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res
+isEnumerationTyCon (TupleTyCon {tyConArity = arity}) = arity == 0
 isEnumerationTyCon _                                                   = False
 
 -- | Is this a 'TyCon', synonym or otherwise, that may have further instances appear?
@@ -907,18 +950,23 @@ isSuperKindTyCon :: TyCon -> Bool
 isSuperKindTyCon (SuperKindTyCon {}) = True
 isSuperKindTyCon _                   = False
 
+-- | Is this an AnyTyCon?
+isAnyTyCon :: TyCon -> Bool
+isAnyTyCon (AnyTyCon {}) = True
+isAnyTyCon _              = False
+
 -- | Attempt to pull a 'TyCon' apart into the arity and 'coKindFun' of
 -- a coercion 'TyCon'. Returns @Nothing@ if the 'TyCon' is not of the
 -- appropriate kind
-isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, [Type] -> (Type,Type))
-isCoercionTyCon_maybe (CoercionTyCon {tyConArity = ar, coKindFun = rule}) 
-  = Just (ar, rule)
+isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, CoTyConDesc)
+isCoercionTyCon_maybe (CoTyCon {tyConArity = ar, coTcDesc = desc}) 
+  = Just (ar, desc)
 isCoercionTyCon_maybe _ = Nothing
 
 -- | Is this a 'TyCon' that represents a coercion?
 isCoercionTyCon :: TyCon -> Bool
-isCoercionTyCon (CoercionTyCon {}) = True
-isCoercionTyCon _                  = False
+isCoercionTyCon (CoTyCon {}) = True
+isCoercionTyCon _            = False
 
 -- | Identifies implicit tycons that, in particular, do not go into interface
 -- files (because they are implicitly reconstructed when the interface is
@@ -938,7 +986,7 @@ isImplicitTyCon tycon | isTyConAssoc tycon           = True
                                                       isTupleTyCon tycon
 isImplicitTyCon _other                               = True
         -- catches: FunTyCon, PrimTyCon, 
-        -- CoercionTyCon, SuperKindTyCon
+        -- CoTyCon, SuperKindTyCon
 \end{code}
 
 
@@ -995,6 +1043,20 @@ tyConHasGenerics (AlgTyCon {hasGenerics = hg})   = hg
 tyConHasGenerics (TupleTyCon {hasGenerics = hg}) = hg
 tyConHasGenerics _                               = False        -- Synonyms
 
+tyConKind :: TyCon -> Kind
+tyConKind (FunTyCon   { tc_kind = k }) = k
+tyConKind (AlgTyCon   { tc_kind = k }) = k
+tyConKind (TupleTyCon { tc_kind = k }) = k
+tyConKind (SynTyCon   { tc_kind = k }) = k
+tyConKind (PrimTyCon  { tc_kind = k }) = k
+tyConKind (AnyTyCon   { tc_kind = k }) = k
+tyConKind tc = pprPanic "tyConKind" (ppr tc)   -- SuperKindTyCon and CoTyCon
+
+tyConHasKind :: TyCon -> Bool
+tyConHasKind (SuperKindTyCon {}) = False
+tyConHasKind (CoTyCon {})        = False
+tyConHasKind _                   = True
+
 -- | As 'tyConDataCons_maybe', but returns the empty list of constructors if no constructors
 -- could be found
 tyConDataCons :: TyCon -> [DataCon]
@@ -1023,8 +1085,9 @@ tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
 -- | Extract an 'AlgTyConRhs' with information about data constructors from an algebraic or tuple
 -- 'TyCon'. Panics for any other sort of 'TyCon'
 algTyConRhs :: TyCon -> AlgTyConRhs
-algTyConRhs (AlgTyCon {algTcRhs = rhs})  = rhs
-algTyConRhs (TupleTyCon {dataCon = con}) = DataTyCon { data_cons = [con], is_enum = False }
+algTyConRhs (AlgTyCon {algTcRhs = rhs}) = rhs
+algTyConRhs (TupleTyCon {dataCon = con, tyConArity = arity})
+    = DataTyCon { data_cons = [con], is_enum = arity == 0 }
 algTyConRhs other = pprPanic "algTyConRhs" (ppr other)
 \end{code}
 
@@ -1097,13 +1160,10 @@ synTyConResKind tycon  = pprPanic "synTyConResKind" (ppr tycon)
 -- has more than one constructor, or represents a primitive or function type constructor then
 -- @Nothing@ is returned. In any other case, the function panics
 tyConSingleDataCon_maybe :: TyCon -> Maybe DataCon
-tyConSingleDataCon_maybe (AlgTyCon {algTcRhs = DataTyCon {data_cons = [c] }}) = Just c
-tyConSingleDataCon_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = c }})    = Just c
-tyConSingleDataCon_maybe (AlgTyCon {})          = Nothing
-tyConSingleDataCon_maybe (TupleTyCon {dataCon = con}) = Just con
-tyConSingleDataCon_maybe (PrimTyCon {})               = Nothing
-tyConSingleDataCon_maybe (FunTyCon {})                = Nothing  -- case at funty
-tyConSingleDataCon_maybe tc = pprPanic "tyConSingleDataCon_maybe: unexpected tycon " $ ppr tc
+tyConSingleDataCon_maybe (TupleTyCon {dataCon = c})                           = Just c
+tyConSingleDataCon_maybe (AlgTyCon {algTcRhs = DataTyCon { data_cons = [c] }}) = Just c
+tyConSingleDataCon_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = c }})     = Just c
+tyConSingleDataCon_maybe _                                                    = Nothing
 \end{code}
 
 \begin{code}
@@ -1174,6 +1234,18 @@ instance Ord TyCon where
 instance Uniquable TyCon where
     getUnique tc = tyConUnique tc
 
+instance Outputable CoTyConDesc where
+    ppr CoSym    = ptext (sLit "SYM")
+    ppr CoTrans  = ptext (sLit "TRANS")
+    ppr CoLeft   = ptext (sLit "LEFT")
+    ppr CoRight  = ptext (sLit "RIGHT")
+    ppr CoCsel1  = ptext (sLit "CSEL1")
+    ppr CoCsel2  = ptext (sLit "CSEL2")
+    ppr CoCselR  = ptext (sLit "CSELR")
+    ppr CoInst   = ptext (sLit "INST")
+    ppr CoUnsafe = ptext (sLit "UNSAFE")
+    ppr (CoAxiom {}) = ptext (sLit "AXIOM")
+
 instance Outputable TyCon where
     ppr tc  = ppr (getName tc)