STUArray with polymorphic type

前端 未结 2 1927
误落风尘
误落风尘 2021-01-18 03:54

I want to implement an algorithm using the ST monad and STUArrays, and I want it to be able to work with both Float and Double

相关标签:
2条回答
  • 2021-01-18 04:33

    Unforunately, you can't currently create a context that requires that an unboxed array be available for a specific type. Quantified Constraints aren't allowed. However, you can still accomplish what you're trying to do, (with the added advantage of having type-specific code versions.) For Longer functions, you could try to split out common expressions so that the repeated code is as small as possible.

    {-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
    module AccumST where 
    
    import Control.Monad
    import Control.Monad.ST
    import Data.Array.Unboxed
    import Data.Array.ST
    import Data.Array.IArray
    
    -- General one valid for all instances of Num.
    -- accumST :: forall a. (IArray UArray a, Num a) => [a] -> Int -> a
    accumST :: forall a. (IArray UArray a, Num a) => [a] -> Int -> a
    accumST vals = (!) . runSTArray $ do
      arr <- newArray (0, length vals) 0 :: (Num a) => ST s (STArray s Int a)
      forM_ (zip vals [1 .. length vals]) $ \(val, i) ->
        readArray arr (i - 1)
        >>= writeArray arr i . (+ val)
      return arr
    
    accumSTFloat vals = (!) . runSTUArray $ do
      arr <- newArray (0, length vals) 0 :: ST s (STUArray s Int Float)
      forM_ (zip vals [1 .. length vals]) $ \(val, i) ->
        readArray arr (i - 1)
        >>= writeArray arr i . (+ val)
      return arr
    
    accumSTDouble vals = (!) . runSTUArray $ do
      arr <- newArray (0, length vals) 0 :: ST s (STUArray s Int Double)
      forM_ (zip vals [1 .. length vals]) $ \(val, i) ->
        readArray arr (i - 1)
        >>= writeArray arr i . (+ val)
      return arr
    
    {-# RULES "accumST/Float" accumST = accumSTFloat #-}
    {-# RULES "accumST/Double" accumST = accumSTDouble #-}
    

    The Generic Unboxed version (which doesn't work) would have a type constraint like the following:

    accumSTU :: forall a. (IArray UArray a, Num a, 
        forall s. MArray (STUArray s) a (ST s)) => [a] -> Int -> a
    

    You could simplify as follows:

    -- accumST :: forall a. (IArray UArray a, Num a) => [a] -> Int -> a
    accumST :: forall a. (IArray UArray a, Num a) => [a] -> Int -> a
    accumST vals = (!) . runSTArray $ do
      arr <- newArray (0, length vals) 0 :: (Num a) => ST s (STArray s Int a)
      accumST_inner vals arr
    
    accumST_inner vals arr = do
      forM_ (zip vals [1 .. length vals]) $ \(val, i) ->
        readArray arr (i - 1)
        >>= writeArray arr i . (+ val)
      return arr
    
    accumSTFloat vals = (!) . runSTUArray $ do
      arr <- newArray (0, length vals) 0 :: ST s (STUArray s Int Float)
      accumST_inner vals arr
    
    accumSTDouble vals = (!) . runSTUArray $ do
      arr <- newArray (0, length vals) 0 :: ST s (STUArray s Int Double)
      accumST_inner vals arr
    
    {-# RULES "accumST/Float" accumST = accumSTFloat #-}
    {-# RULES "accumST/Double" accumST = accumSTDouble #-}
    
    0 讨论(0)
  • 2021-01-18 04:57

    So here's the workaround I'm going with for now - creating a new typeclass for types for which (forall s. MArray (STUArray s) a (ST s)):

    class IArray UArray a => Unboxed a where
      newSTUArray :: Ix i => (i, i) -> a -> ST s (STUArray s i a)
      readSTUArray :: Ix i => STUArray s i a -> i -> ST s a
      writeSTUArray :: Ix i => STUArray s i a -> i -> a -> ST s ()
    
    instance Unboxed Float where
      newSTUArray = newArray
      readSTUArray = readArray
      writeSTUArray = writeArray
    
    instance Unboxed Double where
      newSTUArray = newArray
      readSTUArray = readArray
      writeSTUArray = writeArray
    

    While I'm not perfectly satisfied with this, I prefer it on rules because:

    • rules depend on optimizations
    • rules are not really supposed to change the algorithm (?). where in this case they would as boxed arrays have very different behaviour regarding lazyness etc.
    0 讨论(0)
提交回复
热议问题