[auto ekmett@gmail.com**20090330013513] { addfile ./doc/html/monoids/Data-Reflection.html addfile ./doc/html/monoids/src/Data-Reflection.html hunk ./doc/html/monoids/Data-Reflection.html 1 + + +Data.Reflection
monoids-0.1.15: Lots of MonoidsSource codeContentsIndex
Data.Reflection
Contents
Reflecteding Integrals +
Reflecteding Lists of Integrals +
Reflecteding Storables +
Synopsis
class ReflectedNum s where
reflectNum :: Num a => s -> a
reflectNum :: (ReflectedNum s, Num a) => s -> a
reifyIntegral :: Integral a => a -> (forall s. ReflectedNum s => s -> w) -> w
class ReflectedNums ss
reifyIntegrals :: Integral a => [a] -> (forall ss. ReflectedNums ss => ss -> w) -> w
class ReflectedStorable s where
reflectStorable :: Storable a => s a -> a
reflectStorable :: (ReflectedStorable s, Storable a) => s a -> a
reifyStorable :: Storable a => a -> (forall s. ReflectedStorable s => s a -> w) -> w
class Reflected s a | s -> a where
reflect :: s -> a
reflect :: Reflected s a => s -> a
reify :: a -> (forall s. Reflected s a => s -> w) -> w
Reflecteding Integrals +
class ReflectedNum s whereSource
Methods
reflectNum :: Num a => s -> aSource
show/hide Instances
reflectNum :: (ReflectedNum s, Num a) => s -> aSource
reifyIntegral :: Integral a => a -> (forall s. ReflectedNum s => s -> w) -> wSource
Reflecteding Lists of Integrals +
class ReflectedNums ss Source
show/hide Instances
reifyIntegrals :: Integral a => [a] -> (forall ss. ReflectedNums ss => ss -> w) -> wSource
Reflecteding Storables +
class ReflectedStorable s whereSource
Methods
reflectStorable :: Storable a => s a -> aSource
show/hide Instances
reflectStorable :: (ReflectedStorable s, Storable a) => s a -> aSource
reifyStorable :: Storable a => a -> (forall s. ReflectedStorable s => s a -> w) -> wSource
class Reflected s a | s -> a whereSource
Methods
reflect :: s -> aSource
show/hide Instances
ReflectedStorable s => Reflected (Stable s a) a
reflect :: Reflected s a => s -> aSource
reify :: a -> (forall s. Reflected s a => s -> w) -> wSource
Produced by Haddock version 2.3.0
hunk ./doc/html/monoids/doc-index.html 1519 +>reflectData.ReflectionReflectedData.ReflectionReflectedNumData.ReflectionReflectedNumsData.ReflectionReflectedStorableData.ReflectionreflectNumData.ReflectionreflectStorableData.ReflectionreifyData.ReflectionreifyIntegralData.ReflectionreifyIntegralsData.ReflectionreifyStorableData.ReflectionData.Reflection + + + +Data/Reflection.hs + + + +
{-# LANGUAGE RankNTypes, ScopedTypeVariables, EmptyDataDecls, TypeFamilies, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
+
+module Data.Reflection 
+    ( 
+    -- * Reflecteding Integrals
+      ReflectedNum
+    , reflectNum
+    , reifyIntegral
+    -- * Reflecteding Lists of Integrals
+    , ReflectedNums
+    , reifyIntegrals
+    -- * Reflecteding Storables
+    , ReflectedStorable
+    , reflectStorable
+    , reifyStorable
+    , Reflected
+    , 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 ReflectedNum s where
+    reflectNum :: Num a => s -> a
+
+instance ReflectedNum Zero where
+    reflectNum _ = 0
+
+instance ReflectedNum s => ReflectedNum (Twice s) where
+    reflectNum _ = reflectNum (undefined :: s) * 2
+
+instance ReflectedNum s => ReflectedNum (Succ s) where
+    reflectNum _ = reflectNum (undefined :: s) + 1
+
+instance ReflectedNum s => ReflectedNum (Pred s) where
+    reflectNum _ = reflectNum (undefined :: s) - 1
+
+reifyIntegral :: Integral a => a -> (forall s. ReflectedNum 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 ReflectedNums ss where
+    reflectNums :: Num a => ss -> [a]
+
+instance ReflectedNums Nil where
+    reflectNums _ = []
+
+instance (ReflectedNum s, ReflectedNums ss) => ReflectedNums (Cons s ss) where
+    reflectNums _ = reflectNum (undefined :: s) : reflectNums (undefined :: ss)
+
+reifyIntegrals :: Integral a => [a] -> (forall ss. ReflectedNums 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 ReflectedStorable s where
+    reflectStorable :: Storable a => s a -> a
+
+instance ReflectedNums s => ReflectedStorable (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. ReflectedStorable 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 Reflected s a | s -> a where 
+    reflect :: s -> a
+
+data Stable (s :: * -> *) a
+
+{-
+instance ReflectedStorable s => Reflected (Stable s a) a where
+    reflect = unsafePerformIO . fmap const . deRefStablePtr $ reflectStorable (undefined :: s p) 
+
+reify :: a -> (forall s. Reflected 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 ReflectedStorable s => Reflected (Stable s a) a where
+    reflect = unsafePerformIO $ do
+            a <- deRefStablePtr p
+            freeStablePtr p
+            return (const a)
+        where  
+            p = reflectStorable (undefined :: s p)
+
+reify :: a -> (forall s. Reflected 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))
+
+ }