reflection (empty) → 0.0.0

raw patch · 4 files changed

+207/−0 lines, 4 filesdep +basesetup-changed

Dependencies added: base

Files

Data/Reflection.hs +147/−0
LICENSE +31/−0
Setup.lhs +7/−0
reflection.cabal +22/−0

+ Data/Reflection.hs view

@@ -0,0 +1,147 @@+{-# LANGUAGE KindSignatures, RankNTypes, ScopedTypeVariables, EmptyDataDecls, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}++----------------------------------------------------------------------------+-- |+-- Module     : Data.Reflection+-- Copyright  : 2009 Edward Kmett, 2004 Oleg Kiselyov and Chung-chieh Shan+-- License    : BSD3+--+-- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Stability   : experimental+-- Portability : non-portable (scoped types, MPTCs, rank-n, FFI, kinds)+--+-- Implementation of the Functional Pearl: Implicit Configurations paper by+-- Oleg Kiselyov and Chung-chieh Shan.+--+-- <http://www.cs.rutgers.edu/~ccshan/prepose/prepose.pdf>+--+-- Packaged and updated to work with the current implementation of scoped type +-- variables by Edward Kmett.+--+-------------------------------------------------------------------------------++module Data.Reflection +    ( +    -- * Reflect Integrals+      ReflectNum+    , reflectNum+    , reifyIntegral+    -- * Reflect Lists of Integrals+    , ReflectNums+    , reifyIntegrals+    -- * Reflect Storables+    , ReflectStorable+    , reflectStorable+    , reifyStorable+    -- * Reflect Anything+    , Reflect+    , reflect+    , reify+    ) where++import Foreign.C.Types+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.StablePtr+import Foreign.Storable+import System.IO.Unsafe++data Zero+data Twice s+data Succ s+data Pred s++class ReflectNum s where+    reflectNum :: Num a => s -> a++instance ReflectNum Zero where+    reflectNum _ = 0++instance ReflectNum s => ReflectNum (Twice s) where+    reflectNum _ = reflectNum (undefined :: s) * 2++instance ReflectNum s => ReflectNum (Succ s) where+    reflectNum _ = reflectNum (undefined :: s) + 1++instance ReflectNum s => ReflectNum (Pred s) where+    reflectNum _ = reflectNum (undefined :: s) - 1++reifyIntegral :: Integral a => a -> (forall s. ReflectNum s => s -> w) -> w+reifyIntegral i k = case quotRem i 2 of+    (0, 0) -> k (undefined :: Zero)+    (j, 0) -> reifyIntegral j (\(_ :: s) -> k (undefined :: Twice s))+    (j, 1) -> reifyIntegral j (\(_ :: s) -> k (undefined :: Succ (Twice s)))+    (j,-1) -> reifyIntegral j (\(_ :: s) -> k (undefined :: Pred (Twice s)))+    _      -> undefined++data Nil+data Cons s ss++class ReflectNums ss where+    reflectNums :: Num a => ss -> [a]++instance ReflectNums Nil where+    reflectNums _ = []++instance (ReflectNum s, ReflectNums ss) => ReflectNums (Cons s ss) where+    reflectNums _ = reflectNum (undefined :: s) : reflectNums (undefined :: ss)++reifyIntegrals :: Integral a => [a] -> (forall ss. ReflectNums ss => ss -> w) -> w+reifyIntegrals [] k = k (undefined :: Nil)+reifyIntegrals (i:ii) k = +    reifyIntegral i (\(_ :: s) -> +    reifyIntegrals ii (\(_ :: ss) -> +    k (undefined :: Cons s ss)))++data Store s a ++class ReflectStorable s where+    reflectStorable :: Storable a => s a -> a++instance ReflectNums s => ReflectStorable (Store s) where+    {-# NOINLINE reflectStorable #-}+    reflectStorable _ = unsafePerformIO . alloca $ \p -> do +            pokeArray (castPtr p) bytes+            peek p +        where +            bytes = reflectNums (undefined :: s) :: [CChar]++reifyStorable :: Storable a => a -> (forall s. ReflectStorable s => s a -> w) -> w+reifyStorable a k = reifyIntegrals (bytes :: [CChar]) (\(_ :: s) -> k (undefined :: Store s a))+  where+    bytes = unsafePerformIO $ with a (peekArray (sizeOf a) . castPtr) +{-# NOINLINE reifyStorable #-}++class Reflect s a | s -> a where +    reflect :: s -> a++data Stable (s :: * -> *) a++{-+instance ReflectStorable s => Reflect (Stable s a) a where+    reflect = unsafePerformIO . fmap const . deRefStablePtr $ reflectStorable (undefined :: s p) ++reify :: a -> (forall s. Reflect s a => s -> w) -> w+reify (a :: a) k = unsafePerformIO $ do+        p <- newStablePtr a+        reifyStorable p (\(_ :: s (StablePtr a)) -> return (k (undefined :: Stable s a)))+-}++instance ReflectStorable s => Reflect (Stable s a) a where+    reflect = unsafePerformIO $ do+            a <- deRefStablePtr p+            freeStablePtr p+            return (const a)+        where  +            p = reflectStorable (undefined :: s p)+    {-# NOINLINE reflect #-}++reify :: a -> (forall s. Reflect s a => s -> w) -> w+reify (a :: a) k = unsafePerformIO $ do+        p <- newStablePtr a+        reifyStorable p (\(_ :: s (StablePtr a)) -> +                let k' s = (reflect :: Stable s a -> a) `seq` return (k s) +                in k' (undefined :: Stable s a))+{-# NOINLINE reify #-}

+ LICENSE view

@@ -0,0 +1,31 @@+Copyright (c) 2009 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.

+ Setup.lhs view

@@ -0,0 +1,7 @@+#!/usr/bin/runhaskell+> module Main (main) where++> import Distribution.Simple++> main :: IO ()+> main = defaultMain

+ reflection.cabal view

@@ -0,0 +1,22 @@+name:		    reflection+version:	    0.0.0+license:	    BSD3+license-file:   LICENSE+author:		    Oleg Kiselyov and Chung-chieh Shan+maintainer:	    Edward A. Kmett <ekmett@gmail.com>+stability:	    experimental+homepage:	    http://www.cs.rutgers.edu/~ccshan/prepose/prepose.pdf+category:	    Data+synopsis:	    Functional Pearl: Implicit Configurations+copyright:      2009 Edward A. Kmett, 2004 Oleg Kiselyov and Chung-chieh Shan+description:    Implementation of the code in "Functional Pearl: Implicit Configurations" by Oleg Kiselyov and Chung-chieh Shan+build-type:     Simple+cabal-version:  >=1.2++library+  build-depends: +    base >= 4 && < 4.1+  exposed-modules:+    Data.Reflection+    +  ghc-options: -Wall