View patterns, record wildcards, and record puns

[ghc-hetmet.git] / compiler / basicTypes / DataCon.lhs

diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs
index b2e166b..0c6e3c5 100644 (file)
--- a/compiler/basicTypes/DataCon.lhs
+++ b/compiler/basicTypes/DataCon.lhs
@@ -10,11 +10,12 @@ module DataCon (
        ConTag, fIRST_TAG,
        mkDataCon,
        dataConRepType, dataConSig, dataConFullSig,
        ConTag, fIRST_TAG,
        mkDataCon,
        dataConRepType, dataConSig, dataConFullSig,

-       dataConName, dataConTag, dataConTyCon, dataConUserType,
-       dataConUnivTyVars, dataConExTyVars, dataConAllTyVars, dataConResTys,
-       dataConEqSpec, eqSpecPreds, dataConTheta, dataConStupidTheta, 
-       dataConInstArgTys, dataConOrigArgTys, 
-       dataConInstOrigArgTys, dataConRepArgTys, 
+       dataConName, dataConIdentity, dataConTag, dataConTyCon, dataConUserType,
+       dataConUnivTyVars, dataConExTyVars, dataConAllTyVars, 
+       dataConEqSpec, eqSpecPreds, dataConEqTheta, dataConDictTheta, dataConStupidTheta, 
+       dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
+       dataConInstOrigArgTys, dataConInstOrigDictsAndArgTys,
+       dataConRepArgTys, 

        dataConFieldLabels, dataConFieldType,
        dataConStrictMarks, dataConExStricts,
        dataConSourceArity, dataConRepArity,
        dataConFieldLabels, dataConFieldType,
        dataConStrictMarks, dataConExStricts,
        dataConSourceArity, dataConRepArity,

@@ -43,6 +44,11 @@ import ListSetOps
 import Util
 import Maybes
 import FastString
 import Util
 import Maybes
 import FastString

+import Module
+
+import Data.Char
+import Data.Word
+import Data.List ( partition )

 \end{code}
 
 
 \end{code}
 
 

@@ -81,15 +87,20 @@ differently, as follows.
 
 Note [Data Constructor Naming]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 Note [Data Constructor Naming]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

-Each data constructor C has two, and possibly three, Names associated with it:
+Each data constructor C has two, and possibly up to four, Names associated with it:

 
 

-                            OccName    Name space      Used for
+                            OccName    Name space      Name of

   ---------------------------------------------------------------------------
   ---------------------------------------------------------------------------

-  * The "source data con"      C       DataName        The DataCon itself
-  * The "real data con"                C       VarName         Its worker Id
-  * The "wrapper data con"     $WC     VarName         Wrapper Id (optional)
-
-Each of these three has a distinct Unique.  The "source data con" name
+  * The "data con itself"      C       DataName        DataCon
+  * The "worker data con"      C       VarName         Id (the worker)
+  * The "wrapper data con"     $WC     VarName         Id (the wrapper)
+  * The "newtype coercion"      :CoT    TcClsName      TyCon
+ 
+EVERY data constructor (incl for newtypes) has the former two (the
+data con itself, and its worker.  But only some data constructors have a
+wrapper (see Note [The need for a wrapper]).
+
+Each of these three has a distinct Unique.  The "data con itself" name

 appears in the output of the renamer, and names the Haskell-source
 data constructor.  The type checker translates it into either the wrapper Id
 (if it exists) or worker Id (otherwise).
 appears in the output of the renamer, and names the Haskell-source
 data constructor.  The type checker translates it into either the wrapper Id
 (if it exists) or worker Id (otherwise).

@@ -123,6 +134,8 @@ The "wrapper Id", $WC, goes as follows
   nothing for the wrapper to do.  That is, if its defn would be
        $wC = C
 
   nothing for the wrapper to do.  That is, if its defn would be
        $wC = C
 

+Note [The need for a wrapper]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

 Why might the wrapper have anything to do?  Two reasons:
 
 * Unboxing strict fields (with -funbox-strict-fields)
 Why might the wrapper have anything to do?  Two reasons:
 
 * Unboxing strict fields (with -funbox-strict-fields)

@@ -146,6 +159,8 @@ Why might the wrapper have anything to do?  Two reasons:
   The third argument is a coerion
        [a] :: [a]:=:[a]
 
   The third argument is a coerion
        [a] :: [a]:=:[a]
 

+INVARIANT: the dictionary constructor for a class
+          never has a wrapper.

 
 
 A note about the stupid context
 
 
 A note about the stupid context

@@ -219,11 +234,11 @@ data DataCon
        --
        --      *** As declared by the user
        --  data T a where
        --
        --      *** As declared by the user
        --  data T a where

-       --    MkT :: forall x y. (Ord x) => x -> y -> T (x,y)
+       --    MkT :: forall x y. (x~y,Ord x) => x -> y -> T (x,y)

 
        --      *** As represented internally
        --  data T a where
 
        --      *** As represented internally
        --  data T a where

-       --    MkT :: forall a. forall x y. (a:=:(x,y), Ord x) => x -> y -> T a
+       --    MkT :: forall a. forall x y. (a:=:(x,y),x~y,Ord x) => x -> y -> T a

        -- 
        -- The next six fields express the type of the constructor, in pieces
        -- e.g.
        -- 
        -- The next six fields express the type of the constructor, in pieces
        -- e.g.

@@ -231,21 +246,24 @@ data DataCon
        --      dcUnivTyVars  = [a]
        --      dcExTyVars    = [x,y]
        --      dcEqSpec      = [a:=:(x,y)]
        --      dcUnivTyVars  = [a]
        --      dcExTyVars    = [x,y]
        --      dcEqSpec      = [a:=:(x,y)]

-       --      dcTheta       = [Ord x]
+       --      dcEqTheta     = [x~y]   
+       --      dcDictTheta   = [Ord x]

        --      dcOrigArgTys  = [a,List b]
        --      dcOrigArgTys  = [a,List b]

-       --      dcTyCon       = T
+       --      dcRepTyCon       = T

 
        dcVanilla :: Bool,      -- True <=> This is a vanilla Haskell 98 data constructor
                                --          Its type is of form
                                --              forall a1..an . t1 -> ... tm -> T a1..an
                                --          No existentials, no coercions, nothing.
 
        dcVanilla :: Bool,      -- True <=> This is a vanilla Haskell 98 data constructor
                                --          Its type is of form
                                --              forall a1..an . t1 -> ... tm -> T a1..an
                                --          No existentials, no coercions, nothing.

-                               -- That is: dcExTyVars = dcEqSpec = dcTheta = []
+                               -- That is: dcExTyVars = dcEqSpec = dcEqTheta = dcDictTheta = []

                -- NB 1: newtypes always have a vanilla data con
                -- NB 2: a vanilla constructor can still be declared in GADT-style 
                --       syntax, provided its type looks like the above.
                --       The declaration format is held in the TyCon (algTcGadtSyntax)
 
        dcUnivTyVars :: [TyVar],        -- Universally-quantified type vars 
                -- NB 1: newtypes always have a vanilla data con
                -- NB 2: a vanilla constructor can still be declared in GADT-style 
                --       syntax, provided its type looks like the above.
                --       The declaration format is held in the TyCon (algTcGadtSyntax)
 
        dcUnivTyVars :: [TyVar],        -- Universally-quantified type vars 

+                                       -- INVARIANT: length matches arity of the dcRepTyCon
+

        dcExTyVars   :: [TyVar],        -- Existentially-quantified type vars 
                -- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
                -- FOR THE PARENT TyCon. With GADTs the data con might not even have 
        dcExTyVars   :: [TyVar],        -- Existentially-quantified type vars 
                -- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
                -- FOR THE PARENT TyCon. With GADTs the data con might not even have 

@@ -265,11 +283,14 @@ data DataCon
                -- Each equality is of the form (a :=: ty), where 'a' is one of 
                -- the universally quantified type variables
                                        
                -- Each equality is of the form (a :=: ty), where 'a' is one of 
                -- the universally quantified type variables
                                        

-       dcTheta  :: ThetaType,          -- The context of the constructor
+               -- The next two fields give the type context of the data constructor
+               --      (aside from the GADT constraints, 
+               --       which are given by the dcExpSpec)

                -- In GADT form, this is *exactly* what the programmer writes, even if
                -- the context constrains only universally quantified variables
                -- In GADT form, this is *exactly* what the programmer writes, even if
                -- the context constrains only universally quantified variables

-               --      MkT :: forall a. Eq a => a -> T a
-               -- It may contain user-written equality predicates too
+               --      MkT :: forall a b. (a ~ b, Ord b) => a -> T a b
+       dcEqTheta   :: ThetaType,  -- The *equational* constraints
+       dcDictTheta :: ThetaType,  -- The *type-class and implicit-param* constraints

 
        dcStupidTheta :: ThetaType,     -- The context of the data type declaration 
                                        --      data Eq a => T a = ...
 
        dcStupidTheta :: ThetaType,     -- The context of the data type declaration 
                                        --      data Eq a => T a = ...

@@ -288,9 +309,11 @@ data DataCon
 
        dcOrigArgTys :: [Type],         -- Original argument types
                                        -- (before unboxing and flattening of strict fields)
 
        dcOrigArgTys :: [Type],         -- Original argument types
                                        -- (before unboxing and flattening of strict fields)

-
-       -- Result type of constructor is T t1..tn
-       dcTyCon  :: TyCon,              -- Result tycon, T
+       dcOrigResTy :: Type,            -- Original result type
+               -- NB: for a data instance, the original user result type may 
+               -- differ from the DataCon's representation TyCon.  Example
+               --      data instance T [a] where MkT :: a -> T [a]
+               -- The OrigResTy is T [a], but the dcRepTyCon might be :T123

 
        -- Now the strictness annotations and field labels of the constructor
        dcStrictMarks :: [StrictnessMark],
 
        -- Now the strictness annotations and field labels of the constructor
        dcStrictMarks :: [StrictnessMark],

@@ -300,7 +323,7 @@ data DataCon
 
        dcFields  :: [FieldLabel],
                -- Field labels for this constructor, in the
 
        dcFields  :: [FieldLabel],
                -- Field labels for this constructor, in the

-               -- same order as the argument types; 
+               -- same order as the dcOrigArgTys; 

                -- length = 0 (if not a record) or dataConSourceArity.
 
        -- Constructor representation
                -- length = 0 (if not a record) or dataConSourceArity.
 
        -- Constructor representation

@@ -309,6 +332,10 @@ data DataCon
                                        -- and *including* existential dictionaries
 
        dcRepStrictness :: [StrictnessMark],    -- One for each *representation* argument       
                                        -- and *including* existential dictionaries
 
        dcRepStrictness :: [StrictnessMark],    -- One for each *representation* argument       

+               -- See also Note [Data-con worker strictness] in MkId.lhs
+
+       -- Result type of constructor is T t1..tn
+       dcRepTyCon  :: TyCon,           -- Result tycon, T

 
        dcRepType   :: Type,    -- Type of the constructor
                                --      forall a x y. (a:=:(x,y), Ord x) => x -> y -> MkT a
 
        dcRepType   :: Type,    -- Type of the constructor
                                --      forall a x y. (a:=:(x,y), Ord x) => x -> y -> MkT a

@@ -349,7 +376,7 @@ data DataConIds
        -- The 'Nothing' case of DCIds is important
        -- Not only is this efficient,
        -- but it also ensures that the wrapper is replaced
        -- The 'Nothing' case of DCIds is important
        -- Not only is this efficient,
        -- but it also ensures that the wrapper is replaced

-       -- by the worker (becuase it *is* the wroker)
+       -- by the worker (becuase it *is* the worker)

        -- even when there are no args. E.g. in
        --              f (:) x
        -- the (:) *is* the worker.
        -- even when there are no args. E.g. in
        --              f (:) x
        -- the (:) *is* the worker.

@@ -447,7 +474,7 @@ mkDataCon name declared_infix
 -- so the error is detected properly... it's just that asaertions here
 -- are a little dodgy.
 
 -- so the error is detected properly... it's just that asaertions here
 -- are a little dodgy.
 

-  = ASSERT( not (any isEqPred theta) )
+  = -- ASSERT( not (any isEqPred theta) )

        -- We don't currently allow any equality predicates on
        -- a data constructor (apart from the GADT ones in eq_spec)
     con
        -- We don't currently allow any equality predicates on
        -- a data constructor (apart from the GADT ones in eq_spec)
     con

@@ -457,8 +484,10 @@ mkDataCon name declared_infix
                  dcVanilla = is_vanilla, dcInfix = declared_infix,
                  dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, 
                  dcEqSpec = eq_spec, 
                  dcVanilla = is_vanilla, dcInfix = declared_infix,
                  dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, 
                  dcEqSpec = eq_spec, 

-                 dcStupidTheta = stupid_theta, dcTheta = theta,
-                 dcOrigArgTys = orig_arg_tys, dcTyCon = tycon, 
+                 dcStupidTheta = stupid_theta, 
+                 dcEqTheta = eq_theta, dcDictTheta = dict_theta,
+                 dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty,
+                 dcRepTyCon = tycon, 

                  dcRepArgTys = rep_arg_tys,
                  dcStrictMarks = arg_stricts, 
                  dcRepStrictness = rep_arg_stricts,
                  dcRepArgTys = rep_arg_tys,
                  dcStrictMarks = arg_stricts, 
                  dcRepStrictness = rep_arg_stricts,

@@ -472,9 +501,20 @@ mkDataCon name declared_infix
        -- The 'arg_stricts' passed to mkDataCon are simply those for the
        -- source-language arguments.  We add extra ones for the
        -- dictionary arguments right here.
        -- The 'arg_stricts' passed to mkDataCon are simply those for the
        -- source-language arguments.  We add extra ones for the
        -- dictionary arguments right here.

-    dict_tys     = mkPredTys theta
-    real_arg_tys = dict_tys                      ++ orig_arg_tys
-    real_stricts = map mk_dict_strict_mark theta ++ arg_stricts
+    (eq_theta,dict_theta)  = partition isEqPred theta
+    dict_tys              = mkPredTys dict_theta
+    real_arg_tys          = dict_tys ++ orig_arg_tys
+    real_stricts          = map mk_dict_strict_mark dict_theta ++ arg_stricts
+
+       -- Example
+       --   data instance T (b,c) where 
+       --      TI :: forall e. e -> T (e,e)
+       --
+       -- The representation tycon looks like this:
+       --   data :R7T b c where 
+       --      TI :: forall b1 c1. (b1 ~ c1) => b1 -> :R7T b1 c1
+       -- In this case orig_res_ty = T (e,e)
+    orig_res_ty = mkFamilyTyConApp tycon (substTyVars (mkTopTvSubst eq_spec) univ_tvs)

 
        -- Representation arguments and demands
        -- To do: eliminate duplication with MkId
 
        -- Representation arguments and demands
        -- To do: eliminate duplication with MkId

@@ -483,6 +523,7 @@ mkDataCon name declared_infix
     tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
     ty  = mkForAllTys univ_tvs $ mkForAllTys ex_tvs $ 
          mkFunTys (mkPredTys (eqSpecPreds eq_spec)) $
     tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
     ty  = mkForAllTys univ_tvs $ mkForAllTys ex_tvs $ 
          mkFunTys (mkPredTys (eqSpecPreds eq_spec)) $

+         mkFunTys (mkPredTys eq_theta) $

                -- NB:  the dict args are already in rep_arg_tys
                --      because they might be flattened..
                --      but the equality predicates are not
                -- NB:  the dict args are already in rep_arg_tys
                --      because they might be flattened..
                --      but the equality predicates are not

@@ -492,6 +533,7 @@ mkDataCon name declared_infix
 eqSpecPreds :: [(TyVar,Type)] -> ThetaType
 eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv, ty) | (tv,ty) <- spec ]
 
 eqSpecPreds :: [(TyVar,Type)] -> ThetaType
 eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv, ty) | (tv,ty) <- spec ]
 

