1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
type cfg = { level: int; q: De.Queue.t; w: De.Lz77.window }
let _unsafe_ctz n =
let t = ref 1 and r = ref 0 in
while n land !t == 0 do
t := !t lsl 1;
incr r
done;
!r
let _unsafe_power_of_two x = x land (x - 1) == 0 && x != 0
let config ?(level = 4) ?(size_of_queue = 0x1000) ?(size_of_window = 0x8000) ()
=
if size_of_queue < 0 then
invalid_arg "Flux_zl.config: invalid negative number for the size of queue";
if not (_unsafe_power_of_two size_of_queue) then
invalid_arg "Flux_zl.config: the size of queue must be a power of two";
if size_of_window < 0 then
invalid_arg "Flux_zl.config: invalid negative number for the size of window";
if not (_unsafe_power_of_two size_of_window) then
invalid_arg "Flux_zl.config: the of size of window must be a power of two";
if _unsafe_ctz size_of_window > 15 then
invalid_arg "Flux_zl.config: too big size of window";
let q = De.Queue.create size_of_queue in
let w = De.Lz77.make_window ~bits:(_unsafe_ctz size_of_window) in
{ level; q; w }
let deflate ~cfg =
let open Flux in
let flow (Sink k) =
let rec emit cb encoder lz77 o acc = function
| `Partial ->
assert (not (k.full acc));
let len = Bstr.length o - De.Def.dst_rem encoder in
let str = Bstr.sub_string o ~off:0 ~len in
let acc = k.push acc str in
De.Def.dst encoder o 0 (Bstr.length o);
if k.full acc then cb encoder lz77 o (`Stop acc)
else emit cb encoder lz77 o acc (De.Def.encode encoder `Await)
| `Ok -> cb encoder lz77 o (`Continue acc)
| `Block ->
let literals = De.Lz77.literals lz77 in
let distances = De.Lz77.distances lz77 in
let dynamic = De.Def.dynamic_of_frequencies ~literals ~distances in
let kind = De.Def.Dynamic dynamic in
emit cb encoder lz77 o acc
(De.Def.encode encoder (`Block { De.Def.kind; last= false }))
in
let rec compress encoder lz77 o acc =
match De.Lz77.compress lz77 with
| `Await -> `Continue (encoder, lz77, o, acc)
| `Flush ->
let literals = De.Lz77.literals lz77 in
let distances = De.Lz77.distances lz77 in
let dynamic = De.Def.dynamic_of_frequencies ~literals ~distances in
let kind = De.Def.Dynamic dynamic in
let cb encoder lz77 o = function
| `Continue acc -> compress encoder lz77 o acc
| `Stop acc -> `Stop acc
in
emit cb encoder lz77 o acc
(De.Def.encode encoder (`Block { De.Def.kind; last= false }))
| `End -> assert false
in
let rec remaining encoder lz77 o acc =
match De.Lz77.compress lz77 with
| `End ->
assert (not (k.full acc));
let kind = De.Def.Fixed in
let cb _encoder _lz77 _o = function
| `Continue acc | `Stop acc -> acc
in
emit cb encoder lz77 o acc
(De.Def.encode encoder (`Block { De.Def.kind; last= true }))
| `Flush ->
let literals = De.Lz77.literals lz77 in
let distances = De.Lz77.distances lz77 in
let dynamic = De.Def.dynamic_of_frequencies ~literals ~distances in
let kind = De.Def.Dynamic dynamic in
let cb encoder lz77 o = function
| `Continue acc -> remaining encoder lz77 o acc
| `Stop acc -> acc
in
emit cb encoder lz77 o acc
(De.Def.encode encoder (`Block { De.Def.kind; last= false }))
| `Await -> assert false
in
let init () =
let w = cfg.w and q = cfg.q and level = cfg.level in
let lz77 = De.Lz77.state ~level ~w ~q `Manual in
let encoder = De.Def.encoder `Manual ~q in
let o = Bstr.create 0x7ff in
De.Queue.reset q;
De.Def.dst encoder o 0 0x7ff;
let acc = k.init () in
`Continue (encoder, lz77, o, acc)
in
let push state bstr =
match (state, Bstr.length bstr) with
| _, 0 | `Stop _, _ -> state
| `Continue (encoder, lz77, o, acc), _ ->
De.Lz77.src lz77 bstr 0 (Bstr.length bstr);
compress encoder lz77 o acc
in
let full = function `Continue (_, _, _, acc) | `Stop acc -> k.full acc in
let stop = function
| `Stop acc -> k.stop acc
| `Continue (encoder, lz77, o, acc) when not (k.full acc) ->
De.Lz77.src lz77 Bstr.empty 0 0;
let acc = remaining encoder lz77 o acc in
k.stop acc
| `Continue (_, _, _, acc) -> k.stop acc
in
Sink { init; push; full; stop }
in
{ flow }