diff options
author | Joe Crayne <joe@jerkface.net> | 2018-10-26 02:17:42 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2018-10-26 02:17:42 -0400 |
commit | 9eb3ca619568b8c4b3c3d0ed2da0319f1bd9a4bd (patch) | |
tree | f0dfb22ec331608d60379b72370549b350f2cea5 /haskell | |
parent | 05ae232e966eccae46d535126a579740b6cf780d (diff) |
Reorganizing.
Diffstat (limited to 'haskell')
-rw-r--r-- | haskell/Data/BA.hs | 17 | ||||
-rw-r--r-- | haskell/Data/Primitive/ByteArray/Util.hs | 45 | ||||
-rw-r--r-- | haskell/Data/VCDIFF.hsc (renamed from haskell/Data/XDelta.hsc) | 108 | ||||
-rw-r--r-- | haskell/Data/VCDIFF/Types.hsc (renamed from haskell/XDelta/Types.hsc) | 2 | ||||
-rw-r--r-- | haskell/offset.h | 2 |
5 files changed, 109 insertions, 65 deletions
diff --git a/haskell/Data/BA.hs b/haskell/Data/BA.hs deleted file mode 100644 index 60b1136..0000000 --- a/haskell/Data/BA.hs +++ /dev/null | |||
@@ -1,17 +0,0 @@ | |||
1 | {-# LANGUAGE MagicHash #-} | ||
2 | {-# LANGUAGE ScopedTypeVariables #-} | ||
3 | module Data.BA where | ||
4 | |||
5 | import GHC.Exts | ||
6 | import Control.Monad.Primitive | ||
7 | import Data.Primitive.Types | ||
8 | import Data.Primitive.ByteArray | ||
9 | |||
10 | -- | WARNING: Unsafe to use this on packed C structs. | ||
11 | writeAtByte :: (Prim a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> a -> m () | ||
12 | writeAtByte buf offset a = writeByteArray buf (div offset $ I# (sizeOf# a)) a | ||
13 | {-# INLINE writeAtByte #-} | ||
14 | |||
15 | readAtByte :: forall a m. (Prim a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> m a | ||
16 | readAtByte buf offset = readByteArray buf (div offset $ I# (sizeOf# (undefined :: a))) | ||
17 | {-# INLINE readAtByte #-} | ||
diff --git a/haskell/Data/Primitive/ByteArray/Util.hs b/haskell/Data/Primitive/ByteArray/Util.hs new file mode 100644 index 0000000..1776286 --- /dev/null +++ b/haskell/Data/Primitive/ByteArray/Util.hs | |||
@@ -0,0 +1,45 @@ | |||
1 | {-# LANGUAGE DataKinds #-} | ||
2 | {-# LANGUAGE FlexibleContexts #-} | ||
3 | {-# LANGUAGE FlexibleInstances #-} | ||
4 | {-# LANGUAGE KindSignatures #-} | ||
5 | {-# LANGUAGE MagicHash #-} | ||
6 | {-# LANGUAGE MultiParamTypeClasses #-} | ||
7 | {-# LANGUAGE ScopedTypeVariables #-} | ||
8 | {-# LANGUAGE TypeFamilies #-} | ||
9 | {-# LANGUAGE TypeOperators #-} | ||
10 | module Data.Primitive.ByteArray.Util where | ||
11 | |||
12 | import GHC.TypeLits | ||
13 | import Control.Monad.Primitive | ||
14 | import Data.Primitive.Types | ||
15 | import Data.Primitive.ByteArray | ||
16 | |||
17 | newtype Offset (n :: Nat) = Offset Int | ||
18 | |||
19 | offset :: KnownNat n => Offset n | ||
20 | offset = let k = Offset $ fromIntegral $ natVal k in k | ||
21 | |||
22 | (+.) :: Offset j -> Offset k -> Offset (j + k) | ||
23 | Offset j +. Offset k = Offset (j + k) | ||
24 | |||
25 | |||
26 | type family SizeOf a :: Nat | ||
27 | |||
28 | class IsMultipleOf (n::Nat) (k::Nat) | ||
29 | |||
30 | instance n ~ (q * k) => IsMultipleOf n k | ||
31 | |||
32 | writeAtByte :: ( Prim a | ||
33 | , PrimMonad m | ||
34 | , IsMultipleOf n (SizeOf a) | ||
35 | ) => MutableByteArray (PrimState m) -> Offset n -> a -> m () | ||
36 | writeAtByte buf (Offset offset) a = writeByteArray buf (div offset $ (sizeOf a)) a | ||
37 | {-# INLINE writeAtByte #-} | ||
38 | |||
39 | readAtByte :: forall a m n. | ||
40 | ( Prim a | ||
41 | , PrimMonad m | ||
42 | , IsMultipleOf n (SizeOf a) | ||
43 | ) => MutableByteArray (PrimState m) -> Offset n -> m a | ||
44 | readAtByte buf (Offset offset) = readByteArray buf (div offset $ (sizeOf (undefined :: a))) | ||
45 | {-# INLINE readAtByte #-} | ||
diff --git a/haskell/Data/XDelta.hsc b/haskell/Data/VCDIFF.hsc index 8128a61..5e484e1 100644 --- a/haskell/Data/XDelta.hsc +++ b/haskell/Data/VCDIFF.hsc | |||
@@ -1,19 +1,24 @@ | |||
1 | {-# OPTIONS_GHC -Wno-partial-type-signatures #-} | ||
1 | {-# LANGUAGE BangPatterns #-} | 2 | {-# LANGUAGE BangPatterns #-} |
3 | {-# LANGUAGE DataKinds #-} | ||
4 | {-# LANGUAGE DeriveFunctor #-} | ||
5 | {-# LANGUAGE FlexibleContexts #-} | ||
6 | {-# LANGUAGE FlexibleInstances #-} | ||
2 | {-# LANGUAGE GADTs #-} | 7 | {-# LANGUAGE GADTs #-} |
3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | 8 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
4 | {-# LANGUAGE LambdaCase #-} | 9 | {-# LANGUAGE LambdaCase #-} |
5 | {-# LANGUAGE NondecreasingIndentation #-} | 10 | {-# LANGUAGE NondecreasingIndentation #-} |
11 | {-# LANGUAGE PartialTypeSignatures #-} | ||
6 | {-# LANGUAGE PatternSynonyms #-} | 12 | {-# LANGUAGE PatternSynonyms #-} |
7 | {-# LANGUAGE RankNTypes #-} | 13 | {-# LANGUAGE RankNTypes #-} |
8 | {-# LANGUAGE FlexibleInstances #-} | 14 | {-# LANGUAGE TypeFamilies #-} |
9 | {-# LANGUAGE DeriveFunctor #-} | 15 | {-# LANGUAGE TypeOperators #-} |
10 | module Data.XDelta where | 16 | module Data.VCDIFF where |
11 | 17 | ||
12 | import Control.Monad | 18 | import Control.Monad |
13 | import Control.Monad.Primitive | 19 | import Control.Monad.Primitive |
14 | import Control.Monad.ST | 20 | import Control.Monad.ST |
15 | import Control.Monad.ST.Unsafe | 21 | import Control.Monad.ST.Unsafe |
16 | import Data.BA | ||
17 | import Data.Bits | 22 | import Data.Bits |
18 | import qualified Data.ByteString as B | 23 | import qualified Data.ByteString as B |
19 | import qualified Data.ByteString.Unsafe as B | 24 | import qualified Data.ByteString.Unsafe as B |
@@ -25,6 +30,7 @@ import qualified Data.IntMap as IntMap | |||
25 | import Data.Monoid | 30 | import Data.Monoid |
26 | import Data.Primitive.Addr | 31 | import Data.Primitive.Addr |
27 | import Data.Primitive.ByteArray | 32 | import Data.Primitive.ByteArray |
33 | import Data.Primitive.ByteArray.Util | ||
28 | import Data.Primitive.MutVar | 34 | import Data.Primitive.MutVar |
29 | import Data.STRef | 35 | import Data.STRef |
30 | import qualified Data.Text as T | 36 | import qualified Data.Text as T |
@@ -38,8 +44,9 @@ import Foreign.Concurrent | |||
38 | import Foreign.Storable | 44 | import Foreign.Storable |
39 | import Foreign.ForeignPtr (ForeignPtr) | 45 | import Foreign.ForeignPtr (ForeignPtr) |
40 | import GHC.Exts | 46 | import GHC.Exts |
47 | import GHC.TypeLits | ||
41 | 48 | ||
42 | import XDelta.Types | 49 | import Data.VCDIFF.Types |
43 | 50 | ||
44 | #ifndef SIZEOF_SIZE_T | 51 | #ifndef SIZEOF_SIZE_T |
45 | #define SIZEOF_SIZE_T __SIZEOF_SIZE_T__ | 52 | #define SIZEOF_SIZE_T __SIZEOF_SIZE_T__ |
@@ -50,6 +57,8 @@ import XDelta.Types | |||
50 | #endif | 57 | #endif |
51 | #include <xdelta3.h> | 58 | #include <xdelta3.h> |
52 | 59 | ||
60 | #include "offset.h" | ||
61 | |||
53 | data Stream m = Stream | 62 | data Stream m = Stream |
54 | { streamArray :: MutableByteArray (PrimState m) | 63 | { streamArray :: MutableByteArray (PrimState m) |
55 | , streamPtr :: ForeignPtr Xd3Stream -- ^ HACK: this is only used to attach a finalizer | 64 | , streamPtr :: ForeignPtr Xd3Stream -- ^ HACK: this is only used to attach a finalizer |
@@ -67,26 +76,31 @@ foreign import ccall "xdelta3.h xd3_abort_stream" xd3_abort_stream :: Ptr Xd3Str | |||
67 | 76 | ||
68 | foreign import ccall "xdelta3.h xd3_close_stream" xd3_close_stream :: Ptr Xd3Stream -> IO ErrorCode | 77 | foreign import ccall "xdelta3.h xd3_close_stream" xd3_close_stream :: Ptr Xd3Stream -> IO ErrorCode |
69 | 78 | ||
79 | type instance SizeOf Usize_t = #const sizeof(usize_t) | ||
80 | type instance SizeOf (FunPtr a) = #const sizeof(void(*)()) | ||
81 | type instance SizeOf (Ptr a) = #const sizeof(void*) | ||
82 | type instance SizeOf #{type int} = #const sizeof(int) | ||
83 | type instance SizeOf #{type unsigned int} = #const sizeof(unsigned int) | ||
84 | |||
85 | |||
70 | 86 | ||
71 | writeCompressorConfig :: PrimMonad m => | 87 | writeCompressorConfig :: (PrimMonad m, _) => MutableByteArray (PrimState m) -> Offset j -> CompressorConfig -> m () |
72 | MutableByteArray (PrimState m) -> Int -> CompressorConfig -> m () | ||
73 | writeCompressorConfig c o sec = do | 88 | writeCompressorConfig c o sec = do |
74 | writeAtByte c (o + #{offset xd3_sec_cfg,ngroups}) (ngroups sec) | 89 | writeAtByte c (o +. #{off xd3_sec_cfg,ngroups}) (ngroups sec) |
75 | writeAtByte c (o + #{offset xd3_sec_cfg,sector_size}) (sector_size sec) | 90 | writeAtByte c (o +. #{off xd3_sec_cfg,sector_size}) (sector_size sec) |
76 | writeAtByte c (o + #{offset xd3_sec_cfg,inefficient}) (inefficient sec) | 91 | writeAtByte c (o +. #{off xd3_sec_cfg,inefficient}) (inefficient sec) |
77 | 92 | ||
78 | writeMatcher :: PrimMonad m => | 93 | writeMatcher :: (PrimMonad m, _) => MutableByteArray (PrimState m) -> Offset j -> StringMatcher -> m () |
79 | MutableByteArray (PrimState m) -> Int -> StringMatcher -> m () | ||
80 | writeMatcher c o sm = do | 94 | writeMatcher c o sm = do |
81 | -- handled elsewhere: const char *name; <- smName :: String | 95 | -- handled elsewhere: const char *name; <- smName :: String |
82 | writeAtByte c (o + #{offset xd3_smatcher, string_match }) (smStringMatch sm) | 96 | writeAtByte c (o +. #{off xd3_smatcher, string_match }) (smStringMatch sm) |
83 | writeAtByte c (o + #{offset xd3_smatcher, large_look }) (smLargeLook sm) | 97 | writeAtByte c (o +. #{off xd3_smatcher, large_look }) (smLargeLook sm) |
84 | writeAtByte c (o + #{offset xd3_smatcher, large_step }) (smLargeStep sm) | 98 | writeAtByte c (o +. #{off xd3_smatcher, large_step }) (smLargeStep sm) |
85 | writeAtByte c (o + #{offset xd3_smatcher, small_look }) (smSmallLook sm) | 99 | writeAtByte c (o +. #{off xd3_smatcher, small_look }) (smSmallLook sm) |
86 | writeAtByte c (o + #{offset xd3_smatcher, small_chain }) (smSmallChain sm) | 100 | writeAtByte c (o +. #{off xd3_smatcher, small_chain }) (smSmallChain sm) |
87 | writeAtByte c (o + #{offset xd3_smatcher, small_lchain }) (smSmallLchain sm) | 101 | writeAtByte c (o +. #{off xd3_smatcher, small_lchain }) (smSmallLchain sm) |
88 | writeAtByte c (o + #{offset xd3_smatcher, max_lazy }) (smMaxLazy sm) | 102 | writeAtByte c (o +. #{off xd3_smatcher, max_lazy }) (smMaxLazy sm) |
89 | writeAtByte c (o + #{offset xd3_smatcher, long_enough }) (smLongEnough sm) | 103 | writeAtByte c (o +. #{off xd3_smatcher, long_enough }) (smLongEnough sm) |
90 | 104 | ||
91 | ptr :: Addr -> Ptr a | 105 | ptr :: Addr -> Ptr a |
92 | ptr (Addr a) = Ptr a | 106 | ptr (Addr a) = Ptr a |
@@ -113,23 +127,23 @@ config_stream cfg = do | |||
113 | c <- do | 127 | c <- do |
114 | c <- newPinnedByteArray #const sizeof(xd3_config) | 128 | c <- newPinnedByteArray #const sizeof(xd3_config) |
115 | fillByteArray c 0 #{const sizeof(xd3_config)} 0 | 129 | fillByteArray c 0 #{const sizeof(xd3_config)} 0 |
116 | writeAtByte c #{offset xd3_config, winsize} (winsize cfg) | 130 | writeAtByte c #{off xd3_config, winsize} (winsize cfg) |
117 | writeAtByte c #{offset xd3_config, sprevsz} (sprevsz cfg) | 131 | writeAtByte c #{off xd3_config, sprevsz} (sprevsz cfg) |
118 | writeAtByte c #{offset xd3_config, iopt_size} (iopt_size cfg) | 132 | writeAtByte c #{off xd3_config, iopt_size} (iopt_size cfg) |
119 | writeAtByte c #{offset xd3_config, flags} (coerce (flags cfg) :: Word32) | 133 | writeAtByte c #{off xd3_config, flags} (coerce (flags cfg) :: Word32) |
120 | writeCompressorConfig c #{offset xd3_config, sec_data} (sec_data cfg) | 134 | writeCompressorConfig c #{off xd3_config, sec_data} (sec_data cfg) |
121 | writeCompressorConfig c #{offset xd3_config, sec_inst} (sec_inst cfg) | 135 | writeCompressorConfig c #{off xd3_config, sec_inst} (sec_inst cfg) |
122 | writeCompressorConfig c #{offset xd3_config, sec_addr} (sec_addr cfg) | 136 | writeCompressorConfig c #{off xd3_config, sec_addr} (sec_addr cfg) |
123 | let msel :: #type xd3_smatch_cfg | 137 | let msel :: #type xd3_smatch_cfg |
124 | msel = either (const #{const XD3_SMATCH_SOFT}) | 138 | msel = either (const #{const XD3_SMATCH_SOFT}) |
125 | (fromIntegral . fromEnum) | 139 | (fromIntegral . fromEnum) |
126 | (smatch_cfg cfg) | 140 | (smatch_cfg cfg) |
127 | writeAtByte c #{offset xd3_config, smatch_cfg} msel | 141 | writeAtByte c (#{off xd3_config, smatch_cfg}) msel |
128 | case smatch_cfg cfg of | 142 | case smatch_cfg cfg of |
129 | Right _ -> return () | 143 | Right _ -> return () |
130 | Left matcher -> do | 144 | Left matcher -> do |
131 | let o = #offset xd3_config,smatcher_soft | 145 | let o = offset :: Offset #offset xd3_config,smatcher_soft |
132 | writeAtByte c (o + #{offset xd3_smatcher, name}) nptr | 146 | writeAtByte c (o +. (#{off xd3_smatcher, name})) nptr |
133 | writeMatcher c o matcher | 147 | writeMatcher c o matcher |
134 | unsafeFreezeByteArray c | 148 | unsafeFreezeByteArray c |
135 | let cptr = ptr (byteArrayContents c) :: Ptr Config | 149 | let cptr = ptr (byteArrayContents c) :: Ptr Config |
@@ -173,10 +187,10 @@ set_source stream nm blksz maxwinsz = do | |||
173 | let bsname = encodeUtf8 $ T.pack nm | 187 | let bsname = encodeUtf8 $ T.pack nm |
174 | src <- newPinnedByteArray $ 1 + B.length bsname + #{const sizeof(xd3_source)} | 188 | src <- newPinnedByteArray $ 1 + B.length bsname + #{const sizeof(xd3_source)} |
175 | nptr <- writeStringAt src #{const sizeof(xd3_source)} bsname | 189 | nptr <- writeStringAt src #{const sizeof(xd3_source)} bsname |
176 | writeAtByte src #{offset xd3_source, blksize } blksz | 190 | writeAtByte src (#{off xd3_source, blksize }) blksz |
177 | writeAtByte src #{offset xd3_source, name } nptr | 191 | writeAtByte src (#{off xd3_source, name }) nptr |
178 | writeAtByte src #{offset xd3_source, max_winsize} maxwinsz | 192 | writeAtByte src (#{off xd3_source, max_winsize}) maxwinsz |
179 | writeAtByte src #{offset xd3_source, curblkno } (maxBound :: Xoff_t) | 193 | writeAtByte src (#{off xd3_source, curblkno }) (maxBound :: Xoff_t) |
180 | {- | 194 | {- |
181 | writeAtByte (streamArray stream) | 195 | writeAtByte (streamArray stream) |
182 | #{offset xd3_stream, getblk} | 196 | #{offset xd3_stream, getblk} |
@@ -201,8 +215,8 @@ data XDeltaMethods m u = XDeltaMethods | |||
201 | 215 | ||
202 | setFlag :: PrimMonad m => Flags -> Stream m -> Bool -> m () | 216 | setFlag :: PrimMonad m => Flags -> Stream m -> Bool -> m () |
203 | setFlag b stream wantFlush = do | 217 | setFlag b stream wantFlush = do |
204 | f <- readAtByte (streamArray stream) #{offset xd3_stream, flags} | 218 | f <- readAtByte (streamArray stream) (#{off xd3_stream, flags}) |
205 | writeAtByte (streamArray stream) #{offset xd3_stream, flags} | 219 | writeAtByte (streamArray stream) (#{off xd3_stream, flags}) |
206 | . (coerce :: Flags -> Word32) | 220 | . (coerce :: Flags -> Word32) |
207 | $ if wantFlush then Flags f .|. b | 221 | $ if wantFlush then Flags f .|. b |
208 | else Flags f .&. complement b | 222 | else Flags f .&. complement b |
@@ -218,8 +232,8 @@ setSkipWindow = setFlag XD3_SKIP_WINDOW | |||
218 | 232 | ||
219 | avail_input :: PrimMonad m => Stream m -> Ptr a -> Usize_t -> m () | 233 | avail_input :: PrimMonad m => Stream m -> Ptr a -> Usize_t -> m () |
220 | avail_input stream p sz = do | 234 | avail_input stream p sz = do |
221 | writeAtByte (streamArray stream) #{offset xd3_stream, next_in} p | 235 | writeAtByte (streamArray stream) (#{off xd3_stream, next_in}) p |
222 | writeAtByte (streamArray stream) #{offset xd3_stream, avail_in} sz | 236 | writeAtByte (streamArray stream) (#{off xd3_stream, avail_in}) sz |
223 | 237 | ||
224 | -- | This acknowledges receipt of output data, must be called after any | 238 | -- | This acknowledges receipt of output data, must be called after any |
225 | -- XD3_OUTPUT return. | 239 | -- XD3_OUTPUT return. |
@@ -229,18 +243,18 @@ avail_input stream p sz = do | |||
229 | nextOut :: PrimMonad m => Stream m -> ((Ptr Word8, Usize_t) -> m a) -> m a | 243 | nextOut :: PrimMonad m => Stream m -> ((Ptr Word8, Usize_t) -> m a) -> m a |
230 | nextOut stream action = do | 244 | nextOut stream action = do |
231 | buf <- (,) | 245 | buf <- (,) |
232 | <$> readAtByte (streamArray stream) #{offset xd3_stream, next_out} | 246 | <$> readAtByte (streamArray stream) (#{off xd3_stream, next_out}) |
233 | <*> readAtByte (streamArray stream) #{offset xd3_stream, avail_out} | 247 | <*> readAtByte (streamArray stream) (#{off xd3_stream, avail_out}) |
234 | a <- action buf | 248 | a <- action buf |
235 | -- unsafeIOToPrim $ xd3_consume_output (ptr $ mutableByteArrayContents $ streamArray stream) | 249 | -- unsafeIOToPrim $ xd3_consume_output (ptr $ mutableByteArrayContents $ streamArray stream) |
236 | writeAtByte (streamArray stream) #{offset xd3_stream, avail_out} (0 :: Usize_t) | 250 | writeAtByte (streamArray stream) (#{off xd3_stream, avail_out}) (0 :: Usize_t) |
237 | return a | 251 | return a |
238 | 252 | ||
239 | 253 | ||
240 | requestedBlockNumber :: PrimMonad m => Stream m -> m (Maybe Xoff_t) | 254 | requestedBlockNumber :: PrimMonad m => Stream m -> m (Maybe Xoff_t) |
241 | requestedBlockNumber stream = do | 255 | requestedBlockNumber stream = do |
242 | msrc <- readMutVar $ streamSource stream | 256 | msrc <- readMutVar $ streamSource stream |
243 | forM msrc $ \src -> readAtByte src #offset xd3_source, getblkno | 257 | forM msrc $ \src -> readAtByte src (#{off xd3_source, getblkno}) |
244 | 258 | ||
245 | data CurrentBlock = CurrentBlock | 259 | data CurrentBlock = CurrentBlock |
246 | { blkno :: !Xoff_t -- ^ current block number | 260 | { blkno :: !Xoff_t -- ^ current block number |
@@ -255,7 +269,7 @@ data CurrentBlock = CurrentBlock | |||
255 | -- is known. | 269 | -- is known. |
256 | errorString :: PrimMonad m => Stream m -> m String | 270 | errorString :: PrimMonad m => Stream m -> m String |
257 | errorString stream = do | 271 | errorString stream = do |
258 | cstring <- readAtByte (streamArray stream) #offset xd3_stream, msg | 272 | cstring <- readAtByte (streamArray stream) (#{off xd3_stream, msg}) |
259 | if cstring /= nullPtr | 273 | if cstring /= nullPtr |
260 | then unsafeIOToPrim $ peekCString cstring -- TODO: avoid unsafeIOToPrim | 274 | then unsafeIOToPrim $ peekCString cstring -- TODO: avoid unsafeIOToPrim |
261 | else return "" | 275 | else return "" |
@@ -264,9 +278,9 @@ pokeCurrentBlock :: PrimMonad m => Stream m -> CurrentBlock -> m () | |||
264 | pokeCurrentBlock stream (CurrentBlock no sz ptr) = do | 278 | pokeCurrentBlock stream (CurrentBlock no sz ptr) = do |
265 | msrc <- readMutVar $ streamSource stream | 279 | msrc <- readMutVar $ streamSource stream |
266 | forM_ msrc $ \src -> do | 280 | forM_ msrc $ \src -> do |
267 | writeAtByte src #{offset xd3_source, curblkno} no | 281 | writeAtByte src (#{off xd3_source, curblkno}) no |
268 | writeAtByte src #{offset xd3_source, onblk} sz | 282 | writeAtByte src (#{off xd3_source, onblk}) sz |
269 | writeAtByte src #{offset xd3_source, curblk} ptr | 283 | writeAtByte src (#{off xd3_source, curblk}) ptr |
270 | 284 | ||
271 | 285 | ||
272 | withByteString :: PrimBase m => B.ByteString -> (Ptr b -> Usize_t -> m a) -> m a | 286 | withByteString :: PrimBase m => B.ByteString -> (Ptr b -> Usize_t -> m a) -> m a |
@@ -305,7 +319,7 @@ xdelta x xxcode_input ds = do | |||
305 | pokeCurrentBlock stream $ CurrentBlock n len p | 319 | pokeCurrentBlock stream $ CurrentBlock n len p |
306 | when (len < xBlockSize x) $ do | 320 | when (len < xBlockSize x) $ do |
307 | Just src <- readMutVar $ streamSource stream | 321 | Just src <- readMutVar $ streamSource stream |
308 | writeAtByte src #{offset xd3_source, eof_known} (1 :: #{type int}) | 322 | writeAtByte src (#{off xd3_source, eof_known}) (1 :: #{type int}) |
309 | act | 323 | act |
310 | go2 withBlk' eof ds | 324 | go2 withBlk' eof ds |
311 | XD3_GOTHEADER -> go2 withBlk eof ds -- No | 325 | XD3_GOTHEADER -> go2 withBlk eof ds -- No |
diff --git a/haskell/XDelta/Types.hsc b/haskell/Data/VCDIFF/Types.hsc index 8a60805..015f406 100644 --- a/haskell/XDelta/Types.hsc +++ b/haskell/Data/VCDIFF/Types.hsc | |||
@@ -3,7 +3,7 @@ | |||
3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
4 | {-# LANGUAGE LambdaCase #-} | 4 | {-# LANGUAGE LambdaCase #-} |
5 | {-# LANGUAGE PatternSynonyms #-} | 5 | {-# LANGUAGE PatternSynonyms #-} |
6 | module XDelta.Types where | 6 | module Data.VCDIFF.Types where |
7 | 7 | ||
8 | import Control.Exception | 8 | import Control.Exception |
9 | import Control.Monad | 9 | import Control.Monad |
diff --git a/haskell/offset.h b/haskell/offset.h new file mode 100644 index 0000000..0f344a2 --- /dev/null +++ b/haskell/offset.h | |||
@@ -0,0 +1,2 @@ | |||
1 | |||
2 | #define hsc_off(t, f) hsc_printf("(Offset (%ld) :: Offset (%ld))", (long) offsetof (t, f), (long) offsetof (t, f)); | ||