+mk_dict_strict_mark :: PredType -> StrictnessMark

 mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict
                         | otherwise         = NotMarkedStrict
 \end{code}
 mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict
                         | otherwise         = NotMarkedStrict
 \end{code}

@@ -504,7 +546,7 @@ dataConTag :: DataCon -> ConTag
 dataConTag  = dcTag
 
 dataConTyCon :: DataCon -> TyCon
 dataConTag  = dcTag
 
 dataConTyCon :: DataCon -> TyCon

-dataConTyCon = dcTyCon
+dataConTyCon = dcRepTyCon

 
 dataConRepType :: DataCon -> Type
 dataConRepType = dcRepType
 
 dataConRepType :: DataCon -> Type
 dataConRepType = dcRepType

@@ -525,8 +567,11 @@ dataConAllTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
 dataConEqSpec :: DataCon -> [(TyVar,Type)]
 dataConEqSpec = dcEqSpec
 
 dataConEqSpec :: DataCon -> [(TyVar,Type)]
 dataConEqSpec = dcEqSpec
 

-dataConTheta :: DataCon -> ThetaType
-dataConTheta = dcTheta
+dataConEqTheta :: DataCon -> ThetaType
+dataConEqTheta = dcEqTheta
+
+dataConDictTheta :: DataCon -> ThetaType
+dataConDictTheta = dcDictTheta

 
 dataConWorkId :: DataCon -> Id
 dataConWorkId dc = case dcIds dc of
 
 dataConWorkId :: DataCon -> Id
 dataConWorkId dc = case dcIds dc of

