From 29105efba2db42dcce426a29a11539b3083ec356 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Wed, 31 Oct 2018 16:15:08 -0400 Subject: Minor clean up. --- haskell/Data/VCDIFF.hs | 66 ++++++++------------------------------------ haskell/examples/testdiff.hs | 19 ++++--------- 2 files changed, 17 insertions(+), 68 deletions(-) diff --git a/haskell/Data/VCDIFF.hs b/haskell/Data/VCDIFF.hs index f06be9c..fe4cc98 100644 --- a/haskell/Data/VCDIFF.hs +++ b/haskell/Data/VCDIFF.hs @@ -24,7 +24,6 @@ module Data.VCDIFF , computeDiff , applyPatch) where --- import Debug.Trace import Control.Monad import Control.Monad.Primitive import Control.Monad.ST @@ -69,6 +68,7 @@ data Stream m = Stream , streamSource :: MutVar (PrimState m) (Maybe (Source m)) } +keepAlive :: a1 -> a2 -> IO () keepAlive srcvar s = do seq srcvar $ seq s $ return () -- Keep array s alive until the ffi functions finish. {-# NOINLINE keepAlive #-} @@ -89,7 +89,6 @@ config_stream cfg = do xd3_abort_stream sptr xd3_close_stream sptr xd3_free_stream sptr - putStrLn $ "finalized " ++ show sptr keepAlive srcvar s fp <- newForeignPtr sptr finalize return Stream @@ -122,7 +121,7 @@ set_source stream nm blksz maxwinsz = do data XDeltaMethods m u = XDeltaMethods { xConfig :: Config - , xGetSource :: Xoff_t -> B.ByteString + , xGetSource :: Xoff_t -> m B.ByteString , xOutput :: Ptr Word8 -> Int -> m u , xOnError :: ErrorCode -> String -> m u , xBlockSize :: Usize_t @@ -173,12 +172,11 @@ outputChunks :: (Monoid b, Num t, PrimMonad m, Show b) => outputChunks strm interleave encode output next = fix $ \loop -> do encode >>= \case XD3_OUTPUT -> do u1 <- nextOut strm $ \(p,len) -> output p (fromIntegral len) - trace ("u1 = " ++ show u1) $ return () u <- interleave $ loop return $ u1 <> u - XD3_GOTHEADER -> trace "XD3_GOTHEADER" loop - XD3_WINSTART -> trace "XD3_WINSTART" loop - XD3_WINFINISH -> trace "XD3_WINFINISH" loop + XD3_GOTHEADER -> loop + XD3_WINSTART -> loop + XD3_WINFINISH -> loop xd3 -> next xd3 withBlocks :: PrimBase m => B.ByteString -> Maybe B.ByteString -> m a -> m a @@ -196,7 +194,7 @@ updateBlock :: (Monoid u, PrimBase m, Show u) => -> ErrorCode -> m u updateBlock stream code_input mblk x _ [] XD3_INPUT = return mempty -updateBlock stream code_input mblk x _ (d:ds) XD3_INPUT = trace "XD3_INPUT" $ do +updateBlock stream code_input mblk x _ (d:ds) XD3_INPUT = do withByteString d $ \p len -> avail_input (streamArray stream) p len when (null ds) $ setFlush (streamArray stream) True outputChunks (streamArray stream) (xInterleave x) @@ -205,10 +203,9 @@ updateBlock stream code_input mblk x _ (d:ds) XD3_INPUT = trace "XD3_INPUT" $ do $ updateBlock stream code_input mblk x d ds updateBlock stream code_input mblk x d ds XD3_GETSRCBLK = do Just n <- requestedBlockNumber stream - let blk = xGetSource x n + blk <- xGetSource x n withByteString blk $ \p len -> do pokeCurrentBlock stream $ CurrentBlock n len p - trace ("XD3_GETSRCBLK " ++ show (n,len,p,xBlockSize x)) $ return () when (len < xBlockSize x) $ do Just src <- readMutVar $ streamSource stream sourceWriteEOFKnown src True @@ -216,59 +213,18 @@ updateBlock stream code_input mblk x d ds XD3_GETSRCBLK = do (withBlocks d (Just blk) code_input) (xOutput x) $ updateBlock stream code_input mblk x d ds -updateBlock stream code_input mblk x d ds e = trace (show e) $ do +updateBlock stream code_input mblk x d ds e = do s <- errorString (streamArray stream) xOnError x e s -trace _ = id - xdelta :: (Show u, PrimBase m, Monoid u) => XDeltaMethods m u -> (Stream m -> m ErrorCode) -> [B.ByteString] -> m u -xdelta x xxcode_input ds = trace ("ds = "++show ds) $ do +xdelta x xxcode_input ds = do mstream <- config_stream (xConfig x) either (\e _ -> xOnError x e "config_stream failed") (flip ($)) mstream $ \stream -> do src <- set_source stream "VCDIFF" (xBlockSize x) (xBlockSize x) updateBlock stream (xxcode_input stream) Nothing x B.empty ds XD3_INPUT - {- - let go withBlk [] = return mempty - go withBlk (d:ds) = do - let (fp,off,len) = B.toForeignPtr d - eof = null ds || len < fromIntegral (xBlockSize x) - when eof $ setFlush (streamArray stream) True - withByteString d $ \indata len -> do - avail_input (streamArray stream) indata len - go2 withBlk eof ds - go2 withBlk eof ds = do - ret <- withBlk $ xxcode_input stream - case ret of - XD3_INPUT -> if (not eof) then go withBlk ds else return mempty - XD3_OUTPUT -> do - m' <- nextOut (streamArray stream) (\(p,len) -> xOutput x p (fromIntegral len)) - ms <- xInterleave x $ go2 withBlk eof ds - return $ m' <> ms - XD3_GETSRCBLK -> do - Just n <- requestedBlockNumber stream - let blk = xGetSource x n - withBlk' act = withByteString blk $ \p len -> do - pokeCurrentBlock stream $ CurrentBlock n len p - when (len < xBlockSize x) $ do - Just src <- readMutVar $ streamSource stream - sourceWriteEOFKnown src True - act - go2 withBlk' eof ds - XD3_GOTHEADER -> go2 withBlk eof ds -- No - XD3_WINSTART -> go2 withBlk eof ds -- action - XD3_WINFINISH -> go2 withBlk eof ds -- neccessary - -- -- These are set for each XD3_WINFINISH return. - -- xd3_encoder_used_source :: Ptr Stream -> IO Bool - -- xd3_encoder_srcbase :: Ptr Stream -> IO Xoff_t - -- xd3_encoder_srclen :: Ptr Stream -> IO Usize_t - e -> do - s <- errorString (streamArray stream) - xOnError x e s - xInterleave x $ go id ds - -} decode_input :: PrimMonad m => Stream m -> m ErrorCode decode_input stream = @@ -329,14 +285,14 @@ xdeltaPure codec cfg source input = x :: XDeltaMethods (ST s) (Result L.ByteString) x = XDeltaMethods { xConfig = cfg - , xGetSource = \i -> case IntMap.lookup (fromIntegral i) smap of + , xGetSource = \i -> return $ case IntMap.lookup (fromIntegral i) smap of Nothing -> B.empty Just bs -> bs , xOutput = \ptr len -> unsafeIOToST $ flip Result Nothing . L.fromStrict <$> B.packCStringLen (castPtr ptr,len) , xOnError = \e s -> return (Result L.empty (Just (e,s))) , xBlockSize = bsize - , xInterleave = id -- unsafeInterleaveST + , xInterleave = unsafeInterleaveST } in runST $ xdelta x codec ds diff --git a/haskell/examples/testdiff.hs b/haskell/examples/testdiff.hs index 08229d3..d2b99f5 100644 --- a/haskell/examples/testdiff.hs +++ b/haskell/examples/testdiff.hs @@ -25,10 +25,6 @@ delta3 = computeDiff defaultConfig { flags = XD3_ADLER32 } source target delta4 :: Result VCDIFF delta4 = computeDiff defaultConfig { flags = XD3_ADLER32 } source target -delta5 :: Result VCDIFF -delta5 = computeDiff defaultConfig { flags = XD3_ADLER32 } source target - - dump title bs kont = do putStrLn title @@ -38,17 +34,14 @@ dump title bs kont = do main = do dump "source" source $ putStrLn "" dump "target" target $ putStrLn "" - go source "XD3_ADLER32" delta3 - go source "XD3_ADLER32" delta4 - go source "XD3_ADLER32" delta5 go source "default" delta go source "default" delta2 - {- - go source2 "default" delta - go source2 "default" delta2 - go source2 "XD3_ADLER32" delta3 - go source2 "XD3_ADLER32" delta4 - -} + go source2 "default2" delta + go source2 "default2" delta2 + go source "XD3_ADLER32" delta3 + go source2 "XD3_ADLER32-2" delta3 + go source "XD3_ADLER32" delta4 + go source2 "XD3_ADLER32-2"delta4 print source print source2 print target -- cgit v1.2.3