Specializing Mod: Cache parsed nat value.

Benchmark shows this doesn't seem to gain us much.

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 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PolyKinds #-}
 module Internal.Specialized
     ( Mod(..)
     , f2i
@@ -44,8 +45,9 @@ import Data.Coerce
 import Data.Complex
 import Data.Functor
 import Data.Int
+import Data.IORef
 import Data.Maybe
-import Data.Typeable (eqT,Proxy)
+import Data.Typeable (eqT,Proxy(..),cast)
 import Type.Reflection
 import Foreign.Marshal.Alloc(free,malloc)
 import Foreign.Marshal.Array(newArray,copyArray)
@@ -114,11 +116,29 @@ idint = IntegralRep id id id id id Nothing
 coerceint :: Coercible t a => IntegralRep t a
 coerceint = IntegralRep coerce coerce coerce coerce coerce Nothing
 
-modint :: forall t n. (Read t, Storable t) => TypeRep n -> IntegralRep t (Mod n t)
+-- This exists to hopefully save me from parsing a string since Type.Reflection
+-- currently has no direct way to extract a Nat value from a TypeRep.
+cachedNat :: IORef SomeNat
+cachedNat = unsafePerformIO $ newIORef (SomeNat (Proxy :: Proxy 3))
+{-# NOINLINE cachedNat #-}
+
+withTypes :: p (a::k) -> q (b::h) -> f a b -> f a b
+withTypes _ _ = id
+
+modint :: forall t n. (Read t, Storable t, Integral t) => TypeRep n -> IntegralRep t (Mod n t)
 modint r = IntegralRep i2f i2fM f2i f2iM unMod (Just n)
  where
-    n = read . show $ r -- XXX: Hack to get nat value from Type.Reflection
-    -- n = fromIntegral . natVal $ (undefined :: Proxy n)
+    -- n = withTypeable r $ fromIntegral . natVal $ (undefined :: Proxy n) -- If only..
+    n = case unsafePerformIO $ readIORef cachedNat of
+        SomeNat c -> withTypeable r $
+            case withTypes c r <$> eqT of
+                Just Refl -> fromIntegral $ natVal c
+                _ -> unsafePerformIO $ do
+                    let newnat = read . show $ r -- XXX: Hack to get nat value from Type.Reflection
+                    case someNatVal $ fromIntegral newnat of
+                        Just somenat -> writeIORef cachedNat somenat
+                        _ -> return ()
+                    return newnat
 
 coercerep :: Coercible s t => IntegralRep s a -> IntegralRep t a
 coercerep = coerce