@@ -562,7 +607,7 @@ dataConStrictMarks = dcStrictMarks
 dataConExStricts :: DataCon -> [StrictnessMark]
 -- Strictness of *existential* arguments only
 -- Usually empty, so we don't bother to cache this
 dataConExStricts :: DataCon -> [StrictnessMark]
 -- Strictness of *existential* arguments only
 -- Usually empty, so we don't bother to cache this

-dataConExStricts dc = map mk_dict_strict_mark (dcTheta dc)
+dataConExStricts dc = map mk_dict_strict_mark $ dcDictTheta dc

 
 dataConSourceArity :: DataCon -> Arity
        -- Source-level arity of the data constructor
 
 dataConSourceArity :: DataCon -> Arity
        -- Source-level arity of the data constructor

@@ -572,6 +617,7 @@ dataConSourceArity dc = length (dcOrigArgTys dc)
 -- {\em representation} of the data constructor.  This may be more than appear
 -- in the source code; the extra ones are the existentially quantified
 -- dictionaries
 -- {\em representation} of the data constructor.  This may be more than appear
 -- in the source code; the extra ones are the existentially quantified
 -- dictionaries

+dataConRepArity :: DataCon -> Int

 dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
 
 isNullarySrcDataCon, isNullaryRepDataCon :: DataCon -> Bool
 dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
 
 isNullarySrcDataCon, isNullaryRepDataCon :: DataCon -> Bool

