+let of_string str addr =
+ let t = create () in
+ add_string t str addr
+
+(* 'get_mapping' is the crucial, fast lookup function for address -> mapping.
+ * It searches the tree (hence fast) to work out the topmost mapping which
+ * applies to an address.
+ *
+ * Returns (rightend * mapping option)
+ * where 'mapping option' is the mapping (or None if it's a hole)
+ * and 'rightend' is the next address at which there is a different
+ * mapping/hole. In other words, this mapping result is good for
+ * addresses [addr .. rightend-1].
+ *)
+let rec get_mapping addr = function
+ | Leaf ((_, rightend), mapping) -> rightend, mapping
+
+ | Node ((Leaf ((_, leftend), _) | Node (_, ((_, leftend), _), _) as left),
+ (_, None),
+ right) ->
+ let subrightend, submapping =
+ if addr < leftend then get_mapping addr left
+ else get_mapping addr right in
+ subrightend, submapping
+
+ | Node ((Leaf ((_, leftend), _) | Node (_, ((_, leftend), _), _) as left),
+ (_, Some mapping),
+ right) ->
+ let subrightend, submapping =
+ if addr < leftend then get_mapping addr left
+ else get_mapping addr right in
+ (match submapping with
+ | None -> subrightend, Some mapping
+ | Some submapping ->
+ subrightend,
+ Some (if mapping.order > submapping.order then mapping
+ else submapping)
+ )
+
+(* Use the tree to quickly check if an address is mapped (returns false
+ * if it's a hole).
+ *)
+let is_mapped { mappings = mappings; tree = tree } addr =
+ (* NB: No [`HasMapping] in the type so we have to check mappings <> []. *)
+ match mappings with
+ | [] -> false
+ | _ ->
+ let _, mapping = get_mapping addr tree in
+ mapping <> None
+
+(* Get a single byte. *)
+let get_byte { tree = tree } addr =
+ (* Get the mapping which applies to this address: *)
+ let _, mapping = get_mapping addr tree in
+ match mapping with
+ | Some { start = start; size = size; arr = arr } ->
+ let offset = Int64.to_int (addr -^ start) in
+ Char.code (Array1.get arr offset)
+ | None ->
+ invalid_arg "get_byte"
+
+(* Get a range of bytes, possibly across several intervals. *)
+let get_bytes { tree = tree } addr len =
+ let str = String.create len in
+
+ let rec loop addr pos len =
+ if len > 0 then (
+ let rightend, mapping = get_mapping addr tree in
+ match mapping with
+ | Some { start = start; size = size; arr = arr } ->
+ (* Offset within this mapping. *)
+ let offset = Int64.to_int (addr -^ start) in
+ (* Number of bytes to read before we either get to the end
+ * of our 'len' or we fall off the end of this interval.
+ *)
+ let n = min len (Int64.to_int (rightend -^ addr)) in
+ for i = 0 to n-1 do
+ String.unsafe_set str (pos + i) (Array1.get arr (offset + i))
+ done;
+ let len = len - n in
+ loop (addr +^ Int64.of_int n) (pos + n) len
+
+ | None ->
+ invalid_arg "get_bytes"
+ )
+ in
+ loop addr 0 len;
+
+ str
+
+let get_int32 t addr =
+ let e = get_endian t in
+ let str = get_bytes t addr 4 in
+ let bs = Bitstring.bitstring_of_string str in
+ bitmatch bs with
+ | { addr : 32 : endian (e) } -> addr
+ | { _ } -> invalid_arg "get_int32"
+
+let get_int64 t addr =
+ let e = get_endian t in
+ let str = get_bytes t addr 8 in
+ let bs = Bitstring.bitstring_of_string str in
+ bitmatch bs with
+ | { addr : 64 : endian (e) } -> addr
+ | { _ } -> invalid_arg "get_int64"
+
+let get_C_int = get_int32
+
+let get_C_long t addr =
+ let ws = get_wordsize t in
+ match ws with
+ | W32 -> Int64.of_int32 (get_int32 t addr)
+ | W64 -> get_int64 t addr
+
+(* Take bytes until a condition is not met. This is efficient
+ * in that we stay within the same mapping as long as we can.
+ *
+ * If we hit a hole, raises Invalid_argument "dowhile".
+ *)
+let dowhile { tree = tree } addr cond =
+ let rec loop addr =
+ let rightend, mapping = get_mapping addr tree in
+ match mapping with
+ | Some { start = start; size = size; arr = arr } ->
+ (* Offset within this mapping. *)
+ let offset = Int64.to_int (addr -^ start) in
+ (* Number of bytes before we fall off the end of this interval. *)
+ let n = Int64.to_int (rightend -^ addr) in
+
+ let rec loop2 addr offset n =
+ if n > 0 then (
+ let c = Array1.get arr offset in
+ if cond addr c then
+ loop2 (addr +^ 1L) (offset + 1) (n - 1)
+ else
+ false (* stop now, finish outer loop too *)
+ )
+ else true (* fell off the end, so continue outer loop *)
+ in
+ if loop2 addr offset n then
+ loop (addr +^ Int64.of_int n)
+
+ | None ->
+ invalid_arg "dowhile"