diff --git a/examples/Constraints.hs b/examples/Constraints.hs --- a/examples/Constraints.hs +++ b/examples/Constraints.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE Rank2Types, TypeFamilies, TypeOperators, ConstraintKinds, PolyKinds, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-} +{-# LANGUAGE Rank2Types, TypeFamilies, TypeOperators, ConstraintKinds, PolyKinds, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, FlexibleContexts, UndecidableInstances #-} import Control.Newtype -- from newtype import Data.Constraint -- from constraints import Data.Constraint.Unsafe -- from constraints @@ -11,7 +11,7 @@ class ReifiableConstraint p where data Def (p :: * -> Constraint) (a :: *) - reifiedIns :: (Reified s, Reflected s ~ Def p a) :- p (Lift p a s) + reifiedIns :: Reifies s (Def p a) :- p (Lift p a s) instance Newtype (Lift p a s) a where pack = Lift @@ -19,10 +19,10 @@ -- > ghci> with (Monoid (+) 0) $ mempty <> Lift 2 -- > 2 -with :: Def p a -> (forall s. (Reified s, Reflected s ~ Def p a) => Lift p a s) -> a +with :: Def p a -> (forall s. Reifies s (Def p a) => Lift p a s) -> a with d v = reify d $ lower . asProxyOf v -reifyInstance :: Def p a -> (forall s. (Reified s, Reflected s ~ Def p a) => Proxy s -> r) -> r +reifyInstance :: Def p a -> (forall s. Reifies s (Def p a) => Proxy s -> r) -> r reifyInstance = reify asProxyOf :: f s -> Proxy s -> f s @@ -40,13 +40,13 @@ data Def Monoid a = Monoid { mappend_ :: a -> a -> a, mempty_ :: a } reifiedIns = Sub Dict -instance (Reified s, Reflected s ~ Def Monoid a) => Monoid (Lift Monoid a s) where +instance Reifies s (Def Monoid a) => Monoid (Lift Monoid a s) where mappend a b = Lift $ mappend_ (reflect a) (lower a) (lower b) mempty = a where a = Lift $ mempty_ (reflect a) instance ReifiableConstraint Eq where - data Def Eq a = Eq { eq :: a -> a -> Bool } + data Def Eq a = Eq { eq_ :: a -> a -> Bool } reifiedIns = Sub Dict -instance (Reified s, Reflected s ~ Def Eq a) => Eq (Lift Eq a s) where - a == b = eq (reflect a) (lower a) (lower b) +instance Reifies s (Def Eq a) => Eq (Lift Eq a s) where + a == b = eq_ (reflect a) (lower a) (lower b) diff --git a/examples/Monoid.hs b/examples/Monoid.hs --- a/examples/Monoid.hs +++ b/examples/Monoid.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE Rank2Types, TypeFamilies #-} +{-# LANGUAGE Rank2Types, TypeFamilies, FlexibleContexts, UndecidableInstances #-} import Data.Reflection -- from reflection import Data.Monoid -- from base import Data.Proxy -- from tagged @@ -9,13 +9,13 @@ -- | A dictionary describing the contents of a monoid data Monoid_ a = Monoid_ { mappend_ :: a -> a -> a, mempty_ :: a } -instance (Reified s, Reflected s ~ Monoid_ a) => Monoid (M a s) where +instance Reifies s (Monoid_ a) => Monoid (M a s) where mappend a b = M $ mappend_ (reflect a) (runM a) (runM b) mempty = a where a = M $ mempty_ (reflect a) -- > ghci> withMonoid (+) 0 $ mempty <> M 2 -- > 2 -withMonoid :: (a -> a -> a) -> a -> (forall s. (Reified s, Reflected s ~ Monoid_ a) => M a s) -> a +withMonoid :: (a -> a -> a) -> a -> (forall s. Reifies s (Monoid_ a) => M a s) -> a withMonoid f z v = reify (Monoid_ f z) (runM . asProxyOf v) asProxyOf :: f s -> Proxy s -> f s diff --git a/fast/Data/Reflection.hs b/fast/Data/Reflection.hs --- a/fast/Data/Reflection.hs +++ b/fast/Data/Reflection.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeFamilies, Rank2Types, GADTs #-} +{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, Rank2Types #-} ---------------------------------------------------------------------------- -- | -- Module : Data.Reflection @@ -33,23 +33,18 @@ module Data.Reflection ( -- * Reifying any term at the type level - Reified(..) + Reifies(..) , reify ) where import Data.Proxy import Unsafe.Coerce -class Reified s where - type Reflected s - reflect :: p s -> Reflected s - -data Equal a b where Refl :: Equal a a +class Reifies s a | s -> a where + reflect :: p s -> a -newtype Magic a w = Magic (forall s. Reified s => Equal (Reflected s) a -> Proxy s -> w) +newtype Magic a w = Magic (forall s. Reifies s a => Proxy s -> w) -reify' :: a -> (forall s. Reified s => Equal (Reflected s) a -> Proxy s -> w) -> w -reify' a k = (unsafeCoerce (Magic k) $! const a) (unsafeCoerce Refl) Proxy +reify :: a -> (forall s. Reifies s a => Proxy s -> w) -> w +reify a k = (unsafeCoerce (Magic k) $! const a) Proxy -reify :: a -> (forall s. (Reified s, Reflected s ~ a) => Proxy s -> w) -> w -reify a k = reify' a $ \Refl p -> k p diff --git a/reflection.cabal b/reflection.cabal --- a/reflection.cabal +++ b/reflection.cabal @@ -1,5 +1,5 @@ name: reflection -version: 1.0 +version: 1.1 license: BSD3 license-file: LICENSE author: Edward A. Kmett, Elliott Hird, Oleg Kiselyov and Chung-chieh Shan @@ -7,7 +7,7 @@ stability: experimental homepage: http://github.com/ekmett/reflection category: Data, Reflection, Dependent Types -synopsis: Functional Pearl: Implicit Configurations +synopsis: Reifies arbitrary terms into types that can be reflected back into terms copyright: 2009-2012 Edward A. Kmett, 2012 Elliott Hird, 2004 Oleg Kiselyov and Chung-chieh Shan @@ -16,54 +16,18 @@ description: This package provides an implementation of the ideas presented in the paper \"Functional Pearl: Implicit Configurations\" by Oleg Kiselyov and - Chung-chieh Shan. However, the API has been modified to use @TypeFamilies@ and - the implementation has been streamlined to improve performance. + Chung-chieh Shan. However, the API has been streamlined to improve performance. . The original paper can be obtained from . - /Changes in 1.0/: + /Changes from 0.5 to 1.1/: . * Much faster implementation available that is about 50 /times/ faster than 0.9 and which runs purely on black magic. This version is now used by default. To turn it off install with the 'slow' flag. If you encounter a problem with implementation, please contact the author. . - /Changes in 0.9/: - . - * Faster internal implementation, about 40 percent faster than 0.8. - . * Removed @ReifiedNum@, @reflectNum@, and @reifyIntegral@; @reify@ and @reflect@ are - considerably faster than the special case combinators were. - . - /Changes in 0.8/: - . - * Switched to using type families to avoid a problem where the user could cast - @Proxy (s a) -> Proxy (s b)@ and get back a values with the wrong type under - the API in effect from 0.6. This API yields a much nicer example as well. - . - * Removed @reflectT@ as it no longer makes sense. - . - * Added a more advanced example @example/Constraints.hs@ using constraint kinds. - . - /Changes in 0.7/: - . - * Uses a much simpler construction where @reify@ now converts a @StablePtr@ to an - @IntPtr@ and reifies that directly as an integral type rather than serializing - and storing the StablePtr as a list of bytes as proposed in the original paper. - . - * Removed @ReifiedStorable@ and @ReifiedNums@. - . - * Since we have so many fewer classes now, @Data.Reflection.Internal@ was merged back - into @Data.Reflection@ - . - /Changes in 0.6/: - . - * Removed the dependency on multiparameter type classes, functional - dependencies, and flexible instances, by making @Reifies@ a single - parameter type class in the same fashion as @ReifiesStorable@. - . - * Moved the building blocks to @Data.Reflection.Internal@ to reduce API clutter. - . - * Added @reflectT@ + about 3 orders of magnitude faster than the special case combinators were. . /Changes in 0.5/: . @@ -94,19 +58,21 @@ location: git://github.com/ekmett/reflection.git library + ghc-options: -Wall + + build-depends: + base >= 4 && < 5, + tagged >= 0.2.3 && < 0.3 + default-language: Haskell2010 - other-extensions: Rank2Types, TypeFamilies - if !flag(slow) && impl(ghc) - other-extensions: GADTs + + if impl(ghc) && !flag(slow) hs-source-dirs: fast else - default-extensions: CPP - other-extensions: ScopedTypeVariables + other-extensions: ScopedTypeVariables, FlexibleInstances hs-source-dirs: slow - if flag(slow) && impl(ghc) - other-extensions: MagicHash - build-depends: - base >= 4 && < 5, - tagged >= 0.2.3 && < 0.3 + + other-extensions: MultiParamTypeClasses, FunctionalDependencies, Rank2Types + exposed-modules: Data.Reflection - ghc-options: -Wall + diff --git a/slow/Data/Reflection.hs b/slow/Data/Reflection.hs --- a/slow/Data/Reflection.hs +++ b/slow/Data/Reflection.hs @@ -1,11 +1,8 @@ --- CPP is provided by default-extensions, because it may not work in some compilers to #ifdef a pragma otherwise -{-# LANGUAGE CPP #-} -{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -#ifdef __GLASGOW_HASKELL__ -{-# LANGUAGE MagicHash #-} -#endif +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE Rank2Types #-} {-# OPTIONS_GHC -fno-cse -fno-full-laziness -fno-float-in -fno-warn-unused-binds #-} ---------------------------------------------------------------------------- -- | @@ -41,7 +38,7 @@ module Data.Reflection ( -- * Reifying any term at the type level - Reified(..) + Reifies(..) , reify ) where @@ -51,9 +48,7 @@ import Control.Applicative import Data.Proxy import Data.Bits -#ifdef __GLASGOW_HASKELL__ -import GHC.Word -#endif +import Data.Word class B s where reflectByte :: p s -> IntPtr @@ -101,25 +96,15 @@ impossible = error "Data.Reflection.reifyByte: impossible" reifyByte :: Word8 -> (forall s. B s => Proxy s -> w) -> w -#ifdef __GLASGOW_HASKELL__ -reifyByte (W8# w) k = case w of { -#define GO(n) n## -> k (Proxy :: Proxy CAT(T,n)); -BYTES(GO) -#undef GO -_ -> impossible -} -#else reifyByte w k = case w of { #define GO(n) n -> k (Proxy :: Proxy CAT(T,n)); BYTES(GO) #undef GO _ -> impossible } -#endif -class Reified s where - type Reflected s - reflect :: p s -> Reflected s +class Reifies s a | s -> a where + reflect :: p s -> a newtype Stable b0 b1 b2 b3 b4 b5 b6 b7 a = Stable (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) @@ -138,8 +123,7 @@ {-# INLINE intPtrToStablePtr #-} instance (B b0, B b1, B b2, B b3, B b4, B b5, B b6, B b7) - => Reified (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) where - type Reflected (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) = a + => Reifies (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) a where reflect = unsafePerformIO $ const <$> deRefStablePtr p <* freeStablePtr p where p = intPtrToStablePtr $ reflectByte (Proxy :: Proxy b0) .|. @@ -154,11 +138,11 @@ -- This had to be moved to the top level, due to an apparent bug in -- the ghc inliner introduced in ghc 7.0.x -reflectBefore :: Reified s => (Proxy s -> b) -> proxy s -> b +reflectBefore :: Reifies s a => (Proxy s -> b) -> proxy s -> b reflectBefore f = const $! f Proxy {-# NOINLINE reflectBefore #-} -reify :: a -> (forall s. (Reified s, Reflected s ~ a) => Proxy s -> w) -> w +reify :: a -> (forall s. (Reifies s a) => Proxy s -> w) -> w reify a k = unsafeDupablePerformIO $ do p <- newStablePtr a let n = stablePtrToIntPtr p