@@ -583,71 +629,87 @@ dataConRepStrictness :: DataCon -> [StrictnessMark]
        -- Core constructor application (Con dc args)
 dataConRepStrictness dc = dcRepStrictness dc
 
        -- Core constructor application (Con dc args)
 dataConRepStrictness dc = dcRepStrictness dc
 

-dataConSig :: DataCon -> ([TyVar], ThetaType, [Type])
+dataConSig :: DataCon -> ([TyVar], ThetaType, [Type], Type)

 dataConSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
 dataConSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,

-                   dcTheta  = theta, dcOrigArgTys = arg_tys, dcTyCon = tycon})
-  = (univ_tvs ++ ex_tvs, eqSpecPreds eq_spec ++ theta, arg_tys)
+                   dcEqTheta  = eq_theta, dcDictTheta = dict_theta, dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
+  = (univ_tvs ++ ex_tvs, eqSpecPreds eq_spec ++ eq_theta ++ dict_theta, arg_tys, res_ty)

 
 dataConFullSig :: DataCon 
 
 dataConFullSig :: DataCon 

-              -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, [Type])
+              -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, ThetaType, [Type], Type)

 dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
 dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,

-                       dcTheta  = theta, dcOrigArgTys = arg_tys, dcTyCon = tycon})
-  = (univ_tvs, ex_tvs, eq_spec, theta, arg_tys)
+                       dcEqTheta = eq_theta, dcDictTheta = dict_theta, dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
+  = (univ_tvs, ex_tvs, eq_spec, eq_theta, dict_theta, arg_tys, res_ty)
+
+dataConOrigResTy :: DataCon -> Type
+dataConOrigResTy dc = dcOrigResTy dc

 
 dataConStupidTheta :: DataCon -> ThetaType
 dataConStupidTheta dc = dcStupidTheta dc
 
 
 dataConStupidTheta :: DataCon -> ThetaType
 dataConStupidTheta dc = dcStupidTheta dc
 

