Tuples are wired in as well!

3 files changed, 37 insertions, 14 deletions

diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs
index 5e273b2f45..68cf86d565 100644
--- a/compiler/basicTypes/Name.hs
+++ b/compiler/basicTypes/Name.hs
@@ -9,6 +9,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE TupleSections #-}
 
 -- |
 -- #name_types#
@@ -46,7 +47,7 @@ module Name (
         mkInternalName, mkClonedInternalName, mkDerivedInternalName,
         mkSystemVarName, mkSysTvName,
         mkFCallName,
-        mkExternalName, mkWiredInName,
+        mkExternalName, mkWiredInName, mkWiredInNameTuple,
 
         -- ** Manipulating and deconstructing 'Name's
         nameUnique, setNameUnique,
@@ -62,7 +63,7 @@ module Name (
         isTyVarName, isTyConName, isDataConName,
         isValName, isVarName,
         isWiredInName, isWiredIn, isBuiltInSyntax,
-        isHoleName,
+        isHoleName, isWiredInTuple,
         nameIsLocalOrFrom, nameIsHomePackage,
         nameIsHomePackageImport, nameIsFromExternalPackage,
         stableNameCmp,
@@ -83,6 +84,7 @@ import GhcPrelude
 import {-# SOURCE #-} TyCoRep( TyThing )
 
 import OccName
+import BasicTypes
 import Module
 import SrcLoc
 import Unique
@@ -121,7 +123,7 @@ data Name = Name {
 data NameSort
   = External Module
 
-  | WiredIn Module !() BuiltInSyntax
+  | WiredIn Module !(Maybe (Boxity, Int))  BuiltInSyntax
         -- A variant of External, for wired-in things
 
   | Internal            -- A user-defined Id or TyVar
@@ -222,6 +224,11 @@ isWiredInName _                               = False
 isWiredIn :: NamedThing thing => thing -> Bool
 isWiredIn = isWiredInName . getName
 
+isWiredInTuple :: Name -> Maybe (NameSpace, (Boxity, Arity))
+isWiredInTuple (Name {n_sort = WiredIn _ i _
+                     ,n_occ = o}) = (occNameSpace o,) <$> i
+isWiredInTuple _ = Nothing
+
 isBuiltInSyntax :: Name -> Bool
 isBuiltInSyntax (Name {n_sort = WiredIn _ _ BuiltInSyntax}) = True
 isBuiltInSyntax _                                           = False
@@ -369,9 +376,16 @@ mkExternalName uniq mod occ loc
 mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
 mkWiredInName mod occ uniq _t built_in
   = Name { n_uniq = uniq,
-           n_sort = WiredIn mod () built_in,
+           n_sort = WiredIn mod Nothing built_in,
            n_occ = occ, n_loc = wiredInSrcSpan }
 
+mkWiredInNameTuple :: Boxity -> Arity -> Module -> OccName -> Unique -> Name
+mkWiredInNameTuple boxity arity mod occ uniq
+  = Name { n_uniq = uniq,
+           n_sort = WiredIn mod (Just (boxity, arity)) BuiltInSyntax,
+           n_occ = occ, n_loc = wiredInSrcSpan }
+
+
 -- | Create a name brought into being by the compiler
 mkSystemName :: Unique -> OccName -> Name
 mkSystemName uniq occ = mkSystemNameAt uniq occ noSrcSpan
diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs
index 8985f4afbc..2e74470b54 100644
--- a/compiler/prelude/PrelInfo.hs
+++ b/compiler/prelude/PrelInfo.hs
@@ -196,7 +196,12 @@ knownKeyNamesOkay all_names
                            "]"
 
 wiredInNameTyThing_maybe :: Name -> Maybe TyThing
-wiredInNameTyThing_maybe = lookupNameEnv wiredInMap
+wiredInNameTyThing_maybe n
+  | isWiredIn n
+  = case isWiredInTuple n of
+      Just (ns, (b, a)) -> Just $ tupleTyThing ns b a
+      Nothing -> lookupNameEnv wiredInMap n
+  | otherwise = Nothing
 
 
 -- | Given a 'Unique' lookup its associated 'Name' if it corresponds to a
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index bec29ebc76..475d2c0421 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -71,7 +71,7 @@ module TysWiredIn (
 
         -- * Tuples
         mkTupleTy, mkTupleTy1, mkBoxedTupleTy, mkTupleStr,
-        tupleTyCon, tupleDataCon, tupleTyConName,
+        tupleTyCon, tupleDataCon, tupleTyConName, tupleTyThing,
         promotedTupleDataCon,
         unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey,
         pairTyCon,
@@ -798,6 +798,13 @@ isBuiltInOcc_maybe occ =
       = choose_ns (getName (tupleTyCon   boxity arity))
                   (getName (tupleDataCon boxity arity))
 
+tupleTyThing :: NameSpace -> Boxity -> Arity -> TyThing
+tupleTyThing ns boxity arity
+  | isTcClsNameSpace ns   = ATyCon (tupleTyCon boxity arity)
+  | isDataConNameSpace ns = AConLike (RealDataCon (tupleDataCon boxity arity))
+  | otherwise = pprPanic "tupleTyThing" (ppr (boxity, arity))
+
+
 mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
 -- No need to cache these, the caching is done in mk_tuple
 mkTupleOcc ns Boxed   ar = mkOccName ns (mkBoxedTupleStr   ar)
@@ -916,10 +923,9 @@ mk_tuple Boxed arity = (tycon, tuple_con)
 
     boxity  = Boxed
     modu    = gHC_TUPLE
-    tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq
-                         (ATyCon tycon) BuiltInSyntax
-    dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq
-                            (AConLike (RealDataCon tuple_con)) BuiltInSyntax
+    tc_name = mkWiredInNameTuple boxity arity modu (mkTupleOcc tcName boxity arity) tc_uniq
+    dc_name = mkWiredInNameTuple boxity arity modu (mkTupleOcc dataName boxity arity) dc_uniq
+
     tc_uniq = mkTupleTyConUnique   boxity arity
     dc_uniq = mkTupleDataConUnique boxity arity
 
@@ -944,10 +950,8 @@ mk_tuple Unboxed arity = (tycon, tuple_con)
 
     boxity  = Unboxed
     modu    = gHC_PRIM
-    tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq
-                         (ATyCon tycon) BuiltInSyntax
-    dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq
-                            (AConLike (RealDataCon tuple_con)) BuiltInSyntax
+    tc_name = mkWiredInNameTuple boxity arity modu (mkTupleOcc tcName boxity arity) tc_uniq
+    dc_name = mkWiredInNameTuple boxity arity modu (mkTupleOcc dataName boxity arity) dc_uniq
     tc_uniq = mkTupleTyConUnique   boxity arity
     dc_uniq = mkTupleDataConUnique boxity arity