diff options
author | Joe Crayne <joe@jerkface.net> | 2019-08-10 08:59:23 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-08-10 08:59:23 -0400 |
commit | 12229318f5cdee4a2856c96eb6bf02af3eafd32e (patch) | |
tree | 3aae31d0ab5b1677a88c56ef417a595ce0233f84 /packages | |
parent | ab75b833bbc6e53b6f91fb9faf08508e1c26cff2 (diff) |
Specializing: Cache a non-bignum version of module nat.typeable
Diffstat (limited to 'packages')
-rw-r--r-- | packages/base/src/Internal/Specialized.hs | 14 |
1 files changed, 9 insertions, 5 deletions
diff --git a/packages/base/src/Internal/Specialized.hs b/packages/base/src/Internal/Specialized.hs index c85d44f..6143f65 100644 --- a/packages/base/src/Internal/Specialized.hs +++ b/packages/base/src/Internal/Specialized.hs | |||
@@ -1,3 +1,4 @@ | |||
1 | {-# LANGUAGE ExistentialQuantification #-} | ||
1 | {-# LANGUAGE BangPatterns #-} | 2 | {-# LANGUAGE BangPatterns #-} |
2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
3 | {-# LANGUAGE ConstraintKinds #-} | 4 | {-# LANGUAGE ConstraintKinds #-} |
@@ -116,10 +117,12 @@ idint = IntegralRep id id id id id Nothing | |||
116 | coerceint :: Coercible t a => IntegralRep t a | 117 | coerceint :: Coercible t a => IntegralRep t a |
117 | coerceint = IntegralRep coerce coerce coerce coerce coerce Nothing | 118 | coerceint = IntegralRep coerce coerce coerce coerce coerce Nothing |
118 | 119 | ||
120 | data CachedNat = forall (n::Nat). Typeable n => CachedNat !Int64 !(Proxy n) | ||
121 | |||
119 | -- This exists to hopefully save me from parsing a string since Type.Reflection | 122 | -- 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. | 123 | -- currently has no direct way to extract a Nat value from a TypeRep. |
121 | cachedNat :: IORef SomeNat | 124 | cachedNat :: IORef CachedNat |
122 | cachedNat = unsafePerformIO $ newIORef (SomeNat (Proxy :: Proxy 3)) | 125 | cachedNat = unsafePerformIO $ newIORef (CachedNat 3 (Proxy::Proxy 3)) |
123 | {-# NOINLINE cachedNat #-} | 126 | {-# NOINLINE cachedNat #-} |
124 | 127 | ||
125 | withTypes :: p (a::k) -> q (b::h) -> f a b -> f a b | 128 | withTypes :: p (a::k) -> q (b::h) -> f a b -> f a b |
@@ -130,14 +133,15 @@ modint r = IntegralRep i2f i2fM f2i f2iM unMod (n `seq` Just n) | |||
130 | where | 133 | where |
131 | -- n = withTypeable r $ fromIntegral . natVal $ (undefined :: Proxy n) -- If only.. | 134 | -- n = withTypeable r $ fromIntegral . natVal $ (undefined :: Proxy n) -- If only.. |
132 | n = unsafePerformIO $ do | 135 | n = unsafePerformIO $ do |
133 | SomeNat c <- readIORef cachedNat | 136 | CachedNat ci c <- readIORef cachedNat |
134 | withTypeable r $ do | 137 | withTypeable r $ do |
135 | case withTypes c r <$> eqT of | 138 | case withTypes c r <$> eqT of |
136 | Just Refl -> return $ fromIntegral $ natVal c | 139 | Just Refl -> return $ fromIntegral ci |
137 | _ -> do | 140 | _ -> do |
138 | let newnat = read . show $ r -- XXX: Hack to get nat value from Type.Reflection | 141 | let newnat = read . show $ r -- XXX: Hack to get nat value from Type.Reflection |
139 | case someNatVal $ fromIntegral newnat of | 142 | case someNatVal $ fromIntegral newnat of |
140 | Just somenat@(SomeNat nt) -> nt `seq` writeIORef cachedNat somenat | 143 | Just somenat@(SomeNat nt) -> do |
144 | nt `seq` writeIORef cachedNat $ CachedNat (fromIntegral newnat) nt | ||
141 | _ -> return () | 145 | _ -> return () |
142 | return newnat | 146 | return newnat |
143 | 147 | ||