reflection-1.2.0.1/0000755000000000000000000000000012125101665012170 5ustar0000000000000000reflection-1.2.0.1/.travis.yml0000644000000000000000000000002212125101665014273 0ustar0000000000000000language: haskell reflection-1.2.0.1/CHANGELOG.markdown0000644000000000000000000000233012125101665015221 0ustar0000000000000000# 1.2 * Added `Given` and give. # 1.1.7 * Fixed an issue caused by changes in GHC 7.7's typechecker by using explicit `ScopedTypeVariables`. # 1.1.6: * Relaxed an unnecessary strictness annotation in the fast implementation # 1.1.5 * Both implementations now work on Hugs; the fast implementation ascends from the ranks of completely unportable black magic to being merely /mostly/ unportable black magic. # 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 the implementation, please contact the author. * Removed `ReifiedNum`, `reflectNum`, and `reifyIntegral`; `reify` and `reflect` are about 3 orders of magnitude faster than the special case combinators were. # 0.5 * Generalized the type signatures in reflect to allow you to pass any type with kind `* -> *` wrapped around the desired type as the phantom type argument rather than just a `Proxy`. # 0.4 * Converted from `Data.Tagged` to using `Data.Proxy` for reflection. This reduces the need for helper functions and scoped type variables in user code. reflection-1.2.0.1/LICENSE0000644000000000000000000000305312125101665013176 0ustar0000000000000000Copyright (c) 2009-2013 Edward Kmett Copyright (c) 2004 Oleg Kiselyov and Chung-chieh Shan All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Edward Kmett nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. reflection-1.2.0.1/README.markdown0000644000000000000000000000115512125101665014673 0ustar0000000000000000reflection ========== [![Build Status](https://secure.travis-ci.org/ekmett/reflection.png?branch=master)](http://travis-ci.org/ekmett/reflecton) This package provides an implementation of the ideas presented in [Functional Pearl: Implicit Configurations](http://www.cs.rutgers.edu/~ccshan/prepose/prepose.pdf) by Oleg Kiselyov and Chung-Chieh Shan. However, the API has been implemented in a much more efficient manner. Contact Information ------------------- Contributions and bug reports are welcome! Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net. -Edward Kmett reflection-1.2.0.1/reflection.cabal0000644000000000000000000000411012125101665015302 0ustar0000000000000000name: reflection version: 1.2.0.1 license: BSD3 license-file: LICENSE author: Edward A. Kmett, Elliott Hird, Oleg Kiselyov and Chung-chieh Shan maintainer: Edward A. Kmett stability: experimental homepage: http://github.com/ekmett/reflection bug-reports: http://github.com/ekmett/reflection/issues category: Data, Reflection, Dependent Types synopsis: Reifies arbitrary terms into types that can be reflected back into terms copyright: 2009-2013 Edward A. Kmett, 2012 Elliott Hird, 2004 Oleg Kiselyov and Chung-chieh Shan build-type: Simple cabal-version: >= 1.10 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 streamlined to improve performance. . The original paper can be obtained from . extra-source-files: examples/Monoid.hs examples/Constraints.hs examples/Benchmark.hs CHANGELOG.markdown README.markdown slow/Data/Reflection.hs fast/Data/Reflection.hs .travis.yml -- If you enable this flag, we use a more portable much much slower implementation. -- Moreover, the 'Given' API is broken, so this is currently an unsupported configuration. -- -- If you feel the need to turn on this flag for any reason, please email the maintainer! flag slow default: False manual: False source-repository head type: git location: git://github.com/ekmett/reflection.git library ghc-options: -Wall if impl(ghc >= 7.2) default-extensions: Trustworthy build-depends: base >= 2 && < 5, tagged >= 0.4.4 && < 1 default-language: Haskell98 if !flag(slow) && (impl(ghc) || impl(hugs)) hs-source-dirs: fast else other-extensions: ScopedTypeVariables, FlexibleInstances hs-source-dirs: slow other-extensions: MultiParamTypeClasses, FunctionalDependencies, Rank2Types, CPP exposed-modules: Data.Reflection reflection-1.2.0.1/Setup.lhs0000644000000000000000000000016512125101665014002 0ustar0000000000000000#!/usr/bin/runhaskell > module Main (main) where > import Distribution.Simple > main :: IO () > main = defaultMain reflection-1.2.0.1/examples/0000755000000000000000000000000012125101665014006 5ustar0000000000000000reflection-1.2.0.1/examples/Benchmark.hs0000644000000000000000000000054212125101665016235 0ustar0000000000000000import Criterion.Main import qualified Data.Reflection as Old import qualified Data.NewReflection as New old :: [Int] -> [Int] old = map (\x -> Old.reify x Old.reflect) new :: [Int] -> [Int] new = map (\x -> New.reify x New.reflect) main :: IO () main = defaultMain [ bench "old" $ nf old [1..100000] , bench "new" $ nf new [1..100000] ] reflection-1.2.0.1/examples/Constraints.hs0000644000000000000000000000520312125101665016651 0ustar0000000000000000{-# 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 import Data.Monoid -- from base import Data.Proxy -- from tagged import Data.Reflection -- from reflection -- | Values in our dynamically constructed monoid over 'a' newtype Lift (p :: * -> Constraint) (a :: *) (s :: *) = Lift { lower :: a } class ReifiableConstraint p where data Def (p :: * -> Constraint) (a :: *) reifiedIns :: Reifies s (Def p a) :- p (Lift p a s) instance Newtype (Lift p a s) a where pack = Lift unpack = lower -- > ghci> with (Monoid (+) 0) $ mempty <> Lift 2 -- > 2 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. Reifies s (Def p a) => Proxy s -> r) -> r reifyInstance = reify asProxyOf :: f s -> Proxy s -> f s asProxyOf a _ = a -- > using (Monoid (+) 0) $ mappend mempty 12 -- > 12 using :: forall p a. ReifiableConstraint p => Def p a -> (p a => a) -> a using d m = reify d $ \(_ :: Proxy s) -> m \\ trans (unsafeCoerceConstraint :: (p (Lift p a s) :- p a)) reifiedIns usingT :: forall p f a. ReifiableConstraint p => Def p a -> (p a => f a) -> f a usingT d m = reify d $ \(_ :: Proxy s) -> m \\ trans (unsafeCoerceConstraint :: (p (Lift p a s) :- p a)) reifiedIns instance ReifiableConstraint Monoid where data Def Monoid a = Monoid { mappend_ :: a -> a -> a, mempty_ :: a } reifiedIns = Sub Dict 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) data ClassProxy (p :: * -> Constraint) = ClassProxy given :: ClassProxy c -> p s -> a -> Lift c a s given _ _ = Lift eq :: ClassProxy Eq eq = ClassProxy ord :: ClassProxy Ord ord = ClassProxy monoid :: ClassProxy Monoid monoid = ClassProxy instance ReifiableConstraint Eq where data Def Eq a = Eq { eq_ :: a -> a -> Bool } reifiedIns = Sub Dict instance Reifies s (Def Eq a) => Eq (Lift Eq a s) where a == b = eq_ (reflect a) (lower a) (lower b) instance ReifiableConstraint Ord where data Def Ord a = Ord { compare_ :: a -> a -> Ordering } reifiedIns = Sub Dict instance Reifies s (Def Ord a) => Eq (Lift Ord a s) where a == b = compare a b == EQ instance Reifies s (Def Ord a) => Ord (Lift Ord a s) where compare a b = compare_ (reflect a) (lower a) (lower b) reflection-1.2.0.1/examples/Monoid.hs0000644000000000000000000000162612125101665015574 0ustar0000000000000000{-# LANGUAGE Rank2Types, FlexibleContexts, UndecidableInstances #-} import Data.Reflection -- from reflection import Data.Monoid -- from base import Data.Proxy -- from tagged -- | Values in our dynamically-constructed 'Monoid' over 'a' newtype M a s = M { runM :: a } deriving (Eq,Ord) -- | A dictionary describing a 'Monoid' data Monoid_ a = Monoid_ { mappend_ :: a -> a -> a, mempty_ :: a } 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) -- Construct a 'Monoid' instance out of a binary operation and unit that you have in scope! -- -- > ghci> withMonoid (+) 0 $ mempty <> M 2 -- > 2 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 asProxyOf a _ = a reflection-1.2.0.1/fast/0000755000000000000000000000000012125101665013125 5ustar0000000000000000reflection-1.2.0.1/fast/Data/0000755000000000000000000000000012125101665013776 5ustar0000000000000000reflection-1.2.0.1/fast/Data/Reflection.hs0000644000000000000000000000622412125101665016430 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Rank2Types #-} ---------------------------------------------------------------------------- -- | -- Module : Data.Reflection -- Copyright : 2009-2013 Edward Kmett, -- 2012 Elliott Hird, -- 2004 Oleg Kiselyov and Chung-chieh Shan -- License : BSD3 -- -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- Reifies arbitrary terms at the type level. Based on the Functional -- Pearl: Implicit Configurations paper by Oleg Kiselyov and -- Chung-chieh Shan. -- -- -- -- The approach from the paper was modified to work with Data.Proxy -- and to cheat by using knowledge of GHC's internal representations -- by Edward Kmett and Elliott Hird. -- -- Usage comes down to two combinators, 'reify' and 'reflect'. -- -- >>> reify 6 (\p -> reflect p + reflect p) -- 12 -- -- The argument passed along by reify is just a @data 'Proxy' t = -- Proxy@, so all of the information needed to reconstruct your value -- has been moved to the type level. This enables it to be used when -- constructing instances (see @examples/Monoid.hs@). -- -- In addition, a simpler API is offered for working with singleton -- values such as a system configuration, etc. ------------------------------------------------------------------------------- module Data.Reflection ( -- * Reflection Reifies(..) , reify -- * Given , Given(..) , give ) where import Data.Proxy #ifdef __HUGS__ import Hugs.IOExts #else import Unsafe.Coerce #endif ------------------------------------------------------------------------------ -- Reifies ------------------------------------------------------------------------------ class Reifies s a | s -> a where -- | Recover a value inside a 'reify' context, given a proxy for its -- reified type. reflect :: proxy s -> a newtype Magic a r = Magic (forall s. Reifies s a => Proxy s -> r) -- | Reify a value at the type level, to be recovered with 'reflect'. reify :: forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r reify a k = unsafeCoerce (Magic k :: Magic a r) (const a) Proxy {-# INLINE reify #-} ------------------------------------------------------------------------------ -- Given ------------------------------------------------------------------------------ -- | This is a version of 'Reifies' that allows for only a single value. -- -- This is easier to work with than 'Reifies' and permits extended defaulting, -- but it only offers a single reflected value of a given type at a time. class Given a where -- | Recover the value of a given type previously encoded with 'give'. given :: a newtype Gift a r = Gift (Given a => r) -- | Reify a value into an instance to be recovered with 'given'. -- -- You should only 'give' a single value for each type. If multiple instances -- are in scope, then the behavior is implementation defined. give :: forall a r. a -> (Given a => r) -> r give a k = unsafeCoerce (Gift k :: Gift a r) a {-# INLINE give #-} reflection-1.2.0.1/slow/0000755000000000000000000000000012125101665013154 5ustar0000000000000000reflection-1.2.0.1/slow/Data/0000755000000000000000000000000012125101665014025 5ustar0000000000000000reflection-1.2.0.1/slow/Data/Reflection.hs0000644000000000000000000001623512125101665016462 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE Rank2Types #-} {-# OPTIONS_GHC -fno-cse #-} {-# OPTIONS_GHC -fno-full-laziness #-} {-# OPTIONS_GHC -fno-float-in #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-} ---------------------------------------------------------------------------- -- | -- Module : Data.Reflection -- Copyright : 2009-2012 Edward Kmett, -- 2012 Elliott Hird, -- 2004 Oleg Kiselyov and Chung-chieh Shan -- License : BSD3 -- -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- Reifies arbitrary terms at the type level. Based on the Functional -- Pearl: Implicit Configurations paper by Oleg Kiselyov and -- Chung-chieh Shan. -- -- -- -- The approach from the paper was modified to work with Data.Proxy -- and streamline the API by Edward Kmett and Elliott Hird. -- -- Usage comes down to two combinators, 'reify' and 'reflect'. -- -- >>> reify 6 (\p -> reflect p + reflect p) -- 12 -- -- The argument passed along by reify is just a @data 'Proxy' t = -- Proxy@, so all of the information needed to reconstruct your value -- has been moved to the type level. This enables it to be used when -- constructing instances (see @examples/Monoid.hs@). ------------------------------------------------------------------------------- module Data.Reflection ( Reifies(..) , reify ) where import Foreign.Ptr import Foreign.StablePtr import System.IO.Unsafe import Control.Applicative import Data.Proxy import Data.Bits import Data.Word #ifdef __HUGS__ #define unsafeDupablePerformIO unsafePerformIO #endif class B s where reflectByte :: proxy s -> IntPtr #define CAT(a,b) a/**/b #define BYTES(GO) \ GO(0) GO(1) GO(2) GO(3) GO(4) GO(5) GO(6) GO(7) GO(8) GO(9) GO(10) GO(11) \ GO(12) GO(13) GO(14) GO(15) GO(16) GO(17) GO(18) GO(19) GO(20) GO(21) GO(22) \ GO(23) GO(24) GO(25) GO(26) GO(27) GO(28) GO(29) GO(30) GO(31) GO(32) GO(33) \ GO(34) GO(35) GO(36) GO(37) GO(38) GO(39) GO(40) GO(41) GO(42) GO(43) GO(44) \ GO(45) GO(46) GO(47) GO(48) GO(49) GO(50) GO(51) GO(52) GO(53) GO(54) GO(55) \ GO(56) GO(57) GO(58) GO(59) GO(60) GO(61) GO(62) GO(63) GO(64) GO(65) GO(66) \ GO(67) GO(68) GO(69) GO(70) GO(71) GO(72) GO(73) GO(74) GO(75) GO(76) GO(77) \ GO(78) GO(79) GO(80) GO(81) GO(82) GO(83) GO(84) GO(85) GO(86) GO(87) GO(88) \ GO(89) GO(90) GO(91) GO(92) GO(93) GO(94) GO(95) GO(96) GO(97) GO(98) GO(99) \ GO(100) GO(101) GO(102) GO(103) GO(104) GO(105) GO(106) GO(107) GO(108) \ GO(109) GO(110) GO(111) GO(112) GO(113) GO(114) GO(115) GO(116) GO(117) \ GO(118) GO(119) GO(120) GO(121) GO(122) GO(123) GO(124) GO(125) GO(126) \ GO(127) GO(128) GO(129) GO(130) GO(131) GO(132) GO(133) GO(134) GO(135) \ GO(136) GO(137) GO(138) GO(139) GO(140) GO(141) GO(142) GO(143) GO(144) \ GO(145) GO(146) GO(147) GO(148) GO(149) GO(150) GO(151) GO(152) GO(153) \ GO(154) GO(155) GO(156) GO(157) GO(158) GO(159) GO(160) GO(161) GO(162) \ GO(163) GO(164) GO(165) GO(166) GO(167) GO(168) GO(169) GO(170) GO(171) \ GO(172) GO(173) GO(174) GO(175) GO(176) GO(177) GO(178) GO(179) GO(180) \ GO(181) GO(182) GO(183) GO(184) GO(185) GO(186) GO(187) GO(188) GO(189) \ GO(190) GO(191) GO(192) GO(193) GO(194) GO(195) GO(196) GO(197) GO(198) \ GO(199) GO(200) GO(201) GO(202) GO(203) GO(204) GO(205) GO(206) GO(207) \ GO(208) GO(209) GO(210) GO(211) GO(212) GO(213) GO(214) GO(215) GO(216) \ GO(217) GO(218) GO(219) GO(220) GO(221) GO(222) GO(223) GO(224) GO(225) \ GO(226) GO(227) GO(228) GO(229) GO(230) GO(231) GO(232) GO(233) GO(234) \ GO(235) GO(236) GO(237) GO(238) GO(239) GO(240) GO(241) GO(242) GO(243) \ GO(244) GO(245) GO(246) GO(247) GO(248) GO(249) GO(250) GO(251) GO(252) \ GO(253) GO(254) GO(255) #define GO(n) \ newtype CAT(T,n) = CAT(T,n) CAT(T,n); \ instance B CAT(T,n) where { \ reflectByte _ = n \ }; BYTES(GO) #undef GO impossible :: a impossible = error "Data.Reflection.reifyByte: impossible" reifyByte :: Word8 -> (forall s. B s => Proxy s -> r) -> r reifyByte w k = case w of { #define GO(n) n -> k (Proxy :: Proxy CAT(T,n)); BYTES(GO) #undef GO _ -> impossible } class Reifies s a | s -> a where -- | Recover a value inside a 'reify' context, given a proxy for its -- reified type. reflect :: proxy s -> a newtype Stable b0 b1 b2 b3 b4 b5 b6 b7 a = Stable (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) stable :: p b0 -> p b1 -> p b2 -> p b3 -> p b4 -> p b5 -> p b6 -> p b7 -> Proxy (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) stable _ _ _ _ _ _ _ _ = Proxy {-# INLINE stable #-} stablePtrToIntPtr :: StablePtr a -> IntPtr stablePtrToIntPtr = ptrToIntPtr . castStablePtrToPtr {-# INLINE stablePtrToIntPtr #-} intPtrToStablePtr :: IntPtr -> StablePtr a intPtrToStablePtr = castPtrToStablePtr . intPtrToPtr {-# INLINE intPtrToStablePtr #-} byte0 :: p (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) -> Proxy b0 byte0 _ = Proxy byte1 :: p (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) -> Proxy b1 byte1 _ = Proxy byte2 :: p (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) -> Proxy b2 byte2 _ = Proxy byte3 :: p (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) -> Proxy b3 byte3 _ = Proxy byte4 :: p (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) -> Proxy b4 byte4 _ = Proxy byte5 :: p (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) -> Proxy b5 byte5 _ = Proxy byte6 :: p (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) -> Proxy b6 byte6 _ = Proxy byte7 :: p (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) -> Proxy b7 byte7 _ = Proxy argument :: (p s -> r) -> Proxy s argument _ = Proxy instance (B b0, B b1, B b2, B b3, B b4, B b5, B b6, B b7) => Reifies (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) a where reflect = r where r = unsafePerformIO $ const <$> deRefStablePtr p <* freeStablePtr p s = argument r p = intPtrToStablePtr $ reflectByte (byte0 s) .|. (reflectByte (byte1 s) `shiftL` 8) .|. (reflectByte (byte2 s) `shiftL` 16) .|. (reflectByte (byte3 s) `shiftL` 24) .|. (reflectByte (byte4 s) `shiftL` 32) .|. (reflectByte (byte5 s) `shiftL` 40) .|. (reflectByte (byte6 s) `shiftL` 48) .|. (reflectByte (byte7 s) `shiftL` 56) {-# NOINLINE reflect #-} -- 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 :: Reifies s a => (Proxy s -> b) -> proxy s -> b reflectBefore f = const $! f Proxy {-# NOINLINE reflectBefore #-} -- | Reify a value at the type level, to be recovered with 'reflect'. reify :: a -> (forall s. (Reifies s a) => Proxy s -> r) -> r reify a k = unsafeDupablePerformIO $ do p <- newStablePtr a let n = stablePtrToIntPtr p reifyByte (fromIntegral n) (\s0 -> reifyByte (fromIntegral (n `shiftR` 8)) (\s1 -> reifyByte (fromIntegral (n `shiftR` 16)) (\s2 -> reifyByte (fromIntegral (n `shiftR` 24)) (\s3 -> reifyByte (fromIntegral (n `shiftR` 32)) (\s4 -> reifyByte (fromIntegral (n `shiftR` 40)) (\s5 -> reifyByte (fromIntegral (n `shiftR` 48)) (\s6 -> reifyByte (fromIntegral (n `shiftR` 56)) (\s7 -> reflectBefore (fmap return k) $ stable s0 s1 s2 s3 s4 s5 s6 s7))))))))