[commit: ghc] wip/ttypeable: Give unboxed tuples type representations (f03a227)

[git at git.haskell.org]

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

On branch  : wip/ttypeable
Link       : http://ghc.haskell.org/trac/ghc/changeset/f03a22726d0fed7410221686343a71b844cb69e3/ghc

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

commit f03a22726d0fed7410221686343a71b844cb69e3
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Tue Jul 19 11:59:32 2016 +0200

    Give unboxed tuples type representations
    
    This fixes #12409. Ultimately this was a bit of a toss-up between
    
      1. keeping unboxed tuples unrepresentable and improving the error
         offered by the solver, and
      2. allowing unboxed tuples to be representable
    
    Ultimately it seemed easier (and perhaps more useful) to do (2), so
    that's what this patch does.


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

f03a22726d0fed7410221686343a71b844cb69e3
 compiler/prelude/TysWiredIn.hs   |  2 +-
 compiler/typecheck/TcTypeable.hs | 25 +++++++++++++++++++++----
 compiler/types/TyCon.hs          |  4 +++-
 3 files changed, 25 insertions(+), 6 deletions(-)

diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 66eb396..8d59b80 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -865,7 +865,7 @@ mk_tuple Unboxed arity = (tycon, tuple_con)
     tc_res_kind = unboxedTupleKind rr_tys
 
     tc_arity    = arity * 2
-    flavour     = UnboxedAlgTyCon
+    flavour     = UnboxedAlgTyCon (mkPrelTyConRepName tc_name)
 
     dc_tvs               = binderVars tc_binders
     (rr_tys, dc_arg_tys) = splitAt arity (mkTyVarTys dc_tvs)
diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs
index 402f64c..2bbf522 100644
--- a/compiler/typecheck/TcTypeable.hs
+++ b/compiler/typecheck/TcTypeable.hs
@@ -15,6 +15,7 @@ import TcEnv
 import TcRnMonad
 import PrelNames
 import TysPrim ( primTyCons, primTypeableTyCons )
+import TysWiredIn ( tupleTyCon )
 import Id
 import Type
 import TyCon
@@ -26,6 +27,8 @@ import NameEnv
 import HsSyn
 import DynFlags
 import Bag
+import BasicTypes ( Boxity(..) )
+import Constants  ( mAX_TUPLE_SIZE )
 import Fingerprint(Fingerprint(..), fingerprintString)
 import Outputable
 import FastString ( FastString, mkFastString )
@@ -198,6 +201,22 @@ mkPrimTypeableBinds
        }
   where
 
+-- | This is the list of primitive 'TyCon's for which we must generate bindings
+-- in "GHC.Types". This should include all types defined in "GHC.Prim".
+--
+-- The majority of the types we need here are contained in 'primTyCons'.
+-- However, not all of them: in particular unboxed tuples are absent since we
+-- don't want to include them in the original name cache. See
+-- Note [Built-in syntax and the OrigNameCache] in IfaceEnv for more.
+ghcPrimTypeableTyCons :: [TyCon]
+ghcPrimTypeableTyCons = filter (not . definedManually) $ concat
+    [ [funTyCon, tupleTyCon Unboxed 0]
+    , map (tupleTyCon Unboxed) [2..mAX_TUPLE_SIZE]
+    , primTyCons
+    ]
+  where
+    definedManually tc = tyConName tc `elemNameEnv` primTypeableTcCons
+
 -- | Generate bindings for the type representation of the wired-in TyCons defined
 -- by the virtual "GHC.Prim" module. This differs from the usual
 -- @mkTypeableBinds@ path in that here we need to lie to 'mk_typeable_binds'
@@ -210,10 +229,8 @@ ghcPrimTypeableBinds stuff
   = unionManyBags (map mkBind all_prim_tys)
   where
     all_prim_tys :: [TyCon]
-    all_prim_tys = [ tc' | tc <- funTyCon : primTyCons
-                         , tc' <- tc : tyConATs tc
-                         , not $ tyConName tc' `elemNameEnv` primTypeableTyCons
-                         ]
+    all_prim_tys = [ tc' | tc <- ghcPrimTypeableTyCons
+                         , tc' <- tc : tyConATs tc ]
 
     mkBind :: TyCon -> LHsBinds Id
     mkBind = mk_typeable_binds stuff
diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs
index fb170bb..cd57fae 100644
--- a/compiler/types/TyCon.hs
+++ b/compiler/types/TyCon.hs
@@ -898,6 +898,7 @@ data AlgTyConFlav
     -- | An unboxed type constructor. Note that this carries no TyConRepName
     -- as it is not representable.
   | UnboxedAlgTyCon
+       TyConRepName
 
   -- | Type constructors representing a class dictionary.
   -- See Note [ATyCon for classes] in TyCoRep
@@ -951,7 +952,7 @@ instance Outputable AlgTyConFlav where
 -- name, if any
 okParent :: Name -> AlgTyConFlav -> Bool
 okParent _       (VanillaAlgTyCon {})            = True
-okParent _       (UnboxedAlgTyCon)               = True
+okParent _       (UnboxedAlgTyCon {})            = True
 okParent tc_name (ClassTyCon cls _)              = tc_name == tyConName (classTyCon cls)
 okParent _       (DataFamInstTyCon _ fam_tc tys) = tyConArity fam_tc == length tys
 
@@ -1169,6 +1170,7 @@ tyConRepName_maybe (PrimTyCon  { primRepName = mb_rep_nm })
 tyConRepName_maybe (AlgTyCon { algTcParent = parent })
   | VanillaAlgTyCon rep_nm <- parent = Just rep_nm
   | ClassTyCon _ rep_nm    <- parent = Just rep_nm
+  | UnboxedAlgTyCon rep_nm    <- parent = Just rep_nm
 tyConRepName_maybe (FamilyTyCon { famTcFlav = DataFamilyTyCon rep_nm })
   = Just rep_nm
 tyConRepName_maybe (PromotedDataCon { tcRepName = rep_nm })