Improve conversion from boxed vectors using reflection

src/Data/Chimera/Internal.hs

@@ -5,8 +5,10 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
 -- |
@@ -71,6 +73,7 @@ import Data.Functor.Identity
 import Data.List.Infinite (Infinite (..))
 import qualified Data.List.Infinite as Inf
 import qualified Data.Primitive.Array as A
+import Data.Typeable
 import qualified Data.Vector as V
 import qualified Data.Vector.Generic as G
 import qualified Data.Vector.Unboxed as U
@@ -224,7 +227,7 @@ tabulateM f = Chimera <$> generateArrayM (bits + 1) tabulateSubVector
 -- If full memoization is desired, use 'tabulateFix'' instead.
 --
 -- @since 0.2.0.0
-tabulateFix :: G.Vector v a => ((Word -> a) -> Word -> a) -> Chimera v a
+tabulateFix :: (G.Vector v a, Typeable v) => ((Word -> a) -> Word -> a) -> Chimera v a
 tabulateFix uf = runIdentity $ tabulateFixM (coerce uf)
 {-# INLINEABLE tabulateFix #-}
 
@@ -250,7 +253,7 @@ tabulateFix uf = runIdentity $ tabulateFixM (coerce uf)
 -- 56991483520
 --
 -- @since 0.3.2.0
-tabulateFix' :: G.Vector v a => ((Word -> a) -> Word -> a) -> Chimera v a
+tabulateFix' :: (G.Vector v a, Typeable v) => ((Word -> a) -> Word -> a) -> Chimera v a
 tabulateFix' uf = runIdentity $ tabulateFixM' (coerce uf)
 {-# INLINEABLE tabulateFix' #-}
 
@@ -261,32 +264,32 @@ tabulateFix' uf = runIdentity $ tabulateFixM' (coerce uf)
 --
 -- @since 0.2.0.0
 tabulateFixM
-  :: (Monad m, G.Vector v a)
+  :: (Monad m, G.Vector v a, Typeable v)
   => ((Word -> m a) -> Word -> m a)
   -> m (Chimera v a)
 tabulateFixM = tabulateFixM_ Downwards
 {-# INLINEABLE tabulateFixM #-}
-{-# SPECIALIZE tabulateFixM :: G.Vector v a => ((Word -> Identity a) -> Word -> Identity a) -> Identity (Chimera v a) #-}
+{-# SPECIALIZE tabulateFixM :: (G.Vector v a, Typeable v) => ((Word -> Identity a) -> Word -> Identity a) -> Identity (Chimera v a) #-}
 
 -- | Monadic version of 'tabulateFix''.
 --
 -- @since 0.3.3.0
 tabulateFixM'
   :: forall m v a
-   . (Monad m, G.Vector v a)
+   . (Monad m, G.Vector v a, Typeable v)
   => ((Word -> m a) -> Word -> m a)
   -> m (Chimera v a)
 tabulateFixM' = tabulateFixM_ Full
 {-# INLINEABLE tabulateFixM' #-}
-{-# SPECIALIZE tabulateFixM' :: G.Vector v a => ((Word -> Identity a) -> Word -> Identity a) -> Identity (Chimera v a) #-}
+{-# SPECIALIZE tabulateFixM' :: (G.Vector v a, Typeable v) => ((Word -> Identity a) -> Word -> Identity a) -> Identity (Chimera v a) #-}
 
 -- | Memoization strategy, only used by @tabulateFixM_@.
 data Strategy = Full | Downwards
 
 -- | Internal implementation for 'tabulateFixM' and 'tabulateFixM''.
 tabulateFixM_
   :: forall m v a
-   . (Monad m, G.Vector v a)
+   . (Monad m, G.Vector v a, Typeable v)
   => Strategy
   -> ((Word -> m a) -> Word -> m a)
   -> m (Chimera v a)
@@ -302,7 +305,7 @@ tabulateFixM_ strat f = result
         Full -> f (\k -> flip index k <$> result) 0
     tabulateSubVector i = subResult
       where
-        subResult = G.convert <$> subResultBoxed
+        subResult = fromBoxedVector <$> subResultBoxed
         subResultBoxed = V.generateM ii (\j -> f fixF (int2word (ii + j)))
         ii = 1 `unsafeShiftL` (i - 1)
 
@@ -319,6 +322,11 @@ tabulateFixM_ strat f = result
 -- It's crucial to inline into tabulateFixM and tabulateFixM'.
 {-# INLINE tabulateFixM_ #-}
 
+fromBoxedVector :: forall v a. (G.Vector v a, Typeable v) => V.Vector a -> v a
+fromBoxedVector = case eqT @V.Vector @v of
+  Just Refl -> id
+  Nothing -> G.convert
+
 -- | 'iterate' @f@ @x@ returns an infinite stream, generated by
 -- repeated applications of @f@ to @x@.
 --