[Haskell-cafe] broken IO support in uvector package, when using non primitive types

[Daniel Fischer]

Am Freitag, 13. März 2009 23:53 schrieb Don Stewart:
> manlio_perillo:
> > Daniel Fischer ha scritto:
> >> [...]
> >> Worked with uvector-0.1.0.1:
> >>
> >>  [...]
> >> But not with uvector-0.2
> >>
> > > [...]
> >
> > The main difference is that in uvector 0.2, hPutBU does not write in the
> > file the length of the array; hGetBU simply use the file size.
> >
> >    let elemSize = sizeBU 1 (undefined :: e)
> >    n <- fmap ((`div`elemSize) . fromInteger) $ hFileSize h
> >
> >
> > So, the problem seems to be here.
> > This simply don't support having two arrays written in the same file,
> > and sizeBU belongs to the UAE class, whose instances are only declared
> > for builtin types.
> >
> >
> > So, the patch is: "just revert this change".
>
> Or... use your own UIO instance. That's why it's a type class!
>
> Anyway, for the background on this:
>
>     Tue Nov 18 08:44:46 PST 2008 Malcolm Wallace
>       * Use hFileSize to determine arraysize, rather than encoding it in
> the file.
>
>     "Here is a patch to the uvector library that fixes hGetBU and hPutBU to
>     use the filesize to determine arraysize, rather than encoding it within
>     the file.  I guess the disadvantages are that now only one array can
>     live in a file, and the given Handle must indeed be a file, not a
> socket Handle.  But the advantage is that one can read packed raw datafiles
> obtained externally."
>
> Still, again, I'd point out that uvector is alpha, APIs can and will
> change.
>
> -- Don

Though I don't really know whether what I did is sane, I can offer a few 
patches which seem to work. 
Check for sanity before applying :)

hunk ./Data/Array/Vector/Prim/BUArr.hs 85
-  hPutBU, hGetBU
+  hPutBU, hGetBU, hGetLengthBU

