reflection 1.0 → 1.1
raw patch · 5 files changed
+47/−102 lines, 5 files
Files
- examples/Constraints.hs +8/−8
- examples/Monoid.hs +3/−3
- fast/Data/Reflection.hs +7/−12
- reflection.cabal +18/−52
- slow/Data/Reflection.hs +11/−27
examples/Constraints.hs view
@@ -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)
examples/Monoid.hs view
@@ -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
fast/Data/Reflection.hs view
@@ -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
reflection.cabal view
@@ -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 <http://www.cs.rutgers.edu/~ccshan/prepose/prepose.pdf> .- /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+
slow/Data/Reflection.hs view
@@ -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