this repo has no description
gdiazlo.tngl.sh
1type order = LSB | MSB
2type error = Invalid_code of int | Unexpected_eof | Buffer_overflow
3
4let error_to_string = function
5 | Invalid_code c -> Printf.sprintf "invalid LZW code: %d" c
6 | Unexpected_eof -> "unexpected end of compressed data"
7 | Buffer_overflow -> "decompressed data too large"
8
9let clear_code = 256
10let eof_code = 257
11let initial_dict_size = 258
12let max_code_bits = 12
13let max_dict_size = 1 lsl max_code_bits
14
15type bit_reader = {
16 data : string;
17 mutable pos : int;
18 mutable bit_pos : int;
19 mutable bits_buf : int;
20 mutable bits_count : int;
21}
22
23let make_bit_reader data =
24 { data; pos = 0; bit_pos = 0; bits_buf = 0; bits_count = 0 }
25
26let read_bits_lsb reader n =
27 while reader.bits_count < n do
28 if reader.pos >= String.length reader.data then raise (Failure "eof")
29 else begin
30 let byte = Char.code reader.data.[reader.pos] in
31 reader.bits_buf <- reader.bits_buf lor (byte lsl reader.bits_count);
32 reader.bits_count <- reader.bits_count + 8;
33 reader.pos <- reader.pos + 1
34 end
35 done;
36 let result = reader.bits_buf land ((1 lsl n) - 1) in
37 reader.bits_buf <- reader.bits_buf lsr n;
38 reader.bits_count <- reader.bits_count - n;
39 result
40
41let decompress ?(order = LSB) ?(lit_width = 8) data =
42 if order <> LSB then Error (Invalid_code 0)
43 else if lit_width <> 8 then Error (Invalid_code 0)
44 else
45 try
46 let reader = make_bit_reader data in
47 let output = Buffer.create (String.length data * 2) in
48
49 let dict = Array.make max_dict_size "" in
50 for i = 0 to 255 do
51 dict.(i) <- String.make 1 (Char.chr i)
52 done;
53 dict.(clear_code) <- "";
54 dict.(eof_code) <- "";
55
56 let dict_size = ref initial_dict_size in
57 let code_bits = ref 9 in
58 let prev_string = ref "" in
59
60 let add_to_dict s =
61 if !dict_size < max_dict_size then begin
62 dict.(!dict_size) <- s;
63 incr dict_size;
64 if !dict_size >= 1 lsl !code_bits && !code_bits < max_code_bits then
65 incr code_bits
66 end
67 in
68
69 let reset_dict () =
70 dict_size := initial_dict_size;
71 code_bits := 9;
72 prev_string := ""
73 in
74
75 let rec decode_loop () =
76 let code = read_bits_lsb reader !code_bits in
77 if code = eof_code then ()
78 else if code = clear_code then begin
79 reset_dict ();
80 decode_loop ()
81 end
82 else begin
83 let current_string =
84 if code < !dict_size then dict.(code)
85 else if code = !dict_size then
86 !prev_string ^ String.make 1 !prev_string.[0]
87 else
88 raise
89 (Failure
90 (Printf.sprintf "invalid code %d >= %d" code !dict_size))
91 in
92 Buffer.add_string output current_string;
93 if !prev_string <> "" then
94 add_to_dict (!prev_string ^ String.make 1 current_string.[0]);
95 prev_string := current_string;
96 decode_loop ()
97 end
98 in
99
100 decode_loop ();
101 Ok (Buffer.contents output)
102 with
103 | Failure msg when msg = "eof" -> Error Unexpected_eof
104 | Failure msg
105 when String.length msg > 12 && String.sub msg 0 12 = "invalid code" ->
106 Error (Invalid_code 0)
107 | _ -> Error (Invalid_code 0)
108
109let decompress_lsb8 data = decompress ~order:LSB ~lit_width:8 data