hunk ./Data/Array/Vector/Prim/BUArr.hs 864
+hGetLengthBU :: forall e. UAE e => Int -> Handle -> IO (BUArr e)
+hGetLengthBU numEntries h =
+  do
+    marr@(MBUArr _ marr#) <- stToIO (newMBU numEntries)
+    let bytes = sizeBU numEntries (undefined :: e)
+    wantReadableHandle "hGetBU" h $
+        \handle at Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do
+      buf at Buffer { bufBuf = raw, bufWPtr = w, bufRPtr = r } <- readIORef ref
+      let copied    = bytes `min` (w - r)
+          remaining = bytes - copied
+          newr      = r + copied
+          newbuf | newr == w = buf{ bufRPtr = 0, bufWPtr = 0 }
+                 | otherwise = buf{ bufRPtr = newr }
+      --memcpy_ba_baoff marr# raw (fromIntegral r) (fromIntegral copied)
+      memcpy_ba_baoff marr# raw (fromIntegral r) (fromIntegral copied)
+      writeIORef ref newbuf
+      readChunkBU fd is_stream marr# copied remaining
+      stToIO (unsafeFreezeAllMBU marr)
+

hunk ./Data/Array/Vector/UArr.hs 59
-  BUArr, MBUArr, UAE,
-  lengthBU, indexBU, sliceBU, hGetBU, hPutBU,
+  BUArr, MBUArr, UAE(..),
+  lengthBU, indexBU, sliceBU, hGetBU, hGetLengthBU, hPutBU,

hunk ./Data/Array/Vector/UArr.hs 867
+  hGetLengthU :: Int -> Handle -> IO (UArr a)

hunk ./Data/Array/Vector/UArr.hs 875
+primGetLengthU :: UPrim a => Int -> Handle -> IO (UArr a)
+primGetLengthU n = liftM mkUAPrim . hGetLengthBU n
+

hunk ./Data/Array/Vector/UArr.hs 880
-instance UIO Bool   where hPutU = primPutU; hGetU = primGetU
-instance UIO Char   where hPutU = primPutU; hGetU = primGetU
-instance UIO Int    where hPutU = primPutU; hGetU = primGetU
-instance UIO Word   where hPutU = primPutU; hGetU = primGetU
-instance UIO Float  where hPutU = primPutU; hGetU = primGetU
-instance UIO Double where hPutU = primPutU; hGetU = primGetU
+instance UIO Bool   where hPutU = primPutU; hGetU = primGetU; hGetLengthU = 
primGetLengthU
+instance UIO Char   where hPutU = primPutU; hGetU = primGetU; hGetLengthU = 
primGetLengthU
+instance UIO Int    where hPutU = primPutU; hGetU = primGetU; hGetLengthU = 
primGetLengthU
+instance UIO Word   where hPutU = primPutU; hGetU = primGetU; hGetLengthU = 
primGetLengthU
+instance UIO Float  where hPutU = primPutU; hGetU = primGetU; hGetLengthU = 
primGetLengthU
+instance UIO Double where hPutU = primPutU; hGetU = primGetU; hGetLengthU = 
primGetLengthU

hunk ./Data/Array/Vector/UArr.hs 887
-instance UIO Word8  where hPutU = primPutU; hGetU = primGetU
-instance UIO Word16 where hPutU = primPutU; hGetU = primGetU
-instance UIO Word32 where hPutU = primPutU; hGetU = primGetU
-instance UIO Word64 where hPutU = primPutU; hGetU = primGetU
+instance UIO Word8  where hPutU = primPutU; hGetU = primGetU; hGetLengthU = 
primGetLengthU
+instance UIO Word16 where hPutU = primPutU; hGetU = primGetU; hGetLengthU = 
primGetLengthU
+instance UIO Word32 where hPutU = primPutU; hGetU = primGetU; hGetLengthU = 
primGetLengthU
+instance UIO Word64 where hPutU = primPutU; hGetU = primGetU; hGetLengthU = 
primGetLengthU

hunk ./Data/Array/Vector/UArr.hs 892
-instance UIO Int8   where hPutU = primPutU; hGetU = primGetU
-instance UIO Int16  where hPutU = primPutU; hGetU = primGetU
-instance UIO Int32  where hPutU = primPutU; hGetU = primGetU
-instance UIO Int64  where hPutU = primPutU; hGetU = primGetU
+instance UIO Int8   where hPutU = primPutU; hGetU = primGetU; hGetLengthU = 
primGetLengthU
+instance UIO Int16  where hPutU = primPutU; hGetU = primGetU; hGetLengthU = 
primGetLengthU
+instance UIO Int32  where hPutU = primPutU; hGetU = primGetU; hGetLengthU = 
primGetLengthU
+instance UIO Int64  where hPutU = primPutU; hGetU = primGetU; hGetLengthU = 
primGetLengthU

hunk ./Data/Array/Vector/UArr.hs 899
-instance (UIO a, UIO b) => UIO (a :*: b) where
+instance (UAE a, UAE b, UIO a, UIO b) => UIO (a :*: b) where

hunk ./Data/Array/Vector/UArr.hs 902
-  hGetU h                = do xs <- hGetU h
-                              ys <- hGetU h
+  hGetU h                = do let elemSize = sizeBU 1 (undefined :: a) + 
sizeBU 1 (undefined :: b)
+                              n <- fmap ((`div` elemSize) . fromInteger) $ 
hFileSize h
+                              xs <- hGetLengthU n h
+                              ys <- hGetLengthU n h
+                              return (UAProd xs ys)
+  hGetLengthU n h        = do xs <- hGetLengthU n h
+                              ys <- hGetLengthU n h

hunk ./Data/Array/Vector/UArr.hs 914
-instance (RealFloat a, UIO a) => UIO (Complex a) where
+instance (RealFloat a, UAE a, UIO a) => UIO (Complex a) where

hunk ./Data/Array/Vector/UArr.hs 918
+  hGetLengthU n h         = do arr <- hGetLengthU n h
+                               return (UAComplex arr)

hunk ./Data/Array/Vector/UArr.hs 921
-instance (Integral a, UIO a) => UIO (Ratio a) where
+instance (Integral a, UAE a, UIO a) => UIO (Ratio a) where

hunk ./Data/Array/Vector/UArr.hs 925
+  hGetLengthU n h         = do arr <- hGetLengthU n h
+                               return (UARatio arr)