Something went wrong. Try again.
Zstd compression in pure OCaml
Something went wrong. Try again.
6.2 kB · 183 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184(** Pure OCaml implementation of Zstandard compression (RFC 8878).
{2 Decoder}
The decoder is fully compliant with the zstd format specification and can decompress any valid zstd frame produced by any conforming encoder. It supports all block types (raw, RLE, compressed), Huffman and FSE entropy coding, and content checksums.
{2 Encoder}
The encoder produces valid zstd frames that can be decompressed by any conforming decoder (including the reference C implementation). Current encoding strategy:
- {b RLE blocks}: Data consisting of a single repeated byte is encoded as RLE blocks (4 bytes total regardless of decompressed size) - {b Raw blocks}: All other data is stored as raw (uncompressed) blocks
This means the encoder always produces valid output, but compression ratios are not optimal for most data. The encoder is suitable for: - Applications where decompression speed matters more than compressed size - Data that is already compressed or has high entropy - Testing zstd decoders
Future improvements planned: - LZ77 match finding with sequence encoding - Huffman compression for literals - FSE-compressed blocks for better ratios
{2 Dictionary Support}
Dictionary decompression is supported. Dictionary compression is not yet implemented (falls back to regular compression). *)
type error = Constants.error = | Invalid_magic_number | Invalid_frame_header | Invalid_block_type | Invalid_block_size | Invalid_literals_header | Invalid_huffman_table | Invalid_fse_table | Invalid_sequence_header | Invalid_offset | Invalid_match_length | Truncated_input | Output_too_small | Checksum_mismatch | Dictionary_mismatch | Corruption
exception Zstd_error = Constants.Zstd_error
type dictionary = Zstd_decode.dictionary
let error_message = Constants.error_message
(** Check if data starts with zstd magic number *)let is_zstd_frame s = if String.length s < 4 then false else let b = Bytes.unsafe_of_string s in let magic = Bytes.get_int32_le b 0 in magic = Constants.zstd_magic_number
(** Get decompressed size from frame header *)let get_decompressed_size s = if String.length s < 5 then None else let b = Bytes.unsafe_of_string s in Zstd_decode.get_decompressed_size b ~pos:0 ~len:(String.length s)
(** Calculate maximum compressed size *)let compress_bound src_len = (* zstd guarantees compressed size <= src_len + (src_len >> 8) + constant *) src_len + (src_len lsr 8) + 64
(** Load dictionary *)let load_dictionary s = let b = Bytes.of_string s in Zstd_decode.parse_dictionary b ~pos:0 ~len:(String.length s)
(** Decompress bytes *)let decompress_bytes_exn src = Zstd_decode.decompress_frame src ~pos:0 ~len:(Bytes.length src)
let decompress_bytes src = try Ok (decompress_bytes_exn src) with Zstd_error e -> Error (error_message e)
(** Decompress string *)let decompress_exn s = let src = Bytes.unsafe_of_string s in let result = Zstd_decode.decompress_frame src ~pos:0 ~len:(String.length s) in Bytes.unsafe_to_string result
let decompress s = try Ok (decompress_exn s) with Zstd_error e -> Error (error_message e)
(** Decompress with dictionary *)let decompress_with_dict_exn dict s = let src = Bytes.unsafe_of_string s in let result = Zstd_decode.decompress_frame ~dict src ~pos:0 ~len:(String.length s) in Bytes.unsafe_to_string result
let decompress_with_dict dict s = try Ok (decompress_with_dict_exn dict s) with Zstd_error e -> Error (error_message e)
(** Decompress into pre-allocated buffer *)let decompress_into ~src ~src_pos ~src_len ~dst ~dst_pos = let result = Zstd_decode.decompress_frame src ~pos:src_pos ~len:src_len in let result_len = Bytes.length result in if dst_pos + result_len > Bytes.length dst then raise (Zstd_error Output_too_small); Bytes.blit result 0 dst dst_pos result_len; result_len
(** Compress string *)let compress ?(level=3) s = Zstd_encode.compress ~level ~checksum:true s
(** Compress bytes *)let compress_bytes ?(level=3) src = let s = Bytes.unsafe_to_string src in let result = Zstd_encode.compress ~level ~checksum:true s in Bytes.of_string result
let compress_with_dict ?level _dict s = (* Dictionary compression uses same encoder but with preloaded tables *) (* For now, just compress without dictionary *) compress ?level s
let compress_into ?(level=3) ~src ~src_pos ~src_len ~dst ~dst_pos () = let input = Bytes.sub_string src src_pos src_len in let result = Zstd_encode.compress ~level ~checksum:true input in let result_len = String.length result in if dst_pos + result_len > Bytes.length dst then raise (Zstd_error Output_too_small); Bytes.blit_string result 0 dst dst_pos result_len; result_len
(** Check if data starts with skippable frame magic *)let is_skippable_frame s = let b = Bytes.unsafe_of_string s in Zstd_decode.is_skippable_frame b ~pos:0 ~len:(String.length s)
(** Get skippable frame variant (0-15) *)let get_skippable_variant s = let b = Bytes.unsafe_of_string s in Zstd_decode.get_skippable_variant b ~pos:0 ~len:(String.length s)
(** Write a skippable frame *)let write_skippable_frame ?variant content = Zstd_encode.write_skippable_frame ?variant content
(** Read a skippable frame and return its content *)let read_skippable_frame s = let b = Bytes.unsafe_of_string s in let (content, _) = Zstd_decode.read_skippable_frame b ~pos:0 ~len:(String.length s) in content
(** Get total size of skippable frame *)let get_skippable_frame_size s = let b = Bytes.unsafe_of_string s in Zstd_decode.get_skippable_frame_size b ~pos:0 ~len:(String.length s)
(** Find compressed size of first frame *)let find_frame_compressed_size s = let b = Bytes.unsafe_of_string s in Zstd_decode.find_frame_compressed_size b ~pos:0 ~len:(String.length s)
(** Decompress all frames *)let decompress_all_exn s = let b = Bytes.unsafe_of_string s in let result = Zstd_decode.decompress_frames b ~pos:0 ~len:(String.length s) in Bytes.unsafe_to_string result
let decompress_all s = try Ok (decompress_all_exn s) with Zstd_error e -> Error (error_message e)