From 81b635594934ed0155fbd3bf544deb544627868a Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Sat, 10 Aug 2019 05:38:08 -0400 Subject: Specializing Mod: Cache parsed nat value. Benchmark shows this doesn't seem to gain us much. --- packages/base/src/Internal/Specialized.hs | 28 ++++++++++++++++++++++++---- 1 file 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 -- cgit v1.2.3