[commit: ghc] wip/names3: Fix it (5d2f8d7)

[git at git.haskell.org]

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

On branch  : wip/names3
Link       : http://ghc.haskell.org/trac/ghc/changeset/5d2f8d7906377447fcf604bafefe12ce083953c0/ghc

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

commit 5d2f8d7906377447fcf604bafefe12ce083953c0
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Sun Aug 21 10:43:04 2016 -0400

    Fix it


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

5d2f8d7906377447fcf604bafefe12ce083953c0
 compiler/ghc.mk                  |  1 +
 compiler/iface/BinIface.hs       |  4 +++-
 compiler/prelude/KnownUniques.hs | 23 ++++++++++++++++++-----
 compiler/prelude/PrelInfo.hs     | 10 ++++++++--
 compiler/prelude/TysWiredIn.hs   |  4 ++++
 5 files changed, 34 insertions(+), 8 deletions(-)

diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 5aeda53..1d30386 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -488,6 +488,7 @@ compiler_stage2_dll0_MODULES = \
 	IfaceType \
 	InstEnv \
 	Kind \
+	KnownUniques \
 	Lexeme \
 	ListSetOps \
 	Literal \
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 190da9e..e6b08b8 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -290,8 +290,10 @@ serialiseName bh name _ = do
 -- The format of this word is:
 --  00xxxxxx xxxxxxxx xxxxxxxx xxxxxxxx
 --   A normal name. x is an index into the symbol table
---  10xxxxxx xxyyyyyy yyyyyyyy yyyyyyyyyy
+--  10xxxxxx xxyyyyyy yyyyyyyy yyyyyyyy
 --   A known-key name. x is the Unique's Char, y is the int part
+--
+-- During serialization we check for known-key things using isKnownKeyName.
 
 -- See Note [Symbol table representation of names]
 putName :: BinDictionary -> BinSymbolTable -> BinHandle -> Name -> IO ()
diff --git a/compiler/prelude/KnownUniques.hs b/compiler/prelude/KnownUniques.hs
index 15f953a..e87a489 100644
--- a/compiler/prelude/KnownUniques.hs
+++ b/compiler/prelude/KnownUniques.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -- |
 -- Some types (e.g. tuples and anonymous sums) have large numbers of known key
 -- names which we handle specially to avoid bloating 'PrelInfo.knownKeyNames'.
@@ -20,13 +22,20 @@ module KnownUniques
     , mkCTupleDataConUnique
     ) where
 
+#include "HsVersions.h"
+
 import TysWiredIn
+import TyCon
+import DataCon
+import Id
 import BasicTypes
 import Outputable
-
 import Unique
 import Name
+import Util
+
 import Data.Bits
+import Data.Maybe
 
 -- | Get the 'Name' associated with a known-key 'Unique'.
 knownUniqueName :: Unique -> Maybe Name
@@ -70,8 +79,8 @@ mkSumDataConUnique alt arity
 getUnboxedSumName :: Int -> Name
 getUnboxedSumName n =
     case n .&. 0xff of
-      0xff -> sumTyCon arity
-      alt  -> sumDataCon (alt + 1)
+      0xff -> tyConName $ sumTyCon arity
+      alt  -> dataConName $ sumDataCon (alt + 1) arity
   where arity = n `shiftR` 0xff
 
 -- Note [Uniques for tuple type and data constructors]
@@ -100,13 +109,15 @@ getCTupleTyConName n =
     case n `divMod` 2 of
       (arity, 0) -> cTupleTyConName arity
       (arity, 1) -> mkPrelTyConRepName $ cTupleTyConName arity
+      _          -> panic "getCTupleTyConName: impossible"
 
 getCTupleDataConUnique :: Int -> Name
 getCTupleDataConUnique n =
     case n `divMod` 3 of
       (arity, 0) -> cTupleDataConName arity
-      (arity, 1) -> panic "getCTupleDataConUnique: no worker"
+      (arity, 1) -> panic "getCTupleDataConName: no worker"
       (arity, 2) -> mkPrelTyConRepName $ cTupleDataConName arity
+      _          -> panic "getCTupleDataConName: impossible"
 
 --------------------------------------------------
 -- Normal tuples
@@ -125,11 +136,13 @@ getTupleTyConName boxity n =
       (arity, 0) -> tyConName $ tupleTyCon boxity arity
       (arity, 1) -> fromMaybe (panic "getTupleTyConName")
                     $ tyConRepName_maybe $ tupleTyCon boxity arity
+      _          -> panic "getTupleTyConName: impossible"
 
 getTupleDataConName :: Boxity -> Int -> Name
 getTupleDataConName boxity n =
     case n `divMod` 3 of
       (arity, 0) -> dataConName $ tupleDataCon boxity arity
-      (arity, 1) -> idName $ dcWorkId $ tupleDataCon boxity arity
+      (arity, 1) -> idName $ dataConWorkId $ tupleDataCon boxity arity
       (arity, 2) -> fromMaybe (panic "getTupleDataCon")
                     $ tyConRepName_maybe $ promotedTupleDataCon boxity arity
+      _          -> panic "getTupleDataConName: impossible"
diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs
index a853bfa..bca992c 100644
--- a/compiler/prelude/PrelInfo.hs
+++ b/compiler/prelude/PrelInfo.hs
@@ -27,6 +27,8 @@ module PrelInfo (
 
 #include "HsVersions.h"
 
+import KnownUniques
+
 import ConLike          ( ConLike(..) )
 import PrelNames
 import PrelRules
@@ -45,7 +47,9 @@ import UniqFM
 import Util
 import {-# SOURCE #-} TcTypeNats ( typeNatTyCons )
 
+import Control.Applicative ((<|>))
 import Data.Array
+import Data.Maybe
 
 {-
 ************************************************************************
@@ -134,11 +138,13 @@ knownKeyNames
 -- | Given a 'Unique' lookup its associated 'Name' if it corresponds to a
 -- known-key thing.
 lookupKnownKeyName :: Unique -> Maybe Name
-lookupKnownKeyName = lookupUFM knownKeysMap
+lookupKnownKeyName u =
+    knownUniqueName u <|> lookupUFM knownKeysMap u
 
 -- | Is a 'Name' known-key?
 isKnownKeyName :: Name -> Bool
-isKnownKeyName n = elemUFM n knownKeysMap
+isKnownKeyName n =
+    isJust (knownUniqueName $ nameUnique n) || elemUFM n knownKeysMap
 
 knownKeysMap :: UniqFM Name
 knownKeysMap = listToUFM [ (nameUnique n, n) | n <- knownKeyNames ]
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 27a1f4f..f41edc8 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -633,6 +633,10 @@ Note [How tuples work]  See also Note [Known-key names] in PrelNames
   between BoxedTuple and ConstraintTuple (same OccName!), so tuples
   are not serialised into interface files using OccNames at all.
 
+* Serialization to interface files works via the usual mechanism for known-key
+  things: instead of serializing the OccName we just serialize the key.
+  See Note [Symbol table representation of names] for details.
+
 Note [One-tuples]
 ~~~~~~~~~~~~~~~~~
 GHC supports both boxed and unboxed one-tuples: