[commit: ghc] wip/T12618: Reserve a unique for the wrapper of a wired in DataCon (916c152)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T12618
Link       : http://ghc.haskell.org/trac/ghc/changeset/916c15272fffd7d7457c085488051765c6c8146e/ghc

>---------------------------------------------------------------

commit 916c15272fffd7d7457c085488051765c6c8146e
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Wed Oct 5 12:50:32 2016 -0400

    Reserve a unique for the wrapper of a wired in DataCon


>---------------------------------------------------------------

916c15272fffd7d7457c085488051765c6c8146e
 compiler/basicTypes/Unique.hs  | 17 +++++++++--------
 compiler/prelude/TysWiredIn.hs | 16 +++++++++++-----
 2 files changed, 20 insertions(+), 13 deletions(-)

diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs
index 8d4a1d6..128e7b3 100644
--- a/compiler/basicTypes/Unique.hs
+++ b/compiler/basicTypes/Unique.hs
@@ -55,7 +55,7 @@ module Unique (
         mkCostCentreUnique,
 
         tyConRepNameUnique,
-        dataConWorkerUnique, dataConRepNameUnique,
+        dataConWorkerUnique, dataConWrapperUnique, dataConRepNameUnique,
 
         mkBuiltinUnique,
         mkPseudoUniqueD,
@@ -367,12 +367,12 @@ tyConRepNameUnique  u = incrUnique u
 -- Wired-in data constructor keys occupy *three* slots:
 --    * u: the DataCon itself
 --    * u+1: its worker Id
---    * u+2: the TyConRepName of the promoted TyCon
--- Prelude data constructors are too simple to need wrappers.
+--    * u+2: its wrapper Id
+--    * u+3: the TyConRepName of the promoted TyCon
 
-mkPreludeDataConUnique i              = mkUnique '6' (3*i)    -- Must be alphabetic
-mkTupleDataConUnique Boxed          a = mkUnique '7' (3*a)    -- ditto (*may* be used in C labels)
-mkTupleDataConUnique Unboxed        a = mkUnique '8' (3*a)
+mkPreludeDataConUnique i              = mkUnique '6' (4*i)    -- Must be alphabetic
+mkTupleDataConUnique Boxed          a = mkUnique '7' (4*a)    -- ditto (*may* be used in C labels)
+mkTupleDataConUnique Unboxed        a = mkUnique '8' (4*a)
 
 --------------------------------------------------
 -- Sum arities start from 2. A sum of arity N has N data constructors, so it
@@ -402,9 +402,10 @@ sumUniqsOccupied arity
 {-# INLINE sumUniqsOccupied #-}
 
 --------------------------------------------------
-dataConRepNameUnique, dataConWorkerUnique :: Unique -> Unique
+dataConRepNameUnique, dataConWrapperUnique, dataConWorkerUnique :: Unique -> Unique
 dataConWorkerUnique  u = incrUnique u
-dataConRepNameUnique u = stepUnique u 2
+dataConWrapperUnique u = stepUnique u 2
+dataConRepNameUnique u = stepUnique u 3
 
 --------------------------------------------------
 mkPrimOpIdUnique op         = mkUnique '9' op
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 035ae75..b1d0f52 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -489,22 +489,23 @@ pcDataConWithFixity :: Bool      -- ^ declared infix?
                     -> [Type]    -- ^ args
                     -> TyCon
                     -> DataCon
-pcDataConWithFixity infx n = pcDataConWithFixity' infx n (dataConWorkerUnique (nameUnique n))
+pcDataConWithFixity infx n = pcDataConWithFixity' infx n (dataConWorkerUnique (nameUnique n)) (dataConWrapperUnique (nameUnique n))
                                                   NoRRI
--- The Name's unique is the first of two free uniques;
+-- The Name's unique is the first of four free uniques;
 -- the first is used for the datacon itself,
 -- the second is used for the "worker name"
+-- the third is used for the "wrapper name"
 --
 -- To support this the mkPreludeDataConUnique function "allocates"
 -- one DataCon unique per pair of Ints.
 
-pcDataConWithFixity' :: Bool -> Name -> Unique -> RuntimeRepInfo
+pcDataConWithFixity' :: Bool -> Name -> Unique -> Unique -> RuntimeRepInfo
                      -> [TyVar] -> [TyVar]
                      -> [Type] -> TyCon -> DataCon
 -- The Name should be in the DataName name space; it's the name
 -- of the DataCon itself.
 
-pcDataConWithFixity' declared_infix dc_name wrk_key rri tyvars ex_tyvars arg_tys tycon
+pcDataConWithFixity' declared_infix dc_name wrk_key _wrp_key rri tyvars ex_tyvars arg_tys tycon
   = data_con
   where
     data_con = mkDataCon dc_name declared_infix prom_info
@@ -520,6 +521,8 @@ pcDataConWithFixity' declared_infix dc_name wrk_key rri tyvars ex_tyvars arg_tys
                 []      -- No stupid theta
                 (mkDataConWorkId wrk_name data_con)
                 NoDataConRep    -- Wired-in types are too simple to need wrappers
+                                -- TODO #12618 should be generating a wrapper
+                                -- here, but we cannot use Core here!
 
     no_bang = HsSrcBang Nothing NoSrcUnpack NoSrcStrict
 
@@ -535,7 +538,10 @@ pcDataConWithFixity' declared_infix dc_name wrk_key rri tyvars ex_tyvars arg_tys
 -- used for RuntimeRep and friends
 pcSpecialDataCon :: Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
 pcSpecialDataCon dc_name arg_tys tycon rri
-  = pcDataConWithFixity' False dc_name (dataConWorkerUnique (nameUnique dc_name)) rri
+  = pcDataConWithFixity' False dc_name
+                         (dataConWorkerUnique (nameUnique dc_name))
+                         (dataConWrapperUnique (nameUnique dc_name))
+                         rri
                          [] [] arg_tys tycon
 
 {-