summaryrefslogtreecommitdiff
path: root/haskell/Data
diff options
context:
space:
mode:
Diffstat (limited to 'haskell/Data')
-rw-r--r--haskell/Data/BA.hs17
-rw-r--r--haskell/Data/Primitive/ByteArray/Util.hs45
-rw-r--r--haskell/Data/VCDIFF.hsc (renamed from haskell/Data/XDelta.hsc)108
-rw-r--r--haskell/Data/VCDIFF/Types.hsc208
4 files changed, 314 insertions, 64 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 #-}
3module Data.BA where
4
5import GHC.Exts
6import Control.Monad.Primitive
7import Data.Primitive.Types
8import Data.Primitive.ByteArray
9
10-- | WARNING: Unsafe to use this on packed C structs.
11writeAtByte :: (Prim a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> a -> m ()
12writeAtByte buf offset a = writeByteArray buf (div offset $ I# (sizeOf# a)) a
13{-# INLINE writeAtByte #-}
14
15readAtByte :: forall a m. (Prim a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> m a
16readAtByte 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 #-}
10module Data.Primitive.ByteArray.Util where
11
12import GHC.TypeLits
13import Control.Monad.Primitive
14import Data.Primitive.Types
15import Data.Primitive.ByteArray
16
17newtype Offset (n :: Nat) = Offset Int
18
19offset :: KnownNat n => Offset n
20offset = let k = Offset $ fromIntegral $ natVal k in k
21
22(+.) :: Offset j -> Offset k -> Offset (j + k)
23Offset j +. Offset k = Offset (j + k)
24
25
26type family SizeOf a :: Nat
27
28class IsMultipleOf (n::Nat) (k::Nat)
29
30instance n ~ (q * k) => IsMultipleOf n k
31
32writeAtByte :: ( Prim a
33 , PrimMonad m
34 , IsMultipleOf n (SizeOf a)
35 ) => MutableByteArray (PrimState m) -> Offset n -> a -> m ()
36writeAtByte buf (Offset offset) a = writeByteArray buf (div offset $ (sizeOf a)) a
37{-# INLINE writeAtByte #-}
38
39readAtByte :: forall a m n.
40 ( Prim a
41 , PrimMonad m
42 , IsMultipleOf n (SizeOf a)
43 ) => MutableByteArray (PrimState m) -> Offset n -> m a
44readAtByte 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 #-}
10module Data.XDelta where 16module Data.VCDIFF where
11 17
12import Control.Monad 18import Control.Monad
13import Control.Monad.Primitive 19import Control.Monad.Primitive
14import Control.Monad.ST 20import Control.Monad.ST
15import Control.Monad.ST.Unsafe 21import Control.Monad.ST.Unsafe
16import Data.BA
17import Data.Bits 22import Data.Bits
18import qualified Data.ByteString as B 23import qualified Data.ByteString as B
19import qualified Data.ByteString.Unsafe as B 24import qualified Data.ByteString.Unsafe as B
@@ -25,6 +30,7 @@ import qualified Data.IntMap as IntMap
25import Data.Monoid 30import Data.Monoid
26import Data.Primitive.Addr 31import Data.Primitive.Addr
27import Data.Primitive.ByteArray 32import Data.Primitive.ByteArray
33import Data.Primitive.ByteArray.Util
28import Data.Primitive.MutVar 34import Data.Primitive.MutVar
29import Data.STRef 35import Data.STRef
30import qualified Data.Text as T 36import qualified Data.Text as T
@@ -38,8 +44,9 @@ import Foreign.Concurrent
38import Foreign.Storable 44import Foreign.Storable
39import Foreign.ForeignPtr (ForeignPtr) 45import Foreign.ForeignPtr (ForeignPtr)
40import GHC.Exts 46import GHC.Exts
47import GHC.TypeLits
41 48
42import XDelta.Types 49import 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
53data Stream m = Stream 62data 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
68foreign import ccall "xdelta3.h xd3_close_stream" xd3_close_stream :: Ptr Xd3Stream -> IO ErrorCode 77foreign import ccall "xdelta3.h xd3_close_stream" xd3_close_stream :: Ptr Xd3Stream -> IO ErrorCode
69 78
79type instance SizeOf Usize_t = #const sizeof(usize_t)
80type instance SizeOf (FunPtr a) = #const sizeof(void(*)())
81type instance SizeOf (Ptr a) = #const sizeof(void*)
82type instance SizeOf #{type int} = #const sizeof(int)
83type instance SizeOf #{type unsigned int} = #const sizeof(unsigned int)
84
85
70 86
71writeCompressorConfig :: PrimMonad m => 87writeCompressorConfig :: (PrimMonad m, _) => MutableByteArray (PrimState m) -> Offset j -> CompressorConfig -> m ()
72 MutableByteArray (PrimState m) -> Int -> CompressorConfig -> m ()
73writeCompressorConfig c o sec = do 88writeCompressorConfig 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
78writeMatcher :: PrimMonad m => 93writeMatcher :: (PrimMonad m, _) => MutableByteArray (PrimState m) -> Offset j -> StringMatcher -> m ()
79 MutableByteArray (PrimState m) -> Int -> StringMatcher -> m ()
80writeMatcher c o sm = do 94writeMatcher 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
91ptr :: Addr -> Ptr a 105ptr :: Addr -> Ptr a
92ptr (Addr a) = Ptr a 106ptr (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
202setFlag :: PrimMonad m => Flags -> Stream m -> Bool -> m () 216setFlag :: PrimMonad m => Flags -> Stream m -> Bool -> m ()
203setFlag b stream wantFlush = do 217setFlag 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
219avail_input :: PrimMonad m => Stream m -> Ptr a -> Usize_t -> m () 233avail_input :: PrimMonad m => Stream m -> Ptr a -> Usize_t -> m ()
220avail_input stream p sz = do 234avail_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
229nextOut :: PrimMonad m => Stream m -> ((Ptr Word8, Usize_t) -> m a) -> m a 243nextOut :: PrimMonad m => Stream m -> ((Ptr Word8, Usize_t) -> m a) -> m a
230nextOut stream action = do 244nextOut 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
240requestedBlockNumber :: PrimMonad m => Stream m -> m (Maybe Xoff_t) 254requestedBlockNumber :: PrimMonad m => Stream m -> m (Maybe Xoff_t)
241requestedBlockNumber stream = do 255requestedBlockNumber 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
245data CurrentBlock = CurrentBlock 259data 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.
256errorString :: PrimMonad m => Stream m -> m String 270errorString :: PrimMonad m => Stream m -> m String
257errorString stream = do 271errorString 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 ()
264pokeCurrentBlock stream (CurrentBlock no sz ptr) = do 278pokeCurrentBlock 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
272withByteString :: PrimBase m => B.ByteString -> (Ptr b -> Usize_t -> m a) -> m a 286withByteString :: 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/Data/VCDIFF/Types.hsc b/haskell/Data/VCDIFF/Types.hsc
new file mode 100644
index 0000000..015f406
--- /dev/null
+++ b/haskell/Data/VCDIFF/Types.hsc
@@ -0,0 +1,208 @@
1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE GADTs #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4{-# LANGUAGE LambdaCase #-}
5{-# LANGUAGE PatternSynonyms #-}
6module Data.VCDIFF.Types where
7
8import Control.Exception
9import Control.Monad
10import Data.Bits
11import qualified Data.ByteString as B
12import qualified Data.ByteString.Internal as B
13import Data.Function
14import Data.Int
15import Data.Monoid
16import Data.Primitive.ByteArray
17import qualified Data.Text as T
18import Data.Text.Encoding
19import Data.Word
20import Foreign.C.String
21import Foreign.C.Types
22import Foreign.ForeignPtr
23import Foreign.Marshal.Alloc
24import Foreign.Marshal.Utils
25import Foreign.Ptr
26import Foreign.Storable
27import System.IO
28import System.IO.Error
29import System.IO.Unsafe
30
31
32
33#ifndef SIZEOF_SIZE_T
34#define SIZEOF_SIZE_T __SIZEOF_SIZE_T__
35#define SIZEOF_UNSIGNED_INT __SIZEOF_INT__
36#define SIZEOF_UNSIGNED_LONG __SIZEOF_LONG__
37#define SIZEOF_UNSIGNED_LONG_LONG __SIZEOF_LONG_LONG__
38#define static_assert(...)
39#endif
40#include <xdelta3.h>
41
42type Usize_t = #type usize_t
43-- | Printf code for type Usize_t
44pattern W :: String
45pattern W = #const_str W ""
46
47type Xoff_t = #type xoff_t
48-- | Printf code for type Xoff_t
49pattern Q :: String
50pattern Q = #const_str Q ""
51
52
53-- | These are the five ordinary status codes returned by the
54-- xd3_encode_input() and xd3_decode_input() state machines.
55--
56-- An application must be prepared to handle these five return
57-- values from either xd3_encode_input or xd3_decode_input except
58-- in the case of no-source compression in which case XD3_GETSRCBLK
59-- is never returned. More detailed comments for these are given in
60-- xd3_encode_input and xd3_decode_input comments below.
61newtype ErrorCode = ErrorCode CInt
62 deriving Show
63
64pattern XD3_SUCCESS = ErrorCode 0
65
66-- | need input
67pattern XD3_INPUT = ErrorCode (#const XD3_INPUT)
68
69-- | have output
70pattern XD3_OUTPUT = ErrorCode (#const XD3_OUTPUT)
71
72-- | need a block of source input (with no xd3_getblk function) a chance to do non-blocking read.
73pattern XD3_GETSRCBLK = ErrorCode (#const XD3_GETSRCBLK)
74
75-- | (decode-only) after the initial VCDIFF & first window header
76pattern XD3_GOTHEADER = ErrorCode (#const XD3_GOTHEADER)
77
78-- | notification: returned before a window is processed giving a chance to XD3_SKIP_WINDOW or not XD3_SKIP_EMIT that window.
79pattern XD3_WINSTART = ErrorCode (#const XD3_WINSTART)
80
81-- | notification: returned after encode/decode & output for a window
82pattern XD3_WINFINISH = ErrorCode (#const XD3_WINFINISH)
83
84-- | (encoder only) may be returned by getblk() if the block is too old
85pattern XD3_TOOFARBACK = ErrorCode (#const XD3_TOOFARBACK)
86
87-- | internal error
88pattern XD3_INTERNAL = ErrorCode (#const XD3_INTERNAL)
89
90-- | invalid config
91pattern XD3_INVALID = ErrorCode (#const XD3_INVALID)
92
93-- | invalid input/decoder error
94pattern XD3_INVALID_INPUT = ErrorCode (#const XD3_INVALID_INPUT)
95
96-- | when secondary compression finds no improvement.
97pattern XD3_NOSECOND = ErrorCode (#const XD3_NOSECOND)
98
99-- | currently VCD_TARGET VCD_CODETABLE
100pattern XD3_UNIMPLEMENTED = ErrorCode (#const XD3_UNIMPLEMENTED)
101
102instance Exception ErrorCode
103
104data Config = Config
105 { winsize :: Usize_t -- ^ The encoder window size.
106 -- The encoder allocates a buffer of this size if the
107 -- program supplies input in smaller units (unless the
108 -- XD3_FLUSH flag is set).
109 , sprevsz :: Usize_t -- ^ How far back small string matching goes
110 , iopt_size :: Usize_t -- ^ entries in the instruction-optimizing buffer
111 , flags :: Flags -- ^ stream->flags are initialized from xd3_config & never modified by the library. Use xd3_set_flags to modify flags settings mid-stream.
112 , sec_data :: CompressorConfig -- ^ Secondary compressor config: data
113 , sec_inst :: CompressorConfig -- ^ Secondary compressor config: inst
114 , sec_addr :: CompressorConfig -- ^ Secondary compressor config: addr
115 , smatch_cfg :: Either StringMatcher SMatchSelect -- ^ See enum: use fields below for soft config
116 , chunk_size :: Usize_t -- ^ Suggested chunking size for streaming.
117 }
118
119pattern XD3_DEFAULT_WINSIZE = #const XD3_DEFAULT_WINSIZE
120pattern XD3_DEFAULT_SPREVSZ = #const XD3_DEFAULT_SPREVSZ
121pattern XD3_DEFAULT_IOPT_SIZE = #const XD3_DEFAULT_IOPT_SIZE
122
123newtype Flags = Flags Word32
124 deriving (Storable,Eq,Bits,FiniteBits)
125
126-- used by VCDIFF tools, see xdelta3-main.h.--/
127pattern XD3_JUST_HDR = Flags (#const XD3_JUST_HDR)
128-- used by VCDIFF tools see xdelta3-main.h.--/
129pattern XD3_SKIP_WINDOW = Flags (#const XD3_SKIP_WINDOW)
130-- | used by VCDIFF tools, see xdelta3-main.h. */
131pattern XD3_SKIP_EMIT = Flags (#const XD3_SKIP_EMIT)
132-- | flush the stream buffer to prepare for xd3_stream_close(). */
133pattern XD3_FLUSH = Flags (#const XD3_FLUSH)
134-- | use DJW static huffman */
135pattern XD3_SEC_DJW = Flags (#const XD3_SEC_DJW)
136-- | use FGK adaptive huffman */
137pattern XD3_SEC_FGK = Flags (#const XD3_SEC_FGK)
138-- | use LZMA secondary */
139pattern XD3_SEC_LZMA = Flags (#const XD3_SEC_LZMA)
140pattern XD3_SEC_TYPE = Flags (#const XD3_SEC_TYPE)
141-- | disable secondary compression of the data section. */
142pattern XD3_SEC_NODATA = Flags (#const XD3_SEC_NODATA)
143-- | disable secondary compression of the inst section. */
144pattern XD3_SEC_NOINST = Flags (#const XD3_SEC_NOINST)
145-- | disable secondary compression of the addr section. */
146pattern XD3_SEC_NOADDR = Flags (#const XD3_SEC_NOADDR)
147pattern XD3_SEC_NOALL = Flags (#const XD3_SEC_NOALL)
148-- | enable checksum computation in the encoder. */
149pattern XD3_ADLER32 = Flags (#const XD3_ADLER32)
150-- | disable checksum verification in the decoder. */
151pattern XD3_ADLER32_NOVER = Flags (#const XD3_ADLER32_NOVER)
152-- | disable ordinary data * compression feature, only search * the source, not the target. */
153pattern XD3_NOCOMPRESS = Flags (#const XD3_NOCOMPRESS)
154-- | disable the "1.5-pass * algorithm", instead use greedy * matching. Greedy is off by * default. */
155pattern XD3_BEGREEDY = Flags (#const XD3_BEGREEDY)
156-- | used by "recode". */
157pattern XD3_ADLER32_RECODE = Flags (#const XD3_ADLER32_RECODE)
158-- 4 bits to set the compression level the same as the command-line
159-- setting -1 through -9 Flags (-0 corresponds to the XD3_NOCOMPRESS flag
160-- and is independent of compression level). This is for
161-- convenience especially with xd3_encode_memoryFlags (). */
162pattern XD3_COMPLEVEL_SHIFT = #const XD3_COMPLEVEL_SHIFT
163pattern XD3_COMPLEVEL_MASK = Flags (#const XD3_COMPLEVEL_MASK)
164pattern XD3_COMPLEVEL_1 = Flags (#const XD3_COMPLEVEL_1)
165pattern XD3_COMPLEVEL_2 = Flags (#const XD3_COMPLEVEL_2)
166pattern XD3_COMPLEVEL_3 = Flags (#const XD3_COMPLEVEL_3)
167pattern XD3_COMPLEVEL_6 = Flags (#const XD3_COMPLEVEL_6)
168pattern XD3_COMPLEVEL_9 = Flags (#const XD3_COMPLEVEL_9)
169
170instance Monoid Flags where
171 mempty = Flags 0
172 Flags a `mappend` Flags b = Flags (a .|. b)
173
174-- | Settings for the secondary compressor.
175data CompressorConfig = CompressorConfig
176 { ngroups :: Usize_t -- ^ Number of DJW Huffman groups.
177 , sector_size :: Usize_t -- ^ Sector size.
178 , inefficient :: #{type int} -- ^ If true, ignore efficiency check [avoid XD3_NOSECOND].
179 }
180
181-- | The values of this enumeration are set in xd3_config using the
182-- 'smatch_cfg' variable. It can be set to default, slow, fast, etc.,
183-- and soft.
184data SMatchSelect
185 = SMATCH_DEFAULT -- ^ Flags may contain XD3_COMPLEVEL bits, else default.
186 | SMATCH_SLOW
187 | SMATCH_FAST
188 | SMATCH_FASTER
189 | SMATCH_FASTEST
190 deriving Enum
191
192-- | This type exists only to be a tag for Ptr to an underlying C-struct called
193-- xd3_stream.
194data Xd3Stream
195
196-- | This is the record of a pre-compiled configuration, a subset of
197-- xd3_config. (struct _xd3_smatcher)
198data StringMatcher = StringMatcher
199 { smName :: String
200 , smStringMatch :: FunPtr (Ptr Xd3Stream -> ErrorCode)
201 , smLargeLook :: Usize_t
202 , smLargeStep :: Usize_t
203 , smSmallLook :: Usize_t
204 , smSmallChain :: Usize_t
205 , smSmallLchain :: Usize_t
206 , smMaxLazy :: Usize_t
207 , smLongEnough :: Usize_t
208 }
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-18 12:04:15 +0000