Adapt to OCaml changes

Makefile

@@ -4,7 +4,7 @@ OCAMLLEX=ocamllex
 OCAMLYACC=ocamlyacc -v
 OCAMLDEP=ocamldep
 
-OPTCOMPFLAGS =-package zip,bigarray,unix,cairo2.lablgtk2 -inline 3 -g \
+OPTCOMPFLAGS =-package zip,bigarray,unix,cairo2-gtk -inline 3 -g \
   $(DIRS)
 COMPFLAGS = $(DIRS)
 DEPFLAGS= $(DIRS)

README.txt

@@ -5,7 +5,7 @@ This software only works on 64-bit machines.
 The following external libraries are needed: camlzip, cairo, lablgtk.
 They can be install through opam:
 
-   opam install camlzip cairo2 lablgtk
+   opam install camlzip cairo2-gtk
 
 To compile, just type 'make'.
 
@@ -102,9 +102,8 @@ to display the map:
 
 Optionally, you can include the coastline data:
 - download coastlines-split-4326.zip from
-  http://openstreetmapdata.com/data/coastlines
+  https://osmdata.openstreetmap.de/data/coastlines.html
   (shapefile format, containing linestrings in WGS84 projection)
-- unzip the file
 - build the coastline R-trees:
     ./coastline /path/to/coastlines-split-4326.zip
 

database/column.ml