-dataConResTys :: DataCon -> [Type]
-dataConResTys dc = [substTyVar env tv | tv <- dcUnivTyVars dc]
-  where
-    env = mkTopTvSubst (dcEqSpec dc)
-

 dataConUserType :: DataCon -> Type
 -- The user-declared type of the data constructor
 -- in the nice-to-read form 
 dataConUserType :: DataCon -> Type
 -- The user-declared type of the data constructor
 -- in the nice-to-read form 

---     T :: forall a. a -> T [a]
+--     T :: forall a b. a -> b -> T [a]

 -- rather than
 -- rather than

---     T :: forall b. forall a. (a=[b]) => a -> T b
+--     T :: forall a c. forall b. (c=[a]) => a -> b -> T c

 -- NB: If the constructor is part of a data instance, the result type
 -- mentions the family tycon, not the internal one.
 dataConUserType  (MkData { dcUnivTyVars = univ_tvs, 
                           dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
 -- NB: If the constructor is part of a data instance, the result type
 -- mentions the family tycon, not the internal one.
 dataConUserType  (MkData { dcUnivTyVars = univ_tvs, 
                           dcExTyVars = ex_tvs, dcEqSpec = eq_spec,

-                          dcTheta = theta, dcOrigArgTys = arg_tys,
-                          dcTyCon = tycon })
+                          dcEqTheta = eq_theta, dcDictTheta = dict_theta, dcOrigArgTys = arg_tys,
+                          dcOrigResTy = res_ty })

   = mkForAllTys ((univ_tvs `minusList` map fst eq_spec) ++ ex_tvs) $
   = mkForAllTys ((univ_tvs `minusList` map fst eq_spec) ++ ex_tvs) $

