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
118
119
120
121
122
123
124
125
126
127
128
129
130
|
exception Error of string * string
let _ =
Callback.register_exception "Zlib.Error" (Error("",""))
type stream
type flush_command =
Z_NO_FLUSH
| Z_SYNC_FLUSH
| Z_FULL_FLUSH
| Z_FINISH
external deflate_init: int -> bool -> stream = "camlzip_deflateInit"
external deflate:
stream -> string -> int -> int -> string -> int -> int -> flush_command
-> bool * int * int
= "camlzip_deflate_bytecode" "camlzip_deflate"
external deflate_end: stream -> unit = "camlzip_deflateEnd"
external inflate_init: bool -> stream = "camlzip_inflateInit"
external inflate:
stream -> string -> int -> int -> string -> int -> int -> flush_command
-> bool * int * int
= "camlzip_inflate_bytecode" "camlzip_inflate"
external inflate_end: stream -> unit = "camlzip_inflateEnd"
external update_crc: int32 -> string -> int -> int -> int32
= "camlzip_update_crc32"
let buffer_size = 1024
let compress ?(level = 6) ?(header = true) refill flush =
let inbuf = String.create buffer_size
and outbuf = String.create buffer_size in
let zs = deflate_init level header in
let rec compr inpos inavail =
if inavail = 0 then begin
let incount = refill inbuf in
if incount = 0 then compr_finish() else compr 0 incount
end else begin
let (_, used_in, used_out) =
deflate zs inbuf inpos inavail outbuf 0 buffer_size Z_NO_FLUSH in
flush outbuf used_out;
compr (inpos + used_in) (inavail - used_in)
end
and compr_finish () =
let (finished, _, used_out) =
deflate zs inbuf 0 0 outbuf 0 buffer_size Z_FINISH in
flush outbuf used_out;
if not finished then compr_finish()
in
compr 0 0;
deflate_end zs
let grow_buffer s =
let s' = String.create (2 * String.length s) in
String.blit s 0 s' 0 (String.length s);
s'
(****
let compress_string ?(level = 6) inbuf =
let zs = deflate_init level true in
let rec compr inpos outbuf outpos =
let inavail = String.length inbuf - inpos in
let outavail = String.length outbuf - outpos in
if outavail = 0
then compr inpos (grow_buffer outbuf) outpos
else begin
let (finished, used_in, used_out) =
deflate zs inbuf inpos inavail outbuf outpos outavail
(if inavail = 0 then Z_FINISH else Z_NO_FLUSH) in
if finished then
String.sub outbuf 0 (outpos + used_out)
else
compr (inpos + used_in) outbuf (outpos + used_out)
end in
let res = compr 0 (String.create (String.length inbuf)) 0 in
deflate_end zs;
res
****)
let uncompress ?(header = true) refill flush =
let inbuf = String.create buffer_size
and outbuf = String.create buffer_size in
let zs = inflate_init header in
let rec uncompr inpos inavail =
if inavail = 0 then begin
let incount = refill inbuf in
if incount = 0 then uncompr_finish true else uncompr 0 incount
end else begin
let (_, used_in, used_out) =
inflate zs inbuf inpos inavail outbuf 0 buffer_size Z_SYNC_FLUSH in
flush outbuf used_out;
uncompr (inpos + used_in) (inavail - used_in)
end
and uncompr_finish first_finish =
(* Gotcha: if there is no header, inflate requires an extra "dummy" byte
after the compressed stream in order to complete decompression
and return finished = true. *)
let dummy_byte = if first_finish && not header then 1 else 0 in
let (finished, _, used_out) =
inflate zs inbuf 0 dummy_byte outbuf 0 buffer_size Z_SYNC_FLUSH in
flush outbuf used_out;
if not finished then uncompr_finish false
in
uncompr 0 0;
inflate_end zs
(*****
let uncompress_string inbuf =
let zs = inflate_init true in
let rec uncompr inpos outbuf outpos =
let inavail = String.length inbuf - inpos in
let outavail = String.length outbuf - outpos in
if outavail = 0
then uncompr inpos (grow_buffer outbuf) outpos
else begin
let (finished, used_in, used_out) =
inflate zs inbuf inpos inavail outbuf outpos outavail Z_SYNC_FLUSH in
if finished then
String.sub outbuf 0 (outpos + used_out)
else
uncompr (inpos + used_in) outbuf (outpos + used_out)
end in
let res = uncompr 0 (String.create (2 * String.length inbuf)) 0 in
inflate_end zs;
res
*****)
|
