package checkseum

  1. Overview
  2. Docs

Source file checkseum.ml

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
type ba =
  (char, Bigarray_compat.int8_unsigned_elt, Bigarray_compat.c_layout) Bigarray_compat.Array1.t

type st = Bytes.t
type off = int
type len = int
type optint = Optint.t

(* XXX(dinosaure): we should be able to annot external with [@@noalloc] but
   it's depending on architecture and structural value of [Optint.t]. TODO! *)

module type FOREIGN = sig
  val unsafe_bytes : optint -> st -> off -> len -> optint
  val unsafe_bigstring : optint -> ba -> off -> len -> optint
end

module type DESC = sig
  val default : optint
end

module Adler32_foreign : FOREIGN = struct
  external unsafe_bytes :
    optint -> st -> off -> len -> optint
    = "caml_checkseum_adler32_st"

  external unsafe_bigstring :
    optint -> ba -> off -> len -> optint
    = "caml_checkseum_adler32_ba"
end

module Crc32_foreign : FOREIGN = struct
  external unsafe_bytes :
    optint -> st -> off -> len -> optint
    = "caml_checkseum_crc32_st"

  external unsafe_bigstring :
    optint -> ba -> off -> len -> optint
    = "caml_checkseum_crc32_ba"
end

module Crc32c_foreign : FOREIGN = struct
  external unsafe_bytes :
    optint -> st -> off -> len -> optint
    = "caml_checkseum_crc32c_st"

  external unsafe_bigstring :
    optint -> ba -> off -> len -> optint
    = "caml_checkseum_crc32c_ba"
end

module Make (F : FOREIGN) (D : DESC) = struct
  type t = optint

  let pp ppf v = Optint.pp ppf v
  let equal a b = Optint.equal a b
  let default = D.default
  let unsafe_digest_bytes a o l v = F.unsafe_bytes v a o l

  let unsafe_digest_string a o l v =
    F.unsafe_bytes v (Bytes.unsafe_of_string a) o l

  let unsafe_digest_bigstring a o l v = F.unsafe_bigstring v a o l

  let digest_bytes a o l v =
    if o < 0 || l < 0 || o > Bytes.length a - l then
      invalid_arg "index out of bounds" ;
    unsafe_digest_bytes a o l v

  let digest_string a o l v =
    if o < 0 || l < 0 || o > String.length a - l then
      invalid_arg "index out of bounds" ;
    unsafe_digest_string a o l v

  let digest_bigstring a o l v =
    if o < 0 || l < 0 || o > Bigarray_compat.Array1.dim a - l then
      invalid_arg "index out of bounds" ;
    unsafe_digest_bigstring a o l v
end

type bigstring = ba

module type S = sig
  type t = optint

  val pp : Format.formatter -> t -> unit
  val equal : t -> t -> bool
  val default : t
  val digest_bytes : Bytes.t -> int -> int -> t -> t
  val unsafe_digest_bytes : Bytes.t -> int -> int -> t -> t
  val digest_string : String.t -> int -> int -> t -> t
  val unsafe_digest_string : String.t -> int -> int -> t -> t
  val digest_bigstring : bigstring -> int -> int -> t -> t
  val unsafe_digest_bigstring : bigstring -> int -> int -> t -> t
end

module Adler32 : S =
  Make (Adler32_foreign) (struct let default = Optint.one end)

module Crc32 : S = Make (Crc32_foreign) (struct let default = Optint.zero end)

module Crc32c : S =
  Make (Crc32c_foreign) (struct let default = Optint.zero end)
OCaml

Innovation. Community. Security.