unison

Fork of Unison, a bi-directional file synchronization tool
git clone git://git.laack.co/unison.git
Log | Files | Refs | README | LICENSE

bytearray.ml (3067B)


      1 (* Unison file synchronizer: src/bytearray.ml *)
      2 (* Copyright 1999-2020, Benjamin C. Pierce
      3 
      4     This program is free software: you can redistribute it and/or modify
      5     it under the terms of the GNU General Public License as published by
      6     the Free Software Foundation, either version 3 of the License, or
      7     (at your option) any later version.
      8 
      9     This program is distributed in the hope that it will be useful,
     10     but WITHOUT ANY WARRANTY; without even the implied warranty of
     11     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     12     GNU General Public License for more details.
     13 
     14     You should have received a copy of the GNU General Public License
     15     along with this program.  If not, see <http://www.gnu.org/licenses/>.
     16 *)
     17 
     18 open Bigarray
     19 
     20 type t = (char, int8_unsigned_elt, c_layout) Array1.t
     21 
     22 let m = Umarshal.bytearray
     23 
     24 let length = Bigarray.Array1.dim
     25 
     26 let create l = Bigarray.Array1.create Bigarray.char Bigarray.c_layout l
     27 
     28 (*
     29 let unsafe_blit_from_string s i a j l =
     30   for k = 0 to l - 1 do
     31     a.{j + k} <- s.[i + k]
     32   done
     33 
     34 let unsafe_blit_to_string a i s j l =
     35   for k = 0 to l - 1 do
     36     s.[j + k] <- a.{i + k}
     37   done
     38 *)
     39 
     40 external unsafe_blit_from_string : string -> int -> t -> int -> int -> unit
     41   = "ml_blit_string_to_bigarray" [@@noalloc]
     42 
     43 external unsafe_blit_from_bytes : bytes -> int -> t -> int -> int -> unit
     44   = "ml_blit_bytes_to_bigarray" [@@noalloc]
     45 
     46 external unsafe_blit_to_bytes : t -> int -> bytes -> int -> int -> unit
     47   = "ml_blit_bigarray_to_bytes" [@@noalloc]
     48 
     49 let to_string a =
     50   let l = length a in
     51   if l > Sys.max_string_length then invalid_arg "Bytearray.to_string" else
     52   let s = Bytes.create l in
     53   unsafe_blit_to_bytes a 0 s 0 l;
     54   Bytes.to_string s
     55 
     56 let of_string s =
     57   let l = String.length s in
     58   let a = create l in
     59   unsafe_blit_from_string s 0 a 0 l;
     60   a
     61 
     62 let sub a ofs len =
     63   if
     64     ofs < 0 || len < 0 || ofs > length a - len || len > Sys.max_string_length
     65   then
     66     invalid_arg "Bytearray.sub"
     67   else begin
     68     let s = Bytes.create len in
     69     unsafe_blit_to_bytes a ofs s 0 len;
     70     Bytes.to_string s
     71   end
     72 
     73 let rec prefix_rec a i a' i' l =
     74   l = 0 ||
     75   (a.{i} = a'.{i'} && prefix_rec a (i + 1) a' (i' + 1) (l - 1))
     76 
     77 let prefix a a' i =
     78   let l = length a in
     79   let l' = length a' in
     80   i <= l' - l &&
     81   prefix_rec a 0 a' i l
     82 
     83 let blit_from_string s i a j l =
     84   if l < 0 || i < 0 || i > String.length s - l
     85            || j < 0 || j > length a - l
     86   then invalid_arg "Bytearray.blit_from_string"
     87   else unsafe_blit_from_string s i a j l
     88 
     89 let blit_from_bytes s i a j l =
     90   if l < 0 || i < 0 || i > Bytes.length s - l
     91            || j < 0 || j > length a - l
     92   then invalid_arg "Bytearray.blit_from_bytes"
     93   else unsafe_blit_from_bytes s i a j l
     94 
     95 let blit_to_bytes a i s j l =
     96   if l < 0 || i < 0 || i > length a - l
     97            || j < 0 || j > Bytes.length s - l
     98   then invalid_arg "Bytearray.blit_to_bytes"
     99   else unsafe_blit_to_bytes a i s j l
    100 
    101 external marshal : 'a -> Marshal.extern_flags list -> t
    102   = "ml_marshal_to_bigarray"
    103 
    104 external unmarshal : t -> int -> 'a
    105   = "ml_unmarshal_from_bigarray"