diff options
Diffstat (limited to 'packages/base')
-rw-r--r-- | packages/base/src/Internal/Specialized.hs | 28 |
1 files changed, 24 insertions, 4 deletions
diff --git a/packages/base/src/Internal/Specialized.hs b/packages/base/src/Internal/Specialized.hs index 3738f79..5f89779 100644 --- a/packages/base/src/Internal/Specialized.hs +++ b/packages/base/src/Internal/Specialized.hs | |||
@@ -10,6 +10,7 @@ | |||
10 | {-# LANGUAGE KindSignatures #-} | 10 | {-# LANGUAGE KindSignatures #-} |
11 | {-# LANGUAGE ViewPatterns #-} | 11 | {-# LANGUAGE ViewPatterns #-} |
12 | {-# LANGUAGE LambdaCase #-} | 12 | {-# LANGUAGE LambdaCase #-} |
13 | {-# LANGUAGE PolyKinds #-} | ||
13 | module Internal.Specialized | 14 | module Internal.Specialized |
14 | ( Mod(..) | 15 | ( Mod(..) |
15 | , f2i | 16 | , f2i |
@@ -44,8 +45,9 @@ import Data.Coerce | |||
44 | import Data.Complex | 45 | import Data.Complex |
45 | import Data.Functor | 46 | import Data.Functor |
46 | import Data.Int | 47 | import Data.Int |
48 | import Data.IORef | ||
47 | import Data.Maybe | 49 | import Data.Maybe |
48 | import Data.Typeable (eqT,Proxy) | 50 | import Data.Typeable (eqT,Proxy(..),cast) |
49 | import Type.Reflection | 51 | import Type.Reflection |
50 | import Foreign.Marshal.Alloc(free,malloc) | 52 | import Foreign.Marshal.Alloc(free,malloc) |
51 | import Foreign.Marshal.Array(newArray,copyArray) | 53 | import Foreign.Marshal.Array(newArray,copyArray) |
@@ -114,11 +116,29 @@ idint = IntegralRep id id id id id Nothing | |||
114 | coerceint :: Coercible t a => IntegralRep t a | 116 | coerceint :: Coercible t a => IntegralRep t a |
115 | coerceint = IntegralRep coerce coerce coerce coerce coerce Nothing | 117 | coerceint = IntegralRep coerce coerce coerce coerce coerce Nothing |
116 | 118 | ||
117 | modint :: forall t n. (Read t, Storable t) => TypeRep n -> IntegralRep t (Mod n t) | 119 | -- This exists to hopefully save me from parsing a string since Type.Reflection |
120 | -- currently has no direct way to extract a Nat value from a TypeRep. | ||
121 | cachedNat :: IORef SomeNat | ||
122 | cachedNat = unsafePerformIO $ newIORef (SomeNat (Proxy :: Proxy 3)) | ||
123 | {-# NOINLINE cachedNat #-} | ||
124 | |||
125 | withTypes :: p (a::k) -> q (b::h) -> f a b -> f a b | ||
126 | withTypes _ _ = id | ||
127 | |||
128 | modint :: forall t n. (Read t, Storable t, Integral t) => TypeRep n -> IntegralRep t (Mod n t) | ||
118 | modint r = IntegralRep i2f i2fM f2i f2iM unMod (Just n) | 129 | modint r = IntegralRep i2f i2fM f2i f2iM unMod (Just n) |
119 | where | 130 | where |
120 | n = read . show $ r -- XXX: Hack to get nat value from Type.Reflection | 131 | -- n = withTypeable r $ fromIntegral . natVal $ (undefined :: Proxy n) -- If only.. |
121 | -- n = fromIntegral . natVal $ (undefined :: Proxy n) | 132 | n = case unsafePerformIO $ readIORef cachedNat of |
133 | SomeNat c -> withTypeable r $ | ||
134 | case withTypes c r <$> eqT of | ||
135 | Just Refl -> fromIntegral $ natVal c | ||
136 | _ -> unsafePerformIO $ do | ||
137 | let newnat = read . show $ r -- XXX: Hack to get nat value from Type.Reflection | ||
138 | case someNatVal $ fromIntegral newnat of | ||
139 | Just somenat -> writeIORef cachedNat somenat | ||
140 | _ -> return () | ||
141 | return newnat | ||
122 | 142 | ||
123 | coercerep :: Coercible s t => IntegralRep s a -> IntegralRep t a | 143 | coercerep :: Coercible s t => IntegralRep s a -> IntegralRep t a |
124 | coercerep = coerce | 144 | coercerep = coerce |