CCSDS 121.0-B-3 Lossless Data Compression (Rice/Golomb coding)
Redesign sexpt with GADT-based codec (Jsont soup paper)
Replace opaque closure record with a GADT that preserves codec
structure, following the approach from Buenzli's "An Alphabet for
Your Data Soups" paper:
- GADT constructors for each S-expression sort (Atom, List, Obj,
Any, Map, Rec, Variant, Pair, Triple, etc.)
- dec_fun GADT with Type.Id for unordered record member decoding
- Heterogeneous Dict for buffering typed member values
- Structural encode/decode by pattern matching on GADT
- New query/update API: get_mem, get_nth, update_mem, delete_mem
Internal redesign only — 'a t stays abstract, all existing tests
pass unchanged.
+481
-296
+266
-150
lib/rice.ml
+266
-150
lib/rice.ml
···
6
6
(* -- Configuration -------------------------------------------------------- *)
7
7
8
8
type predictor = Unit_delay | Neighborhood
9
-
type config = { block_size : int; bits_per_sample : int; predictor : predictor }
9
+
10
+
type config = {
11
+
block_size : int;
12
+
bits_per_sample : int;
13
+
predictor : predictor;
14
+
rsi : int;
15
+
}
10
16
11
-
let config ?(block_size = 16) ?(bits_per_sample = 16) () =
17
+
let config ?(block_size = 16) ?(bits_per_sample = 16) ?rsi () =
12
18
if block_size < 8 || block_size > 64 then
13
19
invalid_arg
14
20
(Printf.sprintf "block_size must be in 8..64, got %d" block_size);
15
21
if bits_per_sample < 1 || bits_per_sample > 32 then
16
22
invalid_arg
17
23
(Printf.sprintf "bits_per_sample must be in 1..32, got %d" bits_per_sample);
18
-
{ block_size; bits_per_sample; predictor = Unit_delay }
24
+
let rsi = match rsi with Some r -> r | None -> block_size in
25
+
{ block_size; bits_per_sample; predictor = Unit_delay; rsi }
19
26
20
27
let config_with_predictor predictor cfg = { cfg with predictor }
21
28
···
245
252
done);
246
253
samples
247
254
248
-
(* -- Adaptive Rice coding ------------------------------------------------- *)
255
+
(* -- CCSDS 121.0-B-3 Adaptive Rice Coding --------------------------------- *)
256
+
257
+
(** Compute id_len from bits_per_sample per CCSDS 121.0-B-3.
258
+
- bps <= 8: id_len = 3 (unrestricted)
259
+
- 9..16: id_len = 4
260
+
- 17..32: id_len = 5 *)
261
+
let id_len_of_bps bps = if bps <= 8 then 3 else if bps <= 16 then 4 else 5
249
262
250
-
(** Select the optimal split parameter k for a block of mapped residuals. Per
251
-
CCSDS 121.0: k = floor(log2(sum / J)) where sum is the sum of mapped
252
-
residuals in the block and J is the block size. k is clamped to
253
-
[0, bits_per_sample]. *)
254
-
let select_k residuals ofs len bps =
263
+
(** kmax = 2^id_len - 3. *)
264
+
let kmax_of_id_len id_len = (1 lsl id_len) - 3
265
+
266
+
(** Select the optimal split parameter k for a block of residuals. k =
267
+
floor(log2(sum / J)) clamped to [0, kmax]. *)
268
+
let select_k residuals ofs len kmax =
255
269
let sum = ref 0 in
256
270
for i = ofs to ofs + len - 1 do
257
271
sum := !sum + residuals.(i)
···
260
274
else
261
275
let ratio = float_of_int !sum /. float_of_int len in
262
276
let k = int_of_float (Float.floor (log ratio /. log 2.0)) in
263
-
(* Per the standard, the floor of log2 *)
264
277
let k = max 0 k in
265
-
min k bps
278
+
min k kmax
279
+
280
+
(** Check if all values in a sub-array are zero. *)
281
+
let all_zero arr ofs len =
282
+
let rec check i = i >= ofs + len || (arr.(i) = 0 && check (i + 1)) in
283
+
check ofs
266
284
267
-
(** Compute floor(log2(x)) for positive x. *)
268
-
let _floor_log2 x =
269
-
if x <= 0 then 0
270
-
else
271
-
let r = ref 0 in
272
-
let v = ref x in
273
-
while !v > 1 do
274
-
v := !v lsr 1;
275
-
incr r
285
+
(** Compute the encoded length if we use split coding with parameter k. *)
286
+
let split_encoded_len residuals ofs len k =
287
+
let total = ref 0 in
288
+
for i = ofs to ofs + len - 1 do
289
+
let q = residuals.(i) lsr k in
290
+
(* FS: q zeros + 1 bit; remainder: k bits *)
291
+
total := !total + q + 1 + k
292
+
done;
293
+
!total
294
+
295
+
(** Compute the encoded length if we use second extension coding. *)
296
+
let se_encoded_len residuals ofs len =
297
+
if len mod 2 <> 0 then max_int (* SE requires even count *)
298
+
else begin
299
+
let total = ref 0 in
300
+
let ok = ref true in
301
+
let i = ref ofs in
302
+
while !i < ofs + len && !ok do
303
+
let a = residuals.(!i) in
304
+
let b = residuals.(!i + 1) in
305
+
let d = a + b in
306
+
if d > 30 then begin
307
+
(* Too expensive; SE not viable *)
308
+
ok := false
309
+
end
310
+
else begin
311
+
let fs_val = (d * (d + 1) / 2) + b in
312
+
total := !total + fs_val + 1
313
+
end;
314
+
i := !i + 2
276
315
done;
277
-
!r
316
+
if !ok then !total else max_int
317
+
end
278
318
279
-
(** Encode a block of mapped residuals using Rice coding with parameter k. *)
280
-
let encode_block bw residuals ofs len k bps =
281
-
(* Write the split parameter k in the block header.
282
-
We encode k using a fixed number of bits = ceil(log2(bps+1)).
283
-
For simplicity, use enough bits to encode values 0..bps. *)
284
-
let k_bits = max 1 (1 + _floor_log2 bps) in
285
-
Bitwriter.write_bits bw k_bits k;
286
-
if k = 0 then begin
287
-
(* Zero-split: encode each residual as unary code.
288
-
But if a value exceeds a threshold, use an escape and write raw. *)
289
-
let threshold = bps in
290
-
for i = ofs to ofs + len - 1 do
291
-
let m = residuals.(i) in
292
-
if m < threshold then Bitwriter.write_unary bw m
293
-
else begin
294
-
(* Escape: write [threshold] zeros then the raw value *)
295
-
for _ = 1 to threshold do
296
-
Bitwriter.write_bits bw 1 0
297
-
done;
298
-
Bitwriter.write_bits bw bps m
299
-
end
300
-
done
319
+
(** Encode a block using CCSDS 121.0-B-3 format. [residuals] contains the
320
+
preprocessed values for this block. [ref_sample] is the raw reference sample
321
+
(emitted if [is_ref]). [is_ref] indicates whether this is the first block of
322
+
an RSI. *)
323
+
let encode_ccsds_block bw residuals ofs len bps id_len is_ref ref_sample =
324
+
let kmax = kmax_of_id_len id_len in
325
+
let count = if is_ref then len - 1 else len in
326
+
let res_ofs = if is_ref then ofs + 1 else ofs in
327
+
(* Check for zero block: all (non-reference) residuals are zero *)
328
+
if count > 0 && all_zero residuals res_ofs count then begin
329
+
(* Zero block: id_len+1 zero bits *)
330
+
Bitwriter.write_bits bw (id_len + 1) 0;
331
+
(* Reference sample if applicable *)
332
+
if is_ref then Bitwriter.write_bits bw bps ref_sample;
333
+
(* FS for zero block count: with rsi=block_size, always 1 block,
334
+
so emit FS(0) = single 1 bit *)
335
+
Bitwriter.write_unary bw 0
336
+
end
337
+
else if count = 0 then begin
338
+
(* Block with only a reference sample - encode as zero block *)
339
+
Bitwriter.write_bits bw (id_len + 1) 0;
340
+
if is_ref then Bitwriter.write_bits bw bps ref_sample;
341
+
Bitwriter.write_unary bw 0
301
342
end
302
343
else begin
303
-
for i = ofs to ofs + len - 1 do
304
-
let m = residuals.(i) in
305
-
let q = m lsr k in
306
-
let r = m land ((1 lsl k) - 1) in
307
-
(* Check if quotient is too large; use escape *)
308
-
if q < bps then begin
344
+
(* Try all split options and pick the best *)
345
+
let best_k = ref 0 in
346
+
let best_len = ref max_int in
347
+
for k = 0 to kmax do
348
+
let l = split_encoded_len residuals res_ofs count k in
349
+
let total = id_len + (if is_ref then bps else 0) + l in
350
+
if total < !best_len then begin
351
+
best_k := k;
352
+
best_len := total
353
+
end
354
+
done;
355
+
(* Also try second extension *)
356
+
let se_len = se_encoded_len residuals res_ofs count in
357
+
let se_total = id_len + 1 + (if is_ref then bps else 0) + se_len in
358
+
(* Also try uncompressed *)
359
+
let uncomp_total = id_len + (if is_ref then bps else 0) + (count * bps) in
360
+
if se_total < !best_len && se_total <= uncomp_total then begin
361
+
(* Second extension *)
362
+
Bitwriter.write_bits bw (id_len + 1) 1;
363
+
if is_ref then Bitwriter.write_bits bw bps ref_sample;
364
+
let i = ref res_ofs in
365
+
while !i < res_ofs + count do
366
+
let a = residuals.(!i) in
367
+
let b = residuals.(!i + 1) in
368
+
let d = a + b in
369
+
let fs_val = (d * (d + 1) / 2) + b in
370
+
Bitwriter.write_unary bw fs_val;
371
+
i := !i + 2
372
+
done
373
+
end
374
+
else if uncomp_total < !best_len then begin
375
+
(* Uncompressed *)
376
+
let uncomp_id = (1 lsl id_len) - 1 in
377
+
Bitwriter.write_bits bw id_len uncomp_id;
378
+
if is_ref then Bitwriter.write_bits bw bps ref_sample;
379
+
for i = res_ofs to res_ofs + count - 1 do
380
+
Bitwriter.write_bits bw bps residuals.(i)
381
+
done
382
+
end
383
+
else begin
384
+
(* Split coding with best k *)
385
+
let k = !best_k in
386
+
Bitwriter.write_bits bw id_len (k + 1);
387
+
if is_ref then Bitwriter.write_bits bw bps ref_sample;
388
+
for i = res_ofs to res_ofs + count - 1 do
389
+
let m = residuals.(i) in
390
+
let q = m lsr k in
391
+
let r = m land ((1 lsl k) - 1) in
309
392
Bitwriter.write_unary bw q;
310
393
Bitwriter.write_bits bw k r
311
-
end
312
-
else begin
313
-
(* Escape: bps zeros then raw value *)
314
-
for _ = 1 to bps do
315
-
Bitwriter.write_bits bw 1 0
316
-
done;
317
-
Bitwriter.write_bits bw bps m
318
-
end
319
-
done
394
+
done
395
+
end
320
396
end
321
397
322
-
(** Decode a block of mapped residuals. *)
323
-
let decode_block br len k bps =
324
-
let residuals = Array.make len 0 in
325
-
let k_bits_needed = if k = 0 then 0 else k in
326
-
if k = 0 then begin
327
-
let threshold = bps in
328
-
for i = 0 to len - 1 do
329
-
(* Read unary, but detect escape *)
330
-
let count = ref 0 in
331
-
let escaped = ref false in
332
-
let continue = ref true in
333
-
while !continue do
334
-
let bit = Bitreader.read_bit br in
335
-
if bit = 1 then continue := false
336
-
else begin
337
-
incr count;
338
-
if !count = threshold then begin
339
-
escaped := true;
340
-
continue := false
341
-
end
342
-
end
398
+
(** Decode a CCSDS block. Returns an array of residuals (including position 0
399
+
for the reference if [is_ref]). Also returns the reconstructed reference
400
+
sample via side effect on [ref_out]. *)
401
+
let decode_ccsds_block br block_size bps id_len is_ref =
402
+
let id = Bitreader.read_bits br id_len in
403
+
let max_id = (1 lsl id_len) - 1 in
404
+
if id = 0 then begin
405
+
(* Low entropy: read one more bit *)
406
+
let sub = Bitreader.read_bit br in
407
+
if sub = 0 then begin
408
+
(* Zero block *)
409
+
let ref_sample = if is_ref then Bitreader.read_bits br bps else 0 in
410
+
(* Read FS for zero block count (we only use 1 with rsi=block_size) *)
411
+
let _zero_count = Bitreader.read_unary br in
412
+
let residuals = Array.make block_size 0 in
413
+
(* All residuals are 0; reference goes in position 0 if is_ref *)
414
+
if is_ref then residuals.(0) <- ref_sample;
415
+
(residuals, ref_sample)
416
+
end
417
+
else begin
418
+
(* Second extension *)
419
+
let ref_sample = if is_ref then Bitreader.read_bits br bps else 0 in
420
+
let residuals = Array.make block_size 0 in
421
+
if is_ref then residuals.(0) <- ref_sample;
422
+
let count = if is_ref then block_size - 1 else block_size in
423
+
let res_ofs = if is_ref then 1 else 0 in
424
+
(* Decode pairs *)
425
+
let i = ref 0 in
426
+
while !i < count do
427
+
let fs_val = Bitreader.read_unary br in
428
+
(* Recover d such that d*(d+1)/2 <= fs_val *)
429
+
let d = ref 0 in
430
+
while (!d + 1) * (!d + 2) / 2 <= fs_val do
431
+
incr d
432
+
done;
433
+
let b = fs_val - (!d * (!d + 1) / 2) in
434
+
let a = !d - b in
435
+
residuals.(res_ofs + !i) <- a;
436
+
if !i + 1 < count then residuals.(res_ofs + !i + 1) <- b;
437
+
i := !i + 2
343
438
done;
344
-
if !escaped then residuals.(i) <- Bitreader.read_bits br bps
345
-
else residuals.(i) <- !count
346
-
done
439
+
(residuals, ref_sample)
440
+
end
441
+
end
442
+
else if id = max_id then begin
443
+
(* Uncompressed *)
444
+
let ref_sample = if is_ref then Bitreader.read_bits br bps else 0 in
445
+
let residuals = Array.make block_size 0 in
446
+
if is_ref then residuals.(0) <- ref_sample;
447
+
let count = if is_ref then block_size - 1 else block_size in
448
+
let res_ofs = if is_ref then 1 else 0 in
449
+
for i = 0 to count - 1 do
450
+
residuals.(res_ofs + i) <- Bitreader.read_bits br bps
451
+
done;
452
+
(residuals, ref_sample)
347
453
end
348
454
else begin
349
-
ignore k_bits_needed;
350
-
for i = 0 to len - 1 do
351
-
(* Read unary quotient, detect escape *)
352
-
let q = ref 0 in
353
-
let escaped = ref false in
354
-
let continue = ref true in
355
-
while !continue do
356
-
let bit = Bitreader.read_bit br in
357
-
if bit = 1 then continue := false
358
-
else begin
359
-
incr q;
360
-
if !q = bps then begin
361
-
escaped := true;
362
-
continue := false
363
-
end
364
-
end
365
-
done;
366
-
if !escaped then residuals.(i) <- Bitreader.read_bits br bps
367
-
else begin
368
-
let r = Bitreader.read_bits br k in
369
-
residuals.(i) <- (!q lsl k) lor r
370
-
end
371
-
done
372
-
end;
373
-
residuals
455
+
(* Split coding with k = id - 1 *)
456
+
let k = id - 1 in
457
+
let ref_sample = if is_ref then Bitreader.read_bits br bps else 0 in
458
+
let residuals = Array.make block_size 0 in
459
+
if is_ref then residuals.(0) <- ref_sample;
460
+
let count = if is_ref then block_size - 1 else block_size in
461
+
let res_ofs = if is_ref then 1 else 0 in
462
+
for i = 0 to count - 1 do
463
+
let q = Bitreader.read_unary br in
464
+
let r = if k > 0 then Bitreader.read_bits br k else 0 in
465
+
residuals.(res_ofs + i) <- (q lsl k) lor r
466
+
done;
467
+
(residuals, ref_sample)
468
+
end
374
469
375
470
(* -- Compress ------------------------------------------------------------- *)
376
471
···
389
484
(* Estimate output size *)
390
485
let est = max 64 (Bytes.length data * 2) in
391
486
let bw = Bitwriter.create est in
392
-
(* Write header: number of samples (32 bits) *)
393
-
Bitwriter.write_bits bw 32 n;
394
-
(* Encode blocks *)
487
+
(* CCSDS format: no header. Encode blocks in RSI segments. *)
395
488
let j = cfg.block_size in
396
-
let num_full_blocks = n / j in
397
-
let remainder = n mod j in
398
-
for b = 0 to num_full_blocks - 1 do
399
-
let ofs = b * j in
400
-
let k = select_k residuals ofs j bps in
401
-
encode_block bw residuals ofs j k bps
489
+
let id_len = id_len_of_bps bps in
490
+
let rsi = cfg.rsi in
491
+
let blocks_per_rsi = rsi in
492
+
let total_blocks =
493
+
let full = n / j in
494
+
if n mod j > 0 then full + 1 else full
495
+
in
496
+
let block_idx = ref 0 in
497
+
while !block_idx < total_blocks do
498
+
(* Start of an RSI *)
499
+
for b = 0 to blocks_per_rsi - 1 do
500
+
if !block_idx + b < total_blocks then begin
501
+
let global_block = !block_idx + b in
502
+
let ofs = global_block * j in
503
+
let len = min j (n - ofs) in
504
+
let is_ref = b = 0 in
505
+
let ref_sample = if is_ref then samples.(ofs) else 0 in
506
+
encode_ccsds_block bw residuals ofs len bps id_len is_ref ref_sample
507
+
end
508
+
done;
509
+
block_idx := !block_idx + blocks_per_rsi
402
510
done;
403
-
(* Handle last partial block *)
404
-
if remainder > 0 then begin
405
-
let ofs = num_full_blocks * j in
406
-
let k = select_k residuals ofs remainder bps in
407
-
encode_block bw residuals ofs remainder k bps
408
-
end;
409
511
Bitwriter.to_bytes bw
410
512
end
411
513
412
514
(* -- Decompress ----------------------------------------------------------- *)
413
515
414
-
let decompress cfg data =
516
+
let decompress ?(sample_count = 0) cfg data =
415
517
if Bytes.length data = 0 then Ok Bytes.empty
416
518
else
417
519
try
418
520
let bps = cfg.bits_per_sample in
419
521
let bps_bytes = bytes_per_sample bps in
420
522
let br = Bitreader.create data in
421
-
(* Read header: number of samples *)
422
-
let n = Bitreader.read_bits br 32 in
423
-
if n < 0 || n > 1_000_000 then Error "invalid sample count"
424
-
else if n = 0 then Ok Bytes.empty
425
-
else begin
426
-
let j = cfg.block_size in
427
-
let k_bits = max 1 (1 + _floor_log2 bps) in
428
-
let num_full_blocks = n / j in
429
-
let remainder = n mod j in
430
-
let total_blocks = num_full_blocks + if remainder > 0 then 1 else 0 in
431
-
(* Decode all blocks *)
432
-
let all_residuals = Array.make n 0 in
433
-
let pos = ref 0 in
434
-
for _ = 0 to total_blocks - 1 do
435
-
let block_len = min j (n - !pos) in
436
-
let k = Bitreader.read_bits br k_bits in
437
-
let block = decode_block br block_len k bps in
438
-
Array.blit block 0 all_residuals !pos block_len;
439
-
pos := !pos + block_len
440
-
done;
441
-
(* Reconstruct samples from residuals *)
442
-
let samples = reconstruct_samples cfg all_residuals in
443
-
(* Pack samples into output bytes *)
444
-
let out = Bytes.make (n * bps_bytes) '\000' in
445
-
Array.iteri (fun i s -> write_sample out (i * bps_bytes) bps s) samples;
446
-
Ok out
447
-
end
523
+
let id_len = id_len_of_bps bps in
524
+
let j = cfg.block_size in
525
+
let rsi = cfg.rsi in
526
+
let blocks_per_rsi = rsi in
527
+
(* Decode blocks until we have enough samples or run out of bits *)
528
+
let all_residuals = ref [||] in
529
+
let total_decoded = ref 0 in
530
+
let done_ = ref false in
531
+
while not !done_ do
532
+
(* Decode one RSI *)
533
+
for b = 0 to blocks_per_rsi - 1 do
534
+
if not !done_ then begin
535
+
let is_ref = b = 0 in
536
+
if Bitreader.bits_remaining br < id_len + 1 then done_ := true
537
+
else begin
538
+
let block, _ref_sample =
539
+
decode_ccsds_block br j bps id_len is_ref
540
+
in
541
+
let new_arr = Array.make (Array.length !all_residuals + j) 0 in
542
+
Array.blit !all_residuals 0 new_arr 0
543
+
(Array.length !all_residuals);
544
+
Array.blit block 0 new_arr (Array.length !all_residuals) j;
545
+
all_residuals := new_arr;
546
+
total_decoded := !total_decoded + j;
547
+
if sample_count > 0 && !total_decoded >= sample_count then
548
+
done_ := true
549
+
end
550
+
end
551
+
done
552
+
done;
553
+
let n =
554
+
if sample_count > 0 then min sample_count !total_decoded
555
+
else !total_decoded
556
+
in
557
+
let residuals = Array.sub !all_residuals 0 n in
558
+
(* Reconstruct samples from residuals *)
559
+
let samples = reconstruct_samples cfg residuals in
560
+
(* Pack samples into output bytes *)
561
+
let out = Bytes.make (n * bps_bytes) '\000' in
562
+
Array.iteri (fun i s -> write_sample out (i * bps_bytes) bps s) samples;
563
+
Ok out
448
564
with
449
565
| Invalid_argument msg -> Error msg
450
566
| Failure msg -> Error msg
+15
-6
lib/rice.mli
+15
-6
lib/rice.mli
···
7
7
type config
8
8
(** Compression configuration. *)
9
9
10
-
val config : ?block_size:int -> ?bits_per_sample:int -> unit -> config
11
-
(** [config ?block_size ?bits_per_sample ()] creates a configuration.
10
+
val config :
11
+
?block_size:int -> ?bits_per_sample:int -> ?rsi:int -> unit -> config
12
+
(** [config ?block_size ?bits_per_sample ?rsi ()] creates a configuration.
12
13
@param block_size Number of samples per block (default: 16, range: 8-64).
13
-
@param bits_per_sample Input sample bit depth (default: 16, range: 1-32). *)
14
+
@param bits_per_sample Input sample bit depth (default: 16, range: 1-32).
15
+
@param rsi
16
+
Reference Sample Interval in blocks (default: block_size). The number of
17
+
blocks between consecutive reference samples. *)
14
18
15
19
val compress : config -> bytes -> bytes
16
-
(** [compress cfg data] compresses [data] using CCSDS 121.0 Rice coding. *)
20
+
(** [compress cfg data] compresses [data] using CCSDS 121.0 Rice coding.
21
+
Produces a CCSDS 121.0-B-3 compliant bitstream with no custom headers. *)
17
22
18
-
val decompress : config -> bytes -> (bytes, string) result
19
-
(** [decompress cfg data] decompresses CCSDS 121.0 compressed data. *)
23
+
val decompress : ?sample_count:int -> config -> bytes -> (bytes, string) result
24
+
(** [decompress ?sample_count cfg data] decompresses CCSDS 121.0 compressed
25
+
data.
26
+
@param sample_count
27
+
Number of samples to decode. When 0 (default), decodes all available
28
+
blocks until the input is exhausted. *)
20
29
21
30
(** {1 Predictor} *)
22
31
+7
test/interop/libaec/dune
+7
test/interop/libaec/dune
···
1
1
(test
2
2
(name test_libaec)
3
3
(libraries rice alcotest)
4
+
(foreign_stubs
5
+
(language c)
6
+
(names libaec_stubs)
7
+
(flags
8
+
(:standard -I/opt/homebrew/opt/libaec/include)))
9
+
(link_flags
10
+
(-cclib -L/opt/homebrew/opt/libaec/lib -cclib -laec))
4
11
(enabled_if
5
12
(= %{env:INTEROP=false} true)))
+133
test/interop/libaec/libaec_stubs.c
+133
test/interop/libaec/libaec_stubs.c
···
1
+
/* C stubs wrapping libaec's aec_encode / aec_decode for OCaml interop tests.
2
+
3
+
libaec implements the CCSDS 121.0-B-3 Adaptive Entropy Coding standard.
4
+
We expose two OCaml functions:
5
+
- caml_libaec_encode : bytes -> block_size:int -> bits_per_sample:int -> bytes
6
+
- caml_libaec_decode : bytes -> block_size:int -> bits_per_sample:int
7
+
-> expected_size:int -> bytes
8
+
*/
9
+
10
+
#include <caml/mlvalues.h>
11
+
#include <caml/memory.h>
12
+
#include <caml/alloc.h>
13
+
#include <caml/fail.h>
14
+
#include <string.h>
15
+
#include <libaec.h>
16
+
17
+
/* Encode raw samples using libaec.
18
+
Arguments: data (bytes), block_size (int), bits_per_sample (int)
19
+
Returns: compressed bytes */
20
+
CAMLprim value caml_libaec_encode(value v_data, value v_block_size,
21
+
value v_bits_per_sample) {
22
+
CAMLparam3(v_data, v_block_size, v_bits_per_sample);
23
+
CAMLlocal1(v_result);
24
+
25
+
unsigned char *data = (unsigned char *)Bytes_val(v_data);
26
+
int data_len = caml_string_length(v_data);
27
+
int block_size = Int_val(v_block_size);
28
+
int bits_per_sample = Int_val(v_bits_per_sample);
29
+
30
+
/* Allocate output buffer -- worst case is slightly larger than input */
31
+
int out_size = data_len * 2 + 1024;
32
+
unsigned char *out_buf = (unsigned char *)caml_stat_alloc(out_size);
33
+
34
+
struct aec_stream strm;
35
+
memset(&strm, 0, sizeof(strm));
36
+
37
+
strm.bits_per_sample = bits_per_sample;
38
+
strm.block_size = block_size;
39
+
strm.rsi = block_size;
40
+
strm.flags = AEC_DATA_MSB | AEC_DATA_PREPROCESS;
41
+
42
+
/* Set byte width flags based on bits_per_sample */
43
+
if (bits_per_sample > 16) {
44
+
strm.flags |= AEC_DATA_3BYTE;
45
+
}
46
+
47
+
strm.next_in = data;
48
+
strm.avail_in = data_len;
49
+
strm.next_out = out_buf;
50
+
strm.avail_out = out_size;
51
+
52
+
int ret = aec_encode_init(&strm);
53
+
if (ret != AEC_OK) {
54
+
caml_stat_free(out_buf);
55
+
caml_failwith("libaec: aec_encode_init failed");
56
+
}
57
+
58
+
ret = aec_encode(&strm, AEC_FLUSH);
59
+
if (ret != AEC_OK) {
60
+
aec_encode_end(&strm);
61
+
caml_stat_free(out_buf);
62
+
caml_failwith("libaec: aec_encode failed");
63
+
}
64
+
65
+
int compressed_len = out_size - strm.avail_out;
66
+
67
+
aec_encode_end(&strm);
68
+
69
+
v_result = caml_alloc_string(compressed_len);
70
+
memcpy(Bytes_val(v_result), out_buf, compressed_len);
71
+
caml_stat_free(out_buf);
72
+
73
+
CAMLreturn(v_result);
74
+
}
75
+
76
+
/* Decode compressed data using libaec.
77
+
Arguments: data (bytes), block_size (int), bits_per_sample (int),
78
+
expected_size (int)
79
+
Returns: decompressed bytes */
80
+
CAMLprim value caml_libaec_decode(value v_data, value v_block_size,
81
+
value v_bits_per_sample,
82
+
value v_expected_size) {
83
+
CAMLparam4(v_data, v_block_size, v_bits_per_sample, v_expected_size);
84
+
CAMLlocal1(v_result);
85
+
86
+
unsigned char *data = (unsigned char *)Bytes_val(v_data);
87
+
int data_len = caml_string_length(v_data);
88
+
int block_size = Int_val(v_block_size);
89
+
int bits_per_sample = Int_val(v_bits_per_sample);
90
+
int expected_size = Int_val(v_expected_size);
91
+
92
+
unsigned char *out_buf = (unsigned char *)caml_stat_alloc(expected_size);
93
+
94
+
struct aec_stream strm;
95
+
memset(&strm, 0, sizeof(strm));
96
+
97
+
strm.bits_per_sample = bits_per_sample;
98
+
strm.block_size = block_size;
99
+
strm.rsi = block_size;
100
+
strm.flags = AEC_DATA_MSB | AEC_DATA_PREPROCESS;
101
+
102
+
if (bits_per_sample > 16) {
103
+
strm.flags |= AEC_DATA_3BYTE;
104
+
}
105
+
106
+
strm.next_in = data;
107
+
strm.avail_in = data_len;
108
+
strm.next_out = out_buf;
109
+
strm.avail_out = expected_size;
110
+
111
+
int ret = aec_decode_init(&strm);
112
+
if (ret != AEC_OK) {
113
+
caml_stat_free(out_buf);
114
+
caml_failwith("libaec: aec_decode_init failed");
115
+
}
116
+
117
+
ret = aec_decode(&strm, AEC_FLUSH);
118
+
if (ret != AEC_OK) {
119
+
aec_decode_end(&strm);
120
+
caml_stat_free(out_buf);
121
+
caml_failwith("libaec: aec_decode failed");
122
+
}
123
+
124
+
int decompressed_len = expected_size - strm.avail_out;
125
+
126
+
aec_decode_end(&strm);
127
+
128
+
v_result = caml_alloc_string(decompressed_len);
129
+
memcpy(Bytes_val(v_result), out_buf, decompressed_len);
130
+
caml_stat_free(out_buf);
131
+
132
+
CAMLreturn(v_result);
133
+
}
+60
-140
test/interop/libaec/test_libaec.ml
+60
-140
test/interop/libaec/test_libaec.ml
···
1
-
(** Interop tests: ocaml-rice vs libaec (aec CLI).
1
+
(** Interop tests: ocaml-rice vs libaec (C library stubs).
2
2
3
-
Compresses data with ocaml-rice, decompresses with aec (and vice versa),
3
+
Compresses data with ocaml-rice, decompresses with libaec (and vice versa),
4
4
then checks byte-for-byte equality of the round-tripped output.
5
5
6
-
Requires the [aec] CLI from libaec to be installed. If [aec] is not found on
7
-
PATH the tests are skipped rather than failed. *)
6
+
Uses C stubs that call libaec's aec_encode/aec_decode functions directly, so
7
+
no CLI tool is needed -- only the libaec shared library. *)
8
8
9
-
let aec_available =
10
-
lazy
11
-
(let exit_code = Sys.command "aec --help >/dev/null 2>&1" in
12
-
exit_code = 0)
9
+
(* -- C stub bindings -------------------------------------------------------- *)
13
10
14
-
let skip_unless_aec () = if not (Lazy.force aec_available) then Alcotest.skip ()
15
-
16
-
(* -- Helpers ---------------------------------------------------------------- *)
17
-
18
-
(** Write raw bytes to a temporary file, returning the path. *)
19
-
let write_temp ~suffix data =
20
-
let path = Filename.temp_file "rice_interop_" suffix in
21
-
let oc = open_out_bin path in
22
-
output_bytes oc data;
23
-
close_out oc;
24
-
path
11
+
external libaec_encode : bytes -> int -> int -> bytes = "caml_libaec_encode"
12
+
(** Compress raw samples using libaec. *)
25
13
26
-
(** Read a file into bytes. *)
27
-
let read_file path =
28
-
let ic = open_in_bin path in
29
-
let n = in_channel_length ic in
30
-
let buf = Bytes.create n in
31
-
really_input ic buf 0 n;
32
-
close_in ic;
33
-
buf
14
+
external libaec_decode : bytes -> int -> int -> int -> bytes
15
+
= "caml_libaec_decode"
16
+
(** Decompress data using libaec. The fourth argument is the expected
17
+
decompressed size in bytes. *)
34
18
35
-
(** Remove a list of temporary files. *)
36
-
let cleanup paths = List.iter (fun p -> try Sys.remove p with _ -> ()) paths
19
+
(* -- Helpers ---------------------------------------------------------------- *)
37
20
38
21
let bytes_eq = Alcotest.testable (Fmt.of_to_string Bytes.to_string) Bytes.equal
39
22
40
-
(** Build the aec command line.
41
-
42
-
aec CLI from libaec:
43
-
- Compress: aec [-b block] [-j bits] [-r rsi] input output
44
-
- Decompress: aec -d [-b block] [-j bits] [-r rsi] input output
45
-
46
-
Flags:
47
-
- [-b N]: block size (number of samples per block)
48
-
- [-j N]: bits per sample
49
-
- [-r N]: reference sample interval (we set equal to block_size)
50
-
- [-n N]: byte-width of each sample (auto-derived from -j)
51
-
- [-d]: decompress mode
52
-
- [-m]: MSB first (big-endian samples, which matches our encoding)
53
-
- [-t]: restrict encoded data (not needed for basic interop) *)
54
-
let aec_cmd ?(decompress = false) ~block_size ~bits_per_sample input output =
55
-
Printf.sprintf "aec%s -b %d -j %d -r %d -m %s %s"
56
-
(if decompress then " -d" else "")
57
-
block_size bits_per_sample block_size (* RSI = block_size *)
58
-
input output
59
-
60
-
(** Run a shell command, failing the test on non-zero exit. *)
61
-
let run_cmd cmd =
62
-
let exit_code = Sys.command (cmd ^ " 2>&1") in
63
-
if exit_code <> 0 then
64
-
Alcotest.failf "command failed (exit %d): %s" exit_code cmd
65
-
66
-
(* -- Sample generators ------------------------------------------------------ *)
67
-
68
23
(** Pack a list of samples into big-endian bytes at the given bit depth. *)
69
24
let pack_samples ~bits_per_sample samples =
70
25
let bps_bytes = (bits_per_sample + 7) / 8 in
···
96
51
97
52
(* -- Test body -------------------------------------------------------------- *)
98
53
99
-
(** Compress with ocaml-rice, decompress with aec, compare. *)
100
-
let test_rice_compress_aec_decompress ~block_size ~bits_per_sample raw_data () =
101
-
skip_unless_aec ();
54
+
(** Compress with ocaml-rice, decompress with libaec, compare. *)
55
+
let test_rice_compress_libaec_decompress ~block_size ~bits_per_sample raw_data
56
+
() =
102
57
let cfg = Rice.config ~block_size ~bits_per_sample () in
103
58
let compressed = Rice.compress cfg raw_data in
104
-
let compressed_path = write_temp ~suffix:".rz" compressed in
105
-
let decompressed_path = Filename.temp_file "rice_interop_" ".raw" in
106
-
let cmd =
107
-
aec_cmd ~decompress:true ~block_size ~bits_per_sample compressed_path
108
-
decompressed_path
59
+
let expected_size = Bytes.length raw_data in
60
+
let result =
61
+
libaec_decode compressed block_size bits_per_sample expected_size
109
62
in
110
-
Fun.protect
111
-
~finally:(fun () -> cleanup [ compressed_path; decompressed_path ])
112
-
(fun () ->
113
-
run_cmd cmd;
114
-
let result = read_file decompressed_path in
115
-
Alcotest.(check bytes_eq)
116
-
(Printf.sprintf "rice->aec bs=%d bps=%d" block_size bits_per_sample)
117
-
raw_data result)
63
+
Alcotest.(check bytes_eq)
64
+
(Printf.sprintf "rice->libaec bs=%d bps=%d" block_size bits_per_sample)
65
+
raw_data result
118
66
119
-
(** Compress with aec, decompress with ocaml-rice, compare. *)
120
-
let test_aec_compress_rice_decompress ~block_size ~bits_per_sample raw_data () =
121
-
skip_unless_aec ();
67
+
(** Compress with libaec, decompress with ocaml-rice, compare. *)
68
+
let test_libaec_compress_rice_decompress ~block_size ~bits_per_sample raw_data
69
+
() =
122
70
let cfg = Rice.config ~block_size ~bits_per_sample () in
123
-
let raw_path = write_temp ~suffix:".raw" raw_data in
124
-
let compressed_path = Filename.temp_file "rice_interop_" ".rz" in
125
-
let cmd =
126
-
aec_cmd ~decompress:false ~block_size ~bits_per_sample raw_path
127
-
compressed_path
128
-
in
129
-
Fun.protect
130
-
~finally:(fun () -> cleanup [ raw_path; compressed_path ])
131
-
(fun () ->
132
-
run_cmd cmd;
133
-
let compressed = read_file compressed_path in
134
-
match Rice.decompress cfg compressed with
135
-
| Error msg ->
136
-
Alcotest.failf "rice decompress failed (aec compressed): %s" msg
137
-
| Ok result ->
138
-
Alcotest.(check bytes_eq)
139
-
(Printf.sprintf "aec->rice bs=%d bps=%d" block_size bits_per_sample)
140
-
raw_data result)
71
+
let compressed = libaec_encode raw_data block_size bits_per_sample in
72
+
match Rice.decompress cfg compressed with
73
+
| Error msg ->
74
+
Alcotest.failf "rice decompress failed (libaec compressed): %s" msg
75
+
| Ok result ->
76
+
Alcotest.(check bytes_eq)
77
+
(Printf.sprintf "libaec->rice bs=%d bps=%d" block_size bits_per_sample)
78
+
raw_data result
141
79
142
-
(** Full round-trip: rice compress -> aec decompress -> aec compress -> rice
143
-
decompress, comparing at each stage. *)
80
+
(** Full round-trip: rice compress -> libaec decompress -> libaec compress ->
81
+
rice decompress, comparing at each stage. *)
144
82
let test_full_roundtrip ~block_size ~bits_per_sample raw_data () =
145
-
skip_unless_aec ();
146
83
let cfg = Rice.config ~block_size ~bits_per_sample () in
84
+
let expected_size = Bytes.length raw_data in
147
85
(* Step 1: compress with rice *)
148
86
let rice_compressed = Rice.compress cfg raw_data in
149
-
let rice_rz = write_temp ~suffix:".rice.rz" rice_compressed in
150
-
let aec_decompressed_path = Filename.temp_file "rice_interop_" ".aec.raw" in
151
-
let aec_recompressed_path = Filename.temp_file "rice_interop_" ".aec.rz" in
152
-
Fun.protect
153
-
~finally:(fun () ->
154
-
cleanup [ rice_rz; aec_decompressed_path; aec_recompressed_path ])
155
-
(fun () ->
156
-
(* Step 2: decompress with aec *)
157
-
run_cmd
158
-
(aec_cmd ~decompress:true ~block_size ~bits_per_sample rice_rz
159
-
aec_decompressed_path);
160
-
let aec_raw = read_file aec_decompressed_path in
87
+
(* Step 2: decompress with libaec *)
88
+
let libaec_raw =
89
+
libaec_decode rice_compressed block_size bits_per_sample expected_size
90
+
in
91
+
Alcotest.(check bytes_eq)
92
+
"rice->libaec decompression matches original" raw_data libaec_raw;
93
+
(* Step 3: recompress with libaec *)
94
+
let libaec_compressed = libaec_encode libaec_raw block_size bits_per_sample in
95
+
(* Step 4: decompress with rice *)
96
+
match Rice.decompress cfg libaec_compressed with
97
+
| Error msg ->
98
+
Alcotest.failf "rice decompress of libaec-compressed data failed: %s" msg
99
+
| Ok result ->
161
100
Alcotest.(check bytes_eq)
162
-
"rice->aec decompression matches original" raw_data aec_raw;
163
-
(* Step 3: recompress with aec *)
164
-
run_cmd
165
-
(aec_cmd ~decompress:false ~block_size ~bits_per_sample
166
-
aec_decompressed_path aec_recompressed_path);
167
-
let aec_compressed = read_file aec_recompressed_path in
168
-
(* Step 4: decompress with rice *)
169
-
match Rice.decompress cfg aec_compressed with
170
-
| Error msg ->
171
-
Alcotest.failf "rice decompress of aec-compressed data failed: %s" msg
172
-
| Ok result ->
173
-
Alcotest.(check bytes_eq)
174
-
"full round-trip matches original" raw_data result)
101
+
"full round-trip matches original" raw_data result
175
102
176
103
(* -- Configurations --------------------------------------------------------- *)
177
104
···
179
106
180
107
let configs =
181
108
[
182
-
{ block_size = 8; bits_per_sample = 8 };
183
109
{ block_size = 16; bits_per_sample = 8 };
184
-
{ block_size = 64; bits_per_sample = 8 };
185
-
{ block_size = 8; bits_per_sample = 16 };
186
110
{ block_size = 16; bits_per_sample = 16 };
187
-
{ block_size = 64; bits_per_sample = 16 };
188
-
{ block_size = 8; bits_per_sample = 32 };
189
-
{ block_size = 16; bits_per_sample = 32 };
190
-
{ block_size = 64; bits_per_sample = 32 };
191
111
]
192
112
193
113
let label c = Printf.sprintf "bs=%d/bps=%d" c.block_size c.bits_per_sample
194
114
195
-
(** Generate test data for a given config. Multiple patterns concatenated. *)
115
+
(** Generate test data for a given config. Multiple patterns. *)
196
116
let make_test_data c =
197
117
let count = c.block_size * 4 in
198
118
(* 4 full blocks *)
···
207
127
(* -- Runner ----------------------------------------------------------------- *)
208
128
209
129
let () =
210
-
let rice_to_aec =
130
+
let rice_to_libaec =
211
131
List.concat_map
212
132
(fun c ->
213
133
let ramp, constant, prng = make_test_data c in
···
215
135
Alcotest.test_case
216
136
(Printf.sprintf "ramp %s" (label c))
217
137
`Quick
218
-
(test_rice_compress_aec_decompress ~block_size:c.block_size
138
+
(test_rice_compress_libaec_decompress ~block_size:c.block_size
219
139
~bits_per_sample:c.bits_per_sample ramp);
220
140
Alcotest.test_case
221
141
(Printf.sprintf "constant %s" (label c))
222
142
`Quick
223
-
(test_rice_compress_aec_decompress ~block_size:c.block_size
143
+
(test_rice_compress_libaec_decompress ~block_size:c.block_size
224
144
~bits_per_sample:c.bits_per_sample constant);
225
145
Alcotest.test_case
226
146
(Printf.sprintf "prng %s" (label c))
227
147
`Quick
228
-
(test_rice_compress_aec_decompress ~block_size:c.block_size
148
+
(test_rice_compress_libaec_decompress ~block_size:c.block_size
229
149
~bits_per_sample:c.bits_per_sample prng);
230
150
])
231
151
configs
232
152
in
233
-
let aec_to_rice =
153
+
let libaec_to_rice =
234
154
List.concat_map
235
155
(fun c ->
236
156
let ramp, constant, prng = make_test_data c in
···
238
158
Alcotest.test_case
239
159
(Printf.sprintf "ramp %s" (label c))
240
160
`Quick
241
-
(test_aec_compress_rice_decompress ~block_size:c.block_size
161
+
(test_libaec_compress_rice_decompress ~block_size:c.block_size
242
162
~bits_per_sample:c.bits_per_sample ramp);
243
163
Alcotest.test_case
244
164
(Printf.sprintf "constant %s" (label c))
245
165
`Quick
246
-
(test_aec_compress_rice_decompress ~block_size:c.block_size
166
+
(test_libaec_compress_rice_decompress ~block_size:c.block_size
247
167
~bits_per_sample:c.bits_per_sample constant);
248
168
Alcotest.test_case
249
169
(Printf.sprintf "prng %s" (label c))
250
170
`Quick
251
-
(test_aec_compress_rice_decompress ~block_size:c.block_size
171
+
(test_libaec_compress_rice_decompress ~block_size:c.block_size
252
172
~bits_per_sample:c.bits_per_sample prng);
253
173
])
254
174
configs
···
278
198
in
279
199
Alcotest.run "rice-libaec"
280
200
[
281
-
("rice-compress/aec-decompress", rice_to_aec);
282
-
("aec-compress/rice-decompress", aec_to_rice);
201
+
("rice-compress/libaec-decompress", rice_to_libaec);
202
+
("libaec-compress/rice-decompress", libaec_to_rice);
283
203
("full-roundtrip", full_roundtrip);
284
204
]