@@ -342,7 +342,7 @@ module Output_stream_write = struct
   type output_stream =
     { fd : Unix.file_descr;
       mutable pos : int;
-      write_buffer : string;
+      write_buffer : bytes;
       mutable buf_pos : int;
       buffer : int array;
       mutable i : int;
@@ -357,7 +357,7 @@ module Output_stream_write = struct
       Unix.openfile nm [Unix.O_RDWR; Unix.O_CREAT; Unix.O_TRUNC] 0o666 in
     if temp <> None then Unix.unlink nm;
     ignore (Unix.lseek fd 24 Unix.SEEK_SET);
-    { fd = fd; write_buffer = String.create (write_size + max_overhead);
+    { fd = fd; write_buffer = Bytes.create (write_size + max_overhead);
       buffer = Array.make block_size 0; table = [||];
       pos = 24; buf_pos = 0; i = 0; n = 0 }
 
@@ -372,11 +372,12 @@ module Output_stream_write = struct
     end;
     s.table.(s.n - 1) <- s.pos
 
-  external encode_chunk : string -> int -> int array -> int -> int -> int
+  external encode_chunk : bytes -> int -> int array -> int -> int -> int
     = "encode_chunk_to_string_ml"
 
   let write_int_2 a p v =
-    a.[p] <- Char.chr (v land 0xff); a.[p + 1] <- Char.chr ((v lsr 8) land 0xff)
+    Bytes.set a p (Char.chr (v land 0xff));
+    Bytes.set a (p + 1) (Char.chr ((v lsr 8) land 0xff))
 
   let write_int_8 a p v =
     let v = ref v in
@@ -394,7 +395,7 @@ module Output_stream_write = struct
     let len = min write_size s.buf_pos in
     really_write s.fd s.write_buffer 0 len;
     if len < s.buf_pos then
-      String.blit s.write_buffer len s.write_buffer 0 (s.buf_pos - len);
+      Bytes.blit s.write_buffer len s.write_buffer 0 (s.buf_pos - len);
     s.buf_pos <- s.buf_pos - len
 
   let flush_buffer s =
@@ -433,19 +434,19 @@ module Output_stream_write = struct
     if i > 0 then flush_buffer s;
     write_buffer s;
     assert (s.buf_pos = 0);
-    let a = String.create (8 * s.n) in
+    let a = Bytes.create (8 * s.n) in
     for j = 0 to s.n - 1 do
       write_int_8 a (8 * j) s.table.(j)
     done;
     assert (Unix.lseek s.fd 0 Unix.SEEK_CUR = s.pos);
-    really_write s.fd a 0 (String.length a);
+    really_write s.fd a 0 (Bytes.length a);
     let len = (s.n - 1) * block_size + (if i = 0 then block_size else i) in
 
-    let a = magic ^ String.create 16 in
+    let a = Bytes.cat (Bytes.of_string magic) (Bytes.create 16) in
     write_int_8 a 8 len;
     write_int_8 a 16 s.pos;
     ignore (Unix.lseek s.fd 0 Unix.SEEK_SET);
-    really_write s.fd a 0 (String.length a)
+    really_write s.fd a 0 (Bytes.length a)
 
   let close_out s =
     finish_output s;
@@ -648,8 +649,8 @@ let with_spec_2 f nm1 nm2 =
 (****)
 
 let is_column nm =
-  let ch = Pervasives.open_in (file_in_database nm) in
-  let s = String.make 8 ' ' in
+  let ch = Stdlib.open_in (file_in_database nm) in
+  let s = Bytes.make 8 ' ' in
   ignore (input ch s 0 8);
   close_in ch;
-  s = magic
+  Bytes.unsafe_to_string s = magic

database/rtree.ml

@@ -63,7 +63,7 @@ end
 
 type level =
   { mutable level_bbox : Bbox.t;
-    buffer : string;
+    buffer : bytes;
     file : (int32, Bigarray.int32_elt) Mapped_file.output_stream;
     mutable idx : int }
 

database/table.ml

@@ -32,7 +32,8 @@ let make ?len nm kind =
   let ch = Unix.openfile nm flags 0o600 in
   let l = match len with None -> map_incr | Some l -> l in
   { ch = ch;
-    ar = Bigarray.Array1.map_file ch kind Bigarray.c_layout true l }
+    ar = Bigarray.array1_of_genarray
+           (Unix.map_file ch kind Bigarray.c_layout true [|l|]) }
 
 let extend a l =
   let l' = ref (Bigarray.Array1.dim a.ar) in
@@ -41,7 +42,8 @@ Format.printf "RESIZE@.";
     while !l' < l do l' := !l' + map_incr done;
     let kind = Bigarray.Array1.kind a.ar in
     let layout = Bigarray.Array1.layout a.ar in
-    a.ar <- Bigarray.Array1.map_file a.ch kind layout true !l'
+    a.ar <- Bigarray.array1_of_genarray
+              (Unix.map_file a.ch kind layout true [|!l'|])
   end
 
 (****)

generic/bitvect.ml

@@ -16,14 +16,14 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
-type t = string
+type t = bytes
 
-let make n = String.make ((n + 7) lsr 3) '\000'
+let make n = Bytes.make ((n + 7) lsr 3) '\000'
 
 let set v i =
   let j = i lsr 3 in
-  v.[j] <- Char.chr (Char.code v.[j] lor (1 lsl (i land 7)))
+  Bytes.set v j (Char.chr (Char.code (Bytes.get v j) lor (1 lsl (i land 7))))
 
 let test v i =
   let j = i lsr 3 in
-  Char.code v.[j] land (1 lsl (i land 7)) <> 0
+  Char.code (Bytes.get v j) land (1 lsl (i land 7)) <> 0

generic/bytearray.ml

@@ -37,17 +37,17 @@ let unsafe_blit_to_string a i s j l =
 *)
 
 external unsafe_blit_from_string : string -> int -> t -> int -> int -> unit
-  = "ml_blit_string_to_bigarray" "noalloc"
+  = "ml_blit_string_to_bigarray" [@@noalloc]
 
-external unsafe_blit_to_string : t -> int -> string -> int -> int -> unit
-  = "ml_blit_bigarray_to_string" "noalloc"
+external unsafe_blit_to_string : t -> int -> bytes -> int -> int -> unit
+  = "ml_blit_bigarray_to_string" [@@noalloc]
 
 let to_string a =
   let l = length a in
   if l > Sys.max_string_length then invalid_arg "Bytearray.to_string" else
-  let s = String.create l in
+  let s = Bytes.create l in
   unsafe_blit_to_string a 0 s 0 l;
-  s
+  Bytes.unsafe_to_string s
 
 let of_string s =
   let l = String.length s in
@@ -61,9 +61,9 @@ let sub a ofs len =
   then
     invalid_arg "Bytearray.sub"
   else begin
-    let s = String.create len in
+    let s = Bytes.create len in
     unsafe_blit_to_string a ofs s 0 len;
-    s
+    Bytes.unsafe_to_string s
   end
 
 let rec prefix_rec a i a' i' l =
@@ -82,12 +82,6 @@ let blit_from_string s i a j l =
   then invalid_arg "Bytearray.blit_from_string"
   else unsafe_blit_from_string s i a j l
 
-let blit_to_string a i s j l =
-  if l < 0 || i < 0 || i > length a - l
-           || j < 0 || j > String.length s - l
-  then invalid_arg "Bytearray.blit_to_string"
-  else unsafe_blit_to_string a i s j l
-
 external marshal : 'a -> Marshal.extern_flags list -> t
   = "ml_marshal_to_bigarray"
 

generic/bytearray.mli

@@ -31,8 +31,6 @@ val sub : t -> int -> int -> string
 
 val blit_from_string : string -> int -> t -> int -> int -> unit
 
-val blit_to_string : t -> int -> string -> int -> int -> unit
-
 val prefix : t -> t -> int -> bool
 
 val marshal : 'a -> Marshal.extern_flags list -> t

generic/bytearray_stubs.c

@@ -51,7 +51,7 @@ CAMLprim value ml_unmarshal_from_bigarray(value b, value ofs)
 CAMLprim value ml_blit_string_to_bigarray
 (value s, value i, value a, value j, value l)
 {
-  char *src = String_val(s) + Int_val(i);
+  const char *src = String_val(s) + Int_val(i);
   char *dest = Array_data(Bigarray_val(a), j);
   memcpy(dest, src, Long_val(l));
   return Val_unit;
@@ -61,7 +61,7 @@ CAMLprim value ml_blit_bigarray_to_string
 (value a, value i, value s, value j, value l)
 {
   char *src = Array_data(Bigarray_val(a), i);
-  char *dest = String_val(s) + Long_val(j);
+  char *dest = Bytes_val(s) + Long_val(j);
   memcpy(dest, src, Long_val(l));
   return Val_unit;
 }

generic/mapped_file.ml

@@ -88,7 +88,8 @@ let open_out nm ?temp map_incr (kind, element_size) =
   let ch = Unix.openfile nm flags 0o600 in
   if temp then Unix.unlink nm;
   { ch = ch; map_incr = map_incr; len = 0;
-    ar = Bigarray.Array1.map_file ch kind Bigarray.c_layout true map_incr;
+    ar = Bigarray.array1_of_genarray
+           (Unix.map_file ch kind Bigarray.c_layout true [|map_incr|]);
     element_size = element_size }
 
 let resize s l =
@@ -97,7 +98,8 @@ let resize s l =
   if !l' < l then begin
     while !l' < l do l' := !l' + s.map_incr done;
     let kind = Bigarray.Array1.kind s.ar in
-    s.ar <- Bigarray.Array1.map_file s.ch kind Bigarray.c_layout true !l'
+    s.ar <- Bigarray.array1_of_genarray
+              (Unix.map_file s.ch kind Bigarray.c_layout true [|!l'|])
   end
 
 let output_array s = s.ar
@@ -111,12 +113,14 @@ type ('a, 'b) t = ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t
 let open_in nm kind =
   let flags = [Unix.O_RDWR] in
   let ch = Unix.openfile nm flags 0o600 in
-  let a = Bigarray.Array1.map_file ch kind Bigarray.c_layout true (-1) in
+  let a = Bigarray.array1_of_genarray
+             (Unix.map_file ch kind Bigarray.c_layout true [|-1|]) in
   Unix.close ch;
   a
 
 let open_in_fd ch kind =
-  let a = Bigarray.Array1.map_file ch kind Bigarray.c_layout true (-1) in
+  let a = Bigarray.array1_of_genarray
+             (Unix.map_file ch kind Bigarray.c_layout true [|-1|]) in
   Unix.close ch;
   a
 
@@ -125,6 +129,7 @@ let array a = a
 let freeze s =
   Unix.ftruncate s.ch s.len;
   let kind = Bigarray.Array1.kind s.ar in
-  let a = Bigarray.Array1.map_file s.ch kind Bigarray.c_layout true (-1) in
+  let a = Bigarray.array1_of_genarray
+             (Unix.map_file s.ch kind Bigarray.c_layout true [|-1|]) in
   Unix.close s.ch;
   a

generic/protobuf.ml

@@ -50,12 +50,10 @@ let buffer_copy b = {s = b.s; i = b.i; l = b.l}
 let empty_buffer = {s =""; i = 0; l = 0}
 
 let input_string ch l =
-  let s = String.create l in
-  really_input ch s 0 l;
-  s
+  really_input_string ch l
 
 let buffer_from_channel ch l =
-  buffer_from_substring (input_string ch l) 0 l
+  buffer_from_substring (really_input_string ch l) 0 l
 
 let chunk buf l =
   let i = buf.i in

generic/task.ml

@@ -62,13 +62,13 @@ let functions = Hashtbl.create 17
 
 let send pipe i l =
   let s = Printf.sprintf "%d %d\n" i l in
-  ignore (Unix.write pipe s 0 (String.length s))
+  ignore (Unix.write_substring pipe s 0 (String.length s))
 
 let receive pipe =
-  let s = String.create 50 in
-  let len = Unix.read pipe s 0 (String.length s) in
+  let s = Bytes.create 50 in
+  let len = Unix.read pipe s 0 (Bytes.length s) in
   if len = 0 then exit 1;
-  Scanf.sscanf s "%d %d" (fun i l -> (i, l))
+  Scanf.sscanf (Bytes.unsafe_to_string s) "%d %d" (fun i l -> (i, l))
 
 let read mem l =
   let t = Utimer.start () in
@@ -114,15 +114,17 @@ let spawn f =
     let fd = Unix.openfile "/dev/zero" [Unix.O_RDWR] 0 in
     let mem =
       try
-        Bigarray.Array1.map_file
-          fd Bigarray.char Bigarray.c_layout true mem_size
+        Bigarray.array1_of_genarray
+             (Unix.map_file
+                fd Bigarray.char Bigarray.c_layout true [|mem_size|])
       with Sys_error _ ->
         (* Mac OS X does not support this, so we use a temp file instead. *)
         let (nm, ch) = Filename.open_temp_file "mmap" "" in
         Sys.remove nm;
         let mem =
-          Bigarray.Array1.map_file (Unix.descr_of_out_channel ch)
-            Bigarray.char Bigarray.c_layout true mem_size
+          Bigarray.array1_of_genarray
+             (Unix.map_file (Unix.descr_of_out_channel ch)
+                Bigarray.char Bigarray.c_layout true [|mem_size|])
         in
         close_out ch;
         mem