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

[git at git.haskell.org]

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

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

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

commit c1a65417b061c8fd8c944d959967fbbd57d7b89d
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.


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

c1a65417b061c8fd8c944d959967fbbd57d7b89d
 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 b334967..9091005 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -800,7 +800,7 @@ mk_tuple Unboxed arity = (tycon, tuple_con)
                 | otherwise  = unboxedTupleKind
 
     tc_arity    = arity * 2
-    flavour     = UnboxedAlgTyCon
+    flavour     = UnboxedAlgTyCon (mkPrelTyConRepName tc_name)
 
     dc_tvs     = binderVars tc_binders
     dc_arg_tys = mkTyVarTys (drop arity dc_tvs)
diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs
index 0502f51..89d5586 100644
--- a/compiler/typecheck/TcTypeable.hs
+++ b/compiler/typecheck/TcTypeable.hs
@@ -14,6 +14,7 @@ import TcEnv
 import TcRnMonad
 import PrelNames
 import TysPrim ( primTyCons, primTypeableTyCons )
+import TysWiredIn ( tupleTyCon )
 import Id
 import Type
 import TyCon
@@ -25,6 +26,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 )
@@ -197,6 +200,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'
@@ -209,10 +228,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 d0ecb70..a6b2f8a 100644
--- a/compiler/types/TyCon.hs
+++ b/compiler/types/TyCon.hs
@@ -824,6 +824,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
@@ -877,7 +878,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
 
@@ -1087,6 +1088,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 })