Fix build

lib/endpoint.ml

@@ -18,9 +18,6 @@ open Sexplib.Std
 open Lwt
 open Result
 
-external (|>) : 'a -> ('a -> 'b) -> 'b = "%revapply";;
-external ( $ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
-
 let ( >>= ) = Lwt.bind
 
 let i_int (i:int) = ignore i
@@ -33,7 +30,6 @@ module Int32 = struct
 end
 
 module Opt = struct
-  let map f o = match o with Some e -> Some (f e) | None -> None
   let iter f o = match o with Some e -> f e | None -> ()
 end
 
@@ -48,6 +44,8 @@ external atomic_fetch_and : Cstruct.buffer -> int -> int -> int = "stub_atomic_f
 (* XXX: the xen headers do not use __attribute__(packed). Edit vb: Was
    OK for me. *)
 
+[@@@warning "-32"]
+
 (* matches xen/include/public/io/libxenvchan.h:ring_shared *)
 [%%cstruct
 type ring_shared = {
@@ -70,6 +68,8 @@ type vchan_interface = {
 } [@@little_endian]
 ]
 
+[@@@warning "+32"]
+
 let get_ro v = get_vchan_interface_right_order v
 let get_lo v = get_vchan_interface_left_order v
 let get_lp v = get_ring_shared_prod (get_vchan_interface_left v)
@@ -260,10 +260,6 @@ let fast_get_data_ready (vch: t) request =
   if ready >= request then ready else
     (request_notify vch Write; Int32.(rd_prod vch - rd_cons vch |> to_int))
 
-let data_ready (vch: t) =
-  request_notify vch Write;
-  Int32.(rd_prod vch - rd_cons vch |> to_int)
-
 let fast_get_buffer_space (vch: t) request =
   let ready = wr_ring_size vch - Int32.(wr_prod vch - wr_cons vch |> to_int) in
   if ready > request then ready else
@@ -272,10 +268,6 @@ let fast_get_buffer_space (vch: t) request =
       wr_ring_size vch - Int32.(wr_prod vch - wr_cons vch |> to_int)
     )
 
-let buffer_space (vch: t) =
-  request_notify vch Read;
-  wr_ring_size vch - Int32.(wr_prod vch - wr_cons vch |> to_int)
-
 let state vch =
   let client_state =
     match state_of_live (get_vchan_interface_cli_live vch.shared_page)
@@ -485,7 +477,7 @@ let client ~domid ~port () =
   let map_locations grants l = match l with
   | Location.Within_shared_page offset ->
     None, Cstruct.sub v (Location.to_offset offset) (Location.to_length l)
-  | Location.External n ->
+  | Location.External _n ->
     let mapping = M.mapv ~grants ~rw:true in
     Some mapping, Io_page.to_cstruct (M.buf_of_mapping mapping) in
   let w_map, w_buf = map_locations lgrants lo in
@@ -534,9 +526,4 @@ let close (vch: t) =
       return ()
   end
 
-let disconnect (vch: t) =
-  (* In the vchan protocol close doesn't wait for any kind of acknowledgement,
-     so disconnect and close are the same. *)
-  close vch
-
 end

lib/in_memory.ml

@@ -28,11 +28,11 @@ module Config = struct
 
   let c = Lwt_condition.create ()
 
-  let write ~client_domid ~port t =
+  let write ~client_domid:_ ~port t =
     Hashtbl.replace tbl port t;
     return ()
 
-  let read ~server_domid ~port =
+  let read ~server_domid:_ ~port =
     let rec loop () =
       if Hashtbl.mem tbl port
       then return (Hashtbl.find tbl port)
@@ -41,7 +41,7 @@ module Config = struct
         loop () in
     loop ()
 
-  let delete ~client_domid ~port =
+  let delete ~client_domid:_ ~port =
     Hashtbl.remove tbl port;
     return ()
 
@@ -81,7 +81,7 @@ module Memory = struct
   let individual_pages = Hashtbl.create 16
   let big_mapping = Hashtbl.create 16
 
-  let share ~domid ~npages ~rw =
+  let share ~domid:_ ~npages ~rw:_ =
     let mapping = Io_page.get npages in
     let grants = get_n npages in
     let share = { grants; mapping } in
@@ -134,7 +134,7 @@ module Memory = struct
     Hashtbl.replace currently_mapped first ();
     { mapping; grants }
 
-  let unmap { mapping; grants } =
+  let unmap { mapping = _; grants } =
     let first = snd (List.hd grants) in
     if Hashtbl.mem currently_mapped first
     then Hashtbl.remove currently_mapped first

lib/in_memory_events.ml

@@ -20,8 +20,6 @@ open Sexplib.Std
 
 open Lwt
 
-type 'a io = 'a Lwt.t
-
 type port = int [@@deriving sexp_of]
 
 let port_of_string x = `Ok (int_of_string x)

lib_test/test.ml

@@ -149,6 +149,7 @@ let test_write_wraps () = Lwt_main.run (
       for i = 0 to Cstruct.len ring - 1 do Cstruct.set_char ring i 'X' done;
       V.write server ring >>|= fun () ->
       V.read client >>!= fun buf ->
+      assert_equal ~printer:(fun x -> x) (string_of_cstruct ring) (string_of_cstruct buf);
       (* writing and reading 1 byte will ensure we have consumed the previous chunk
          (read doesn't perform a copy, see ack_up_to) *)
       V.write server (cstruct_of_string "!") >>|= fun () ->

lwt/vchan_lwt_unix.ml

@@ -65,8 +65,6 @@ module IO = struct
 
   let write = Lwt_io.write
 
-  let write_line = Lwt_io.write_line
-
   let flush = Lwt_io.flush
 
 end

vchan-unix.opam

@@ -1,4 +1,5 @@
 opam-version: "1.2"
+synopsis:      "Xen Vchan implementation"
 maintainer:    "jonathan.ludlam@eu.citrix.com"
 authors: [
   "Vincent Bernardoff"

vchan-xen.opam

@@ -1,4 +1,5 @@
 opam-version: "1.2"
+synopsis:      "Xen Vchan implementation"
 maintainer:    "jonathan.ludlam@eu.citrix.com"
 authors: [
   "Vincent Bernardoff"

vchan.opam

@@ -1,4 +1,5 @@
 opam-version: "1.2"
+synopsis:      "Xen Vchan implementation"
 maintainer:    "jonathan.ludlam@eu.citrix.com"
 authors: [
   "Vincent Bernardoff"