unikernel/duniverse/bstr/lib/slice.ml.in

@@ -0,0 +1,148 @@
+(*
+ * Copyright (c) 2024 Romain Calascibetta <romain.calascibetta@gmail.com>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+type t = S.t Slice.t
+
+external ( < ) : 'a -> 'a -> bool = "%lessthan"
+external ( <= ) : 'a -> 'a -> bool = "%lessequal"
+external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
+external ( > ) : 'a -> 'a -> bool = "%greaterthan"
+
+let ( > ) (x : int) y = x > y [@@inline]
+let ( < ) (x : int) y = x < y [@@inline]
+let ( <= ) (x : int) y = x <= y [@@inline]
+let ( >= ) (x : int) y = x >= y [@@inline]
+let min (a : int) b = if a <= b then a else b [@@inline]
+let max (a : int) b = if a >= b then a else b [@@inline]
+
+open Slice
+
+let make ?(off= 0) ?len buf =
+  let len = match len with
+    | Some len -> len
+    | None -> S.length buf - off in
+  if len < 0
+  || off < 0
+  || off > S.length buf - len
+  then invalid_arg "Slice.make";
+  Slice.unsafe_make ~off ~len buf
+
+let empty = unsafe_make ~off:0 ~len:0 S.empty
+let length { len; _ } = len
+let get { off; buf; _ } idx = S.get buf (off + idx)
+let get_int8 { off; buf; _ } idx = S.get_int8 buf (off + idx)
+let get_uint8 { off; buf; _ } idx = S.get_uint8 buf (off + idx)
+let get_uint16_ne { off; buf; _ } idx = S.get_uint16_ne buf (off + idx)
+let get_uint16_le { off; buf; _ } idx = S.get_uint16_le buf (off + idx)
+let get_uint16_be { off; buf; _ } idx = S.get_uint16_be buf (off + idx)
+let get_int16_ne { off; buf; _ } idx = S.get_int16_ne buf (off + idx)
+let get_int16_le { off; buf; _ } idx = S.get_int16_ne buf (off + idx)
+let get_int16_be { off; buf; _ } idx = S.get_int16_be buf (off + idx)
+let get_int32_ne { off; buf; _ } idx = S.get_int32_ne buf (off + idx)
+let get_int32_le { off; buf; _ } idx = S.get_int32_le buf (off + idx)
+let get_int32_be { off; buf; _ } idx = S.get_int32_be buf (off + idx)
+let get_int64_ne { off; buf; _ } idx = S.get_int64_ne buf (off + idx)
+let get_int64_le { off; buf; _ } idx = S.get_int64_le buf (off + idx)
+let get_int64_be { off; buf; _ } idx = S.get_int64_be buf (off + idx)
+let set { off; buf; _ } idx v = S.set buf (off + idx) v
+let set_int8 { off; buf; _ } idx v = S.set_int8 buf (off + idx) v
+let set_uint8 { off; buf; _ } idx v = S.set_uint8 buf (off + idx) v
+let set_uint16_ne { off; buf; _ } idx v = S.set_uint16_ne buf (off + idx) v
+let set_uint16_le { off; buf; _ } idx v = S.set_uint16_le buf (off + idx) v
+let set_uint16_be { off; buf; _ } idx v = S.set_uint16_be buf (off + idx) v
+let set_int16_ne { off; buf; _ } idx v = S.set_int16_ne buf (off + idx) v
+let set_int16_le { off; buf; _ } idx v = S.set_int16_ne buf (off + idx) v
+let set_int16_be { off; buf; _ } idx v = S.set_int16_be buf (off + idx) v
+let set_int32_ne { off; buf; _ } idx v = S.set_int32_ne buf (off + idx) v
+let set_int32_le { off; buf; _ } idx v = S.set_int32_le buf (off + idx) v
+let set_int32_be { off; buf; _ } idx v = S.set_int32_be buf (off + idx) v
+let set_int64_ne { off; buf; _ } idx v = S.set_int64_ne buf (off + idx) v
+let set_int64_le { off; buf; _ } idx v = S.set_int64_le buf (off + idx) v
+let set_int64_be { off; buf; _ } idx v = S.set_int64_be buf (off + idx) v
+
+let blit a b =
+  let len = Int.min a.len b.len in
+  S.blit a.buf ~src_off:a.off b.buf ~dst_off:b.off ~len:len
+
+let blit_from_bytes src ~src_off { Slice.buf; off; _ } ?dst_off len =
+  let dst_off = match dst_off with
+    | Some dst_off -> dst_off + off
+    | None -> off in
+  if len < 0
+  || dst_off < 0
+  || dst_off > S.length buf - len
+  then invalid_arg "Slice.blit_from_bytes";
+  S.blit_from_bytes src ~src_off buf ~dst_off ~len
+
+let blit_to_bytes { Slice.buf; off; _ } ?src_off dst ~dst_off ~len =
+  let src_off = match src_off with
+    | Some src_off -> src_off + off
+    | None -> off in
+  if len < 0
+  || src_off < 0
+  || src_off > S.length buf - len
+  then invalid_arg "Slice.blit_to_bytes";
+  S.blit_to_bytes buf ~src_off dst ~dst_off ~len
+
+let fill { off; len; buf; } ?off:(off'= 0) ?len:len' chr =
+  let len' = match len' with
+    | Some len' -> len'
+    | None -> len - off' in
+  S.fill buf ~off:(off + off') ~len:len' chr
+
+let sub t ~off ~len = Slice.sub t ~off ~len
+let shift t n = Slice.shift t n
+let is_empty t = Slice.is_empty t
+
+let sub_string { Slice.buf; off; _ } ~off:off' ~len =
+  let dst = Bytes.create len in
+  S.blit_to_bytes buf ~src_off:(off + off') dst ~dst_off:0 ~len;
+  Bytes.unsafe_to_string dst
+
+let to_string { Slice.buf; off= src_off; len } =
+  let dst = Bytes.create len in
+  S.blit_to_bytes buf ~src_off dst ~dst_off:0 ~len;
+  Bytes.unsafe_to_string dst
+
+let of_string str =
+  let off = 0 and len = String.length str in
+  Slice.unsafe_make ~off ~len (S.of_string str)
+
+let string ?(off= 0) ?len str =
+  let len = match len with 
+    | None -> String.length str - off 
+    | Some len -> len in
+  Slice.unsafe_make ~off:0 ~len (S.string ~off ~len str)
+
+let overlap ({ buf= buf0; _ } as a) ({ buf= buf1; _ } as b) =
+  match S.overlap buf0 buf1 with
+  | None -> None
+  | Some (_, 0, 0) ->
+      let len =
+        max 0 (min (a.off + a.len) (b.off + b.len)) - max a.off b.off in
+      if a.off >= b.off && a.off < b.off + b.len
+      then
+        let offset = a.off - b.off in Some (len, 0, offset)
+      else if b.off >= a.off && b.off < a.off + a.len
+      then
+        let offset = b.off + a.off in Some (len, offset, 0)
+      else None
+  | Some _ ->
+      let a = S.sub buf0 ~off:a.off ~len:a.len
+      and b = S.sub buf1 ~off:b.off ~len:b.len in
+      S.overlap a b
+      (* TODO(dinosaure): this case appears only for bigstrings, but we could
+         optimize it and avoid [S.sub]. *)