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

[git at git.haskell.org]

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

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

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

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


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

f248c7087fd378369608b04966fd9ac790bb76a9
 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 51f5555..556c1d2 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -771,7 +771,7 @@ mk_tuple Unboxed arity = (tycon, tuple_con)
                                         (\ks -> map tYPE ks)
     tc_res_kind = 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 d825712..5869978 100644
--- a/compiler/types/TyCon.hs
+++ b/compiler/types/TyCon.hs
@@ -816,6 +816,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
@@ -869,7 +870,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
 
@@ -1079,6 +1080,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 })