<
haskell.vivian.mcphail@gmail.com> wrote:
> Hi Roman,
>
>
> Can you explain why the following code doesn't work? 'unsafePerformIO' is
> used all the time in hmatrix. For example, adding two vectors, we create a
> new Vector then use that as the target for an FFI C call.
>
> Is the difference because I'm using mutable Storable Vectors? I would have
> thought that unsafeFreeze (at the end) would make sure the problem reported
> by Luke wouldn't occur.
>
> Is there a problem with laziness in the let binding of Luke's example?
>
> I note that in Data.Vector.Storable there is a pure 'convert' function,
> which is essentially what I am trying to emulate.
>
> -- | convert to a vector
> toVector :: Storable a => Buffer a -> (V.Vector a)
> toVector (B o n v) = unsafePerformIO $ do
> w <- M.new n
> i <- readIORef o
> M.unsafeWith v $ \p ->
> M.unsafeWith w $ \q -> do
> let n' = n-i
> copyArray q (p `advancePtr` i) n'
> if i /= 0
> then copyArray (q `advancePtr` n') p i
> else return ()
> V.unsafeFreeze w
> {-# INLINE toVector #-}
>
>
> Vivian
>
> From: Luke Palmer <
lrpalmer@gmail.com>
>
> This interface is an outlaw.
>
> main = do
> buf <- newBuffer 10 :: IO (Buffer Int)
> pushNextElement buf 1
> let v1 = V.toList (toVector buf)
> v2 = V.toList (toVector buf)
> print v1
> pushNextElement buf 2
> print v2
>
> Despite v1 and v2 being defined to equal the exact same thing, this
> program prints two distinct lines.
>
> toVector depends on the current state of the buffer. If this is to be
> a law-abiding interface, toVector must return a value in IO:
>
> toVector :: (Storable a) => Buffer a -> IO (Vector a)
>
> Luke
>