-    mkFunTys (mkPredTys theta) $
+    mkFunTys (mkPredTys eq_theta) $
+    mkFunTys (mkPredTys dict_theta) $

     mkFunTys arg_tys $
     mkFunTys arg_tys $

-    case tyConFamInst_maybe tycon of
-      Nothing             -> mkTyConApp tycon (map (substTyVar subst) univ_tvs)
-      Just (ftc, insttys) -> mkTyConApp ftc insttys        -- data instance
-  where
-    subst = mkTopTvSubst eq_spec
+    res_ty

 
 

-dataConInstArgTys :: DataCon
+dataConInstArgTys :: DataCon   -- A datacon with no existentials or equality constraints
+                               -- However, it can have a dcTheta (notably it can be a 
+                               -- class dictionary, with superclasses)

                  -> [Type]     -- Instantiated at these types
                  -> [Type]     -- Instantiated at these types

-                               -- NB: these INCLUDE the existentially quantified arg types

                  -> [Type]     -- Needs arguments of these types
                  -> [Type]     -- Needs arguments of these types

-                               -- NB: these INCLUDE the existentially quantified dict args
+                               -- NB: these INCLUDE any dict args

                                --     but EXCLUDE the data-decl context which is discarded
                                -- It's all post-flattening etc; this is a representation type
                                --     but EXCLUDE the data-decl context which is discarded
                                -- It's all post-flattening etc; this is a representation type

