[commit: ghc] wip/ttypeable: Clean up build issues (cac1821)

git at git.haskell.org git at git.haskell.org
Sun Jan 29 20:22:31 UTC 2017


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

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

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

commit cac1821ed54805762132892dedc069221fb25a33
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Sun Jan 29 01:35:23 2017 -0500

    Clean up build issues


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

cac1821ed54805762132892dedc069221fb25a33
 libraries/base/Data/Typeable/Internal.hs | 23 +++++++++++++++++------
 libraries/base/Type/Reflection/Unsafe.hs |  2 +-
 2 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs
index 646baa0..8e6e282 100644
--- a/libraries/base/Data/Typeable/Internal.hs
+++ b/libraries/base/Data/Typeable/Internal.hs
@@ -45,7 +45,7 @@ module Data.Typeable.Internal (
     -- * TyCon
     TyCon,   -- Abstract
     tyConPackage, tyConModule, tyConName, tyConKindVars, tyConKindRep,
-    KindRep(..),
+    KindRep(.., KindRepTypeLit), TypeLitSort(..),
     rnfTyCon,
 
     -- * TypeRep
@@ -143,6 +143,8 @@ rnfKindRep (KindRepVar _)   = ()
 rnfKindRep (KindRepApp a b) = rnfKindRep a `seq` rnfKindRep b
 rnfKindRep (KindRepFun a b) = rnfKindRep a `seq` rnfKindRep b
 rnfKindRep (KindRepTYPE rr) = rnfRuntimeRep rr
+rnfKindRep (KindRepTypeLitS _ _) = ()
+rnfKindRep (KindRepTypeLitD _ t) = rnfString t
 
 rnfRuntimeRep :: RuntimeRep -> ()
 rnfRuntimeRep (VecRep !_ !_) = ()
@@ -330,7 +332,6 @@ typeRepKind (TrApp _ f _)
   | otherwise
   = error ("Ill-kinded type application: " ++ show (typeRepKind f))
 typeRepKind (TrFun _ _ _) = typeRep @Type
-typeRepKind t = error ("Ill-kinded type representation: "++show t)
 
 tyConKind :: TyCon -> [SomeTypeRep] -> SomeTypeRep
 tyConKind (TyCon _ _ _ _ nKindVars# kindRep) kindVars =
@@ -352,7 +353,7 @@ instantiateKindRep vars = go
       = SomeTypeRep $ TRFun (unsafeCoerceRep $ go a) (unsafeCoerceRep $ go b)
     go (KindRepTYPE r) = unkindedTypeRep $ tYPE `kApp` runtimeRepTypeRep r
     go (KindRepTypeLitS sort s)
-      = mkTypeLitFromString sort (unpackString# s)
+      = mkTypeLitFromString sort (unpackCString# s)
     go (KindRepTypeLitD sort s)
       = mkTypeLitFromString sort s
 
@@ -547,6 +548,16 @@ rnfSomeTypeRep (SomeTypeRep r) = rnfTypeRep r
 *                                                          *
 ********************************************************* -}
 
+pattern KindRepTypeLit :: TypeLitSort -> String -> KindRep
+pattern KindRepTypeLit sort t <- (getKindRepTypeLit -> Just (sort, t))
+  where
+    KindRepTypeLit sort t = KindRepTypeLitD sort t
+
+getKindRepTypeLit :: KindRep -> Maybe (TypeLitSort, String)
+getKindRepTypeLit (KindRepTypeLitS sort t) = Just (sort, unpackCString# t)
+getKindRepTypeLit (KindRepTypeLitD sort t) = Just (sort, t)
+getKindRepTypeLit _                        = Nothing
+
 -- | Exquisitely unsafe.
 mkTyCon# :: Addr#       -- ^ package name
          -> Addr#       -- ^ module name
@@ -593,7 +604,7 @@ typeNatTypeRep p = typeLitTypeRep (show (natVal' p)) tcNat
 
 -- | Used to make `'Typeable' instance for things of kind Symbol
 typeSymbolTypeRep :: KnownSymbol a => Proxy# a -> TypeRep a
-typeSymbolTypeRep p = typeSymbolTypeRep (show (symbolVal' p)) tcSymbol
+typeSymbolTypeRep p = typeLitTypeRep (show (symbolVal' p)) tcSymbol
 
 mkTypeLitFromString :: TypeLitSort -> String -> SomeTypeRep
 mkTypeLitFromString TypeLitSymbol s =
@@ -602,10 +613,10 @@ mkTypeLitFromString TypeLitNat s =
     SomeTypeRep $ (typeLitTypeRep s tcSymbol :: TypeRep Nat)
 
 tcSymbol :: TyCon
-tcSymbol = typeRepTyCon typeRep
+tcSymbol = typeRepTyCon (typeRep @Symbol)
 
 tcNat :: TyCon
-tcNat = typeRepTyCon typeRep
+tcNat = typeRepTyCon (typeRep @Nat)
 
 -- | An internal function, to make representations for type literals.
 typeLitTypeRep :: forall (a :: k). (Typeable k) => String -> TyCon -> TypeRep a
diff --git a/libraries/base/Type/Reflection/Unsafe.hs b/libraries/base/Type/Reflection/Unsafe.hs
index b9f71be..879d240 100644
--- a/libraries/base/Type/Reflection/Unsafe.hs
+++ b/libraries/base/Type/Reflection/Unsafe.hs
@@ -15,7 +15,7 @@
 
 module Type.Reflection.Unsafe (
     tyConKindRep, tyConKindVars,
-    KindRep(..),
+    KindRep(..), TypeLit(..),
     mkTrCon, mkTrApp, mkTyCon
   ) where
 



More information about the ghc-commits mailing list