experimental hashing with oxcaml
anil.recoil.org
1open Bigarray
2
3type state = (int32, int32_elt, c_layout) Array1.t
4type digest = (int, int8_unsigned_elt, c_layout) Array1.t
5type buffer = (int, int8_unsigned_elt, c_layout) Array1.t
6
7(* External C functions *)
8external init : unit -> state = "oxcaml_sha256_init"
9external process_block : state -> buffer -> unit = "oxcaml_sha256_process_block" [@@noalloc]
10external finalize : state -> buffer -> int64 -> digest = "oxcaml_sha256_finalize"
11external oneshot : buffer -> int64 -> digest = "oxcaml_sha256_oneshot"
12
13(* High-level interface *)
14
15let hash_bytes bytes =
16 let len = Bytes.length bytes in
17 let buffer = Array1.create int8_unsigned c_layout len in
18 for i = 0 to len - 1 do
19 Array1.set buffer i (Char.code (Bytes.get bytes i))
20 done;
21 oneshot buffer (Int64.of_int len)
22
23let hash_string str =
24 let len = String.length str in
25 let buffer = Array1.create int8_unsigned c_layout len in
26 for i = 0 to len - 1 do
27 Array1.set buffer i (Char.code str.[i])
28 done;
29 oneshot buffer (Int64.of_int len)
30
31(* Utilities *)
32
33let digest_to_hex digest =
34 let hex_of_byte b =
35 Printf.sprintf "%02x" b
36 in
37 let buf = Buffer.create 64 in
38 for i = 0 to 31 do
39 Buffer.add_string buf (hex_of_byte (Array1.get digest i))
40 done;
41 Buffer.contents buf
42
43let digest_to_bytes digest =
44 let bytes = Bytes.create 32 in
45 for i = 0 to 31 do
46 Bytes.set bytes i (Char.chr (Array1.get digest i))
47 done;
48 bytes
49
50let digest_equal d1 d2 =
51 let rec compare i =
52 if i >= 32 then true
53 else if Array1.get d1 i <> Array1.get d2 i then false
54 else compare (i + 1)
55 in
56 compare 0
57
58(* Zero-allocation variants using OxCaml features *)
59
60module Fast = struct
61 (* Stack-allocated processing for temporary computations *)
62 let[@inline] [@zero_alloc assume] process_block_local state block =
63 process_block state block
64
65 (* Process multiple blocks efficiently *)
66 let[@zero_alloc assume] process_blocks state blocks num_blocks =
67 for i = 0 to num_blocks - 1 do
68 let offset = i * 64 in
69 let block = Array1.sub blocks offset 64 in
70 process_block state block
71 done
72
73 (* Parallel hashing for multiple inputs *)
74 let parallel_hash_many par inputs =
75 match inputs with
76 | [] -> []
77 | [x] -> [hash_bytes x]
78 | _ ->
79 let process_batch batch =
80 List.map hash_bytes batch
81 in
82 let mid = List.length inputs / 2 in
83 let rec split n lst =
84 if n = 0 then ([], lst)
85 else match lst with
86 | [] -> ([], [])
87 | h::t -> let (l1, l2) = split (n-1) t in (h::l1, l2)
88 in
89 let (left, right) = split mid inputs in
90 let left_results, right_results =
91 Parallel.fork_join2 par
92 (fun _ -> process_batch left)
93 (fun _ -> process_batch right)
94 in
95 left_results @ right_results
96end