-dataConInstArgTys (MkData {dcRepArgTys = arg_tys, 
-                          dcUnivTyVars = univ_tvs, 
-                          dcExTyVars = ex_tvs}) inst_tys
- = ASSERT( length tyvars == length inst_tys )
-   map (substTyWith tyvars inst_tys) arg_tys
- where
-   tyvars = univ_tvs ++ ex_tvs
-
-
--- And the same deal for the original arg tys
-dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
+dataConInstArgTys dc@(MkData {dcRepArgTys = rep_arg_tys, 
+                             dcUnivTyVars = univ_tvs, dcEqSpec = eq_spec,
+                             dcExTyVars = ex_tvs}) inst_tys
+ = ASSERT2 ( length univ_tvs == length inst_tys 
+           , ptext SLIT("dataConInstArgTys") <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)
+   ASSERT2 ( null ex_tvs && null eq_spec, ppr dc )        
+   map (substTyWith univ_tvs inst_tys) rep_arg_tys
+
+dataConInstOrigArgTys 
+       :: DataCon      -- Works for any DataCon
+       -> [Type]       -- Includes existential tyvar args, but NOT
+                       -- equality constraints or dicts
+       -> [Type]       -- Returns just the instsantiated *value* arguments
+-- For vanilla datacons, it's all quite straightforward
+-- But for the call in MatchCon, we really do want just the value args

 dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
 dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,

