Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : new-typeable
http://hackage.haskell.org/trac/ghc/changeset/7a640a2600e5fbbb433885d205552ac4f5a5accf >--------------------------------------------------------------- commit 7a640a2600e5fbbb433885d205552ac4f5a5accf Author: Jose Pedro Magalhaes <[email protected]> Date: Wed Oct 3 13:53:40 2012 +0100 Cleanup >--------------------------------------------------------------- Data/Fixed.hs | 2 - Data/Typeable.hs | 2 +- Data/Typeable/Internal.hs | 56 +++++++++++++++++++------------------------- 3 files changed, 25 insertions(+), 35 deletions(-) diff --git a/Data/Fixed.hs b/Data/Fixed.hs index 6618b2a..81e7c03 100644 --- a/Data/Fixed.hs +++ b/Data/Fixed.hs @@ -73,7 +73,6 @@ newtype Fixed a = MkFixed Integer deriving (Eq,Ord) #endif -{- JPM: FIX #ifndef __NHC__ -- We do this because the automatically derived Data instance requires (Data a) context. -- Our manual instance has the more general (Typeable a) context. @@ -87,7 +86,6 @@ instance (Typeable a) => Data (Fixed a) where dataTypeOf _ = tyFixed toConstr _ = conMkFixed #endif --} class HasResolution a where resolution :: p a -> Integer diff --git a/Data/Typeable.hs b/Data/Typeable.hs index 04e4fd2..4d58e16 100644 --- a/Data/Typeable.hs +++ b/Data/Typeable.hs @@ -45,7 +45,7 @@ module Data.Typeable Typeable( typeRep ), -- :: Proxy a -> TypeRep -- * For backwards compatibility - typeOf, typeOf1, typeOf2, + typeOf, typeOf1, typeOf2, typeOf3, typeOf4, typeOf5, typeOf6, typeOf7, -- * Type-safe cast cast, -- :: (Typeable a, Typeable b) => a -> Maybe b diff --git a/Data/Typeable/Internal.hs b/Data/Typeable/Internal.hs index fc8119c..8994293 100644 --- a/Data/Typeable/Internal.hs +++ b/Data/Typeable/Internal.hs @@ -19,7 +19,6 @@ , FlexibleInstances , MagicHash , KindSignatures - , UndecidableInstances -- JPM: do we accept this? , PolyKinds #-} #ifdef __GLASGOW_HASKELL__ {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} @@ -29,7 +28,7 @@ module Data.Typeable.Internal ( Proxy (..), TypeRep(..), Fingerprint(..), - typeOf, typeOf1, typeOf2, + typeOf, typeOf1, typeOf2, typeOf3, typeOf4, typeOf5, typeOf6, typeOf7, TyCon(..), mkTyCon, mkTyCon3, @@ -49,7 +48,6 @@ module Data.Typeable.Internal ( import GHC.Base import GHC.Word import GHC.Show -import GHC.Err (undefined) import Data.Maybe import Data.List import GHC.Num @@ -189,22 +187,6 @@ tyConString = tyConName -- ------------------------------------------------------------- -{- Note [Memoising typeOf] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -IMPORTANT: we don't want to recalculate the type-rep once per -call to the dummy argument. This is what went wrong in Trac #3245 -So we help GHC by manually keeping the 'rep' *outside* the value -lambda, thus - - typeOfDefault :: forall t a. (Typeable1 t, Typeable a) => t a -> TypeRep - typeOfDefault = \_ -> rep - where - rep = typeOf1 (undefined :: t a) `mkAppTy` - typeOf (undefined :: a) - -Notice the crucial use of scoped type variables here! --} - -- | A proxy type data Proxy t = Proxy @@ -213,11 +195,9 @@ data Proxy t = Proxy class Typeable a where typeRep :: Proxy a -> TypeRep -- ^ Takes a value of type @a@ and returns a concrete representation - -- of that type. The /value/ of the argument should be ignored by - -- any instance of 'Typeable', so that it is safe to pass 'undefined' as - -- the argument. + -- of that type. -{-# DEPRECATED typeOf, typeOf1, typeOf2 "Use typeRep instead" #-} +{-# DEPRECATED typeOf, typeOf1, typeOf2, typeOf3, typeOf4, typeOf5, typeOf6, typeOf7 "Use typeRep instead" #-} typeOf :: forall a. Typeable a => a -> TypeRep typeOf _ = typeRep (Proxy :: Proxy a) @@ -227,17 +207,29 @@ typeOf1 _ = typeRep (Proxy :: Proxy t) typeOf2 :: forall t (a :: *) (b :: *). Typeable t => t a b -> TypeRep typeOf2 _ = typeRep (Proxy :: Proxy t) --- JPM: write the others up to 7 +typeOf3 :: forall t (a :: *) (b :: *) (c :: *). Typeable t + => t a b c -> TypeRep +typeOf3 _ = typeRep (Proxy :: Proxy t) + +typeOf4 :: forall t (a :: *) (b :: *) (c :: *) (d :: *). Typeable t + => t a b c d -> TypeRep +typeOf4 _ = typeRep (Proxy :: Proxy t) + +typeOf5 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *). Typeable t + => t a b c d e -> TypeRep +typeOf5 _ = typeRep (Proxy :: Proxy t) + +typeOf6 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *) (f :: *). + Typeable t => t a b c d e f -> TypeRep +typeOf6 _ = typeRep (Proxy :: Proxy t) --- Given a @Typeable@/n/ instance for an /n/-ary type constructor, --- define the instances for partial applications. --- Programmers using non-GHC implementations must do this manually --- for each type constructor. +typeOf7 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *) (f :: *) + (g :: *). Typeable t => t a b c d e f g -> TypeRep +typeOf7 _ = typeRep (Proxy :: Proxy t) --- | One Typeable instance for all Typeable1 instances -instance (Typeable s, Typeable a) - => Typeable (s a) where - typeRep = undefined -- JPM: To do +-- | Kind-polymorphic Typeable instance for type application +instance (Typeable s, Typeable a) => Typeable (s a) where + typeRep _ = typeRep (Proxy :: Proxy s) `mkAppTy` typeRep (Proxy :: Proxy a) ----------------- Showing TypeReps -------------------- _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