-                              dcUnivTyVars = univ_tvs, 
-                              dcExTyVars = ex_tvs}) inst_tys
- = ASSERT2( length tyvars == length inst_tys, ptext SLIT("dataConInstOrigArgTys") <+> ppr dc <+> ppr inst_tys )
-   map (substTyWith tyvars inst_tys) arg_tys
- where
-   tyvars = univ_tvs ++ ex_tvs
+                                 dcUnivTyVars = univ_tvs, 
+                                 dcExTyVars = ex_tvs}) inst_tys
+  = ASSERT2( length tyvars == length inst_tys
+          , ptext SLIT("dataConInstOrigArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
+    map (substTyWith tyvars inst_tys) arg_tys
+  where
+    tyvars = univ_tvs ++ ex_tvs
+
+dataConInstOrigDictsAndArgTys 
+       :: DataCon      -- Works for any DataCon
+       -> [Type]       -- Includes existential tyvar args, but NOT
+                       -- equality constraints or dicts
+       -> [Type]       -- Returns just the instsantiated dicts and *value* arguments
+dataConInstOrigDictsAndArgTys dc@(MkData {dcOrigArgTys = arg_tys,
+                                 dcDictTheta = dicts,       
+                                 dcUnivTyVars = univ_tvs, 
+                                 dcExTyVars = ex_tvs}) inst_tys
+  = ASSERT2( length tyvars == length inst_tys
+          , ptext SLIT("dataConInstOrigDictsAndArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
+    map (substTyWith tyvars inst_tys) (mkPredTys dicts ++ arg_tys)
+  where
+    tyvars = univ_tvs ++ ex_tvs

 \end{code}
 
 These two functions get the real argument types of the constructor,
 \end{code}
 
 These two functions get the real argument types of the constructor,

@@ -666,13 +728,26 @@ dataConRepArgTys :: DataCon -> [Type]
 dataConRepArgTys dc = dcRepArgTys dc
 \end{code}
 
 dataConRepArgTys dc = dcRepArgTys dc
 \end{code}
 

+The string <package>:<module>.<name> identifying a constructor, which is attached
+to its info table and used by the GHCi debugger and the heap profiler.  We want
+this string to be UTF-8, so we get the bytes directly from the FastStrings.
+
+\begin{code}
+dataConIdentity :: DataCon -> [Word8]
+dataConIdentity dc = bytesFS (packageIdFS (modulePackageId mod)) ++ 
+                  fromIntegral (ord ':') : bytesFS (moduleNameFS (moduleName mod)) ++
+                  fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name))
+  where name = dataConName dc
+        mod  = nameModule name
+\end{code}
+

 
 \begin{code}
 isTupleCon :: DataCon -> Bool
 
 \begin{code}
 isTupleCon :: DataCon -> Bool

-isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
+isTupleCon (MkData {dcRepTyCon = tc}) = isTupleTyCon tc

        
 isUnboxedTupleCon :: DataCon -> Bool
        
 isUnboxedTupleCon :: DataCon -> Bool

-isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
+isUnboxedTupleCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc

 
 isVanillaDataCon :: DataCon -> Bool
 isVanillaDataCon dc = dcVanilla dc
 
 isVanillaDataCon :: DataCon -> Bool
 isVanillaDataCon dc = dcVanilla dc

@@ -683,6 +758,7 @@ isVanillaDataCon dc = dcVanilla dc
 classDataCon :: Class -> DataCon
 classDataCon clas = case tyConDataCons (classTyCon clas) of
                      (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr 
 classDataCon :: Class -> DataCon
 classDataCon clas = case tyConDataCons (classTyCon clas) of
                      (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr 

+                     [] -> panic "classDataCon"

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -716,26 +792,31 @@ splitProductType_maybe ty
                                        -- and for constructors visible
           -> Just (tycon, ty_args, data_con, dataConInstArgTys data_con ty_args)
           where
                                        -- and for constructors visible
           -> Just (tycon, ty_args, data_con, dataConInstArgTys data_con ty_args)
           where

-             data_con = head (tyConDataCons tycon)
-       other -> Nothing
+             data_con = ASSERT( not (null (tyConDataCons tycon)) ) 
+                        head (tyConDataCons tycon)
+       _other -> Nothing

 
 

+splitProductType :: String -> Type -> (TyCon, [Type], DataCon, [Type])

 splitProductType str ty
   = case splitProductType_maybe ty of
        Just stuff -> stuff
        Nothing    -> pprPanic (str ++ ": not a product") (pprType ty)
 
 
 splitProductType str ty
   = case splitProductType_maybe ty of
        Just stuff -> stuff
        Nothing    -> pprPanic (str ++ ": not a product") (pprType ty)
 
 

+deepSplitProductType_maybe :: Type -> Maybe (TyCon, [Type], DataCon, [Type])

 deepSplitProductType_maybe ty
   = do { (res@(tycon, tycon_args, _, _)) <- splitProductType_maybe ty
        ; let {result 
 deepSplitProductType_maybe ty
   = do { (res@(tycon, tycon_args, _, _)) <- splitProductType_maybe ty
        ; let {result 

-             | isClosedNewTyCon tycon && not (isRecursiveTyCon tycon)
-             = deepSplitProductType_maybe (newTyConInstRhs tycon tycon_args)
+             | Just (ty', _co) <- instNewTyCon_maybe tycon tycon_args
+            , not (isRecursiveTyCon tycon)
+             = deepSplitProductType_maybe ty'  -- Ignore the coercion?

              | isNewTyCon tycon = Nothing  -- cannot unbox through recursive
                                           -- newtypes nor through families
              | otherwise = Just res}
        ; result
        }
           
              | isNewTyCon tycon = Nothing  -- cannot unbox through recursive
                                           -- newtypes nor through families
              | otherwise = Just res}
        ; result
        }
           

+deepSplitProductType :: String -> Type -> (TyCon, [Type], DataCon, [Type])

 deepSplitProductType str ty 
   = case deepSplitProductType_maybe ty of
       Just stuff -> stuff
 deepSplitProductType str ty 
   = case deepSplitProductType_maybe ty of
       Just stuff -> stuff