[ocaml] fix and update for latest ocaml

fix usage of Bytes and String
drop support of ocaml < 4.02
we keep Compat for functions that need ocaml 4.03 until end of life of
Ubuntu Xenial 16.04, drop support of previous releases
enforce type safe_string option to prevent future errors
replace Pervasives by Stdlib (depreciated in latest ocaml vesions)
only use ocamlnet >= 4.0.4

sw/Makefile.ocaml

@@ -30,8 +30,8 @@ endif
 endif
 
 OCAML = ocaml
-OCAMLC = ocamlfind ocamlc
-OCAMLOPT = ocamlfind ocamlopt
+OCAMLC = ocamlfind ocamlc -safe-string
+OCAMLOPT = ocamlfind ocamlopt -safe-string
 OCAMLDEP = ocamlfind ocamldep
 OCAMLMKLIB = ocamlmklib
 OCAMLLEX=ocamllex

sw/ground_segment/cockpit/horizon.ml

@@ -47,16 +47,16 @@ let floats_of_points = fun ps ->
   done;
   a
 
-let ruler = fun ?(index_on_right=false) ~text_props ~max ~scale ~w ~index_width ~step ~h root ->
+let ruler = fun ?(index_on_right=false) ~text_props ~max_value ~scale ~w ~index_width ~step ~h root ->
   let r = GnoCanvas.group root in
-  let height = scale *. float max in
+  let height = scale *. float max_value in
 
   (* Grey background *)
   let _ = GnoCanvas.rect ~x1:0. ~y1:(-.height) ~x2:w ~y2:height ~fill_color:"#808080" r in
   let props = (text_props@[`ANCHOR `EAST]) in
 
   (* One step drawer *)
-  let tab = Array.make (max/step) false in
+  let tab = Array.make (max_value/step) false in
   let draw = fun i ->
     let i = i * step in
     let y = -. scale *. float i in
@@ -69,7 +69,7 @@ let ruler = fun ?(index_on_right=false) ~text_props ~max ~scale ~w ~index_width
 
   let lazy_drawer = fun v ->
     let v = truncate v / step in
-    for i = Pervasives.max 0 (v - 5) to min (v + 5) (Array.length tab - 1) do (* FIXME *)
+    for i = max 0 (v - 5) to min (v + 5) (Array.length tab - 1) do (* FIXME *)
       if not tab.(i) then begin
         tab.(i) <- true;
         draw i
@@ -181,7 +181,7 @@ class h = fun ?packing size  ->
   (* Speedometer on the left side *)
   let speed, mi, mx, lazy_speed =
     let g = GnoCanvas.group ~x:left_margin ~y:yc canvas#root in
-    let r, lazy_ruler = ruler ~text_props ~index_on_right:true ~max:50 ~scale:speed_scale ~w:speed_width ~step:2 ~index_width ~h:(0.75*.size2) g in
+    let r, lazy_ruler = ruler ~text_props ~index_on_right:true ~max_value:50 ~scale:speed_scale ~w:speed_width ~step:2 ~index_width ~h:(0.75*.size2) g in
     let mx =
       GnoCanvas.text ~x:(speed_width/.2.) ~y:(-0.88*.size2) ~props:text_props g
     and mi =
@@ -194,7 +194,7 @@ class h = fun ?packing size  ->
   (* Altimeter on the right side *)
   and alt, lazy_alt =
     let g = GnoCanvas.group ~x:(xc+.size2) ~y:yc canvas#root in
-    ruler ~text_props ~max:3000 ~scale:alt_scale ~w:alt_width ~step:10 ~index_width ~h:(0.75*.size2) g
+    ruler ~text_props ~max_value:3000 ~scale:alt_scale ~w:alt_width ~step:10 ~index_width ~h:(0.75*.size2) g
   in
 
 object

sw/ground_segment/cockpit/live.ml

@@ -172,7 +172,7 @@ let select_ac = fun acs_notebook ac_id ->
     if !active_ac <> "" then begin
       let ac' = find_ac !active_ac in
       ac'.strip#hide_buttons ();
-      ac'.notebook_label#set_width_chars (Compat.bytes_length ac'.notebook_label#text);
+      ac'.notebook_label#set_width_chars (String.length ac'.notebook_label#text);
       if !_auto_hide_fp then hide_fp ac'
     end;
 
@@ -353,7 +353,7 @@ let attributes_pretty_printer = fun attribs ->
     && a <> "post_call" && a <> "key" && a <> "group" in
 
   let sprint_opt = fun b s ->
-    if Compat.bytes_length b > 0 then
+    if String.length b > 0 then
       sprintf " %s%s%s" s b s
     else
       ""
@@ -651,7 +651,7 @@ let create_ac = fun ?(confirm_kill=true) alert (geomap:G.widget) (acs_notebook:G
   let settings_file = Http.file_of_url settings_url in
   let settings_xml =
     try
-      if Compat.bytes_compare "replay" settings_file <> 0 then
+      if String.compare "replay" settings_file <> 0 then
         ExtXml.parse_file ~noprovedtd:true settings_file
       else
         Xml.Element("empty", [], [])
@@ -755,7 +755,7 @@ let create_ac = fun ?(confirm_kill=true) alert (geomap:G.widget) (acs_notebook:G
 
         (* only horizontal wind and airspeed are updated, so bitmask is 0b0000101 = 5 *)
         let msg_items = ["WIND_INFO"; ac_id; "5"; wind_east; wind_north; "0.0"; airspeed] in
-        let value = Compat.bytes_concat ";" msg_items in
+        let value = String.concat ";" msg_items in
         let vs = ["ac_id", PprzLink.String ac_id; "message", PprzLink.String value] in
         Ground_Pprz.message_send "dl" "RAW_DATALINK" vs;
       with

sw/ground_segment/cockpit/page_settings.ml

@@ -91,7 +91,7 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) ac_id packing dl_
       1.
   in
   (* get number of digits after decimal dot *)
-  let digits = try Compat.bytes_length (ExtXml.attrib dl_setting "step") - Compat.bytes_index (ExtXml.attrib dl_setting "step") '.' - 1 with _ -> 0 in
+  let digits = try String.length (ExtXml.attrib dl_setting "step") - String.index (ExtXml.attrib dl_setting "step") '.' - 1 with _ -> 0 in
   let page_incr = step_incr
   and page_size = step_incr
   and show_auto = try ExtXml.attrib dl_setting "auto" = "true" with _ -> false in

sw/ground_segment/cockpit/saveSettings.ml

@@ -199,7 +199,7 @@ let fill_data = fun (model:GTree.tree_store) settings airframe_xml ->
 
   (* Warning if needed *)
   if !not_in_airframe_file <> [] then begin
-    GToolbox.message_box ~title:"Warning" (Printf.sprintf "Some parameters not writable in the airframe file:\n\n%s" (Compat.bytes_concat "\n" !not_in_airframe_file));
+    GToolbox.message_box ~title:"Warning" (Printf.sprintf "Some parameters not writable in the airframe file:\n\n%s" (String.concat "\n" !not_in_airframe_file));
   end
 
 

sw/ground_segment/cockpit/strip.ml

@@ -328,7 +328,7 @@ object
 
     (* add a button widget in a vertical box if it belongs to a group (create new group if needed) *)
   method add_widget ?(group="") w =
-    let (vbox, pack) = match Compat.bytes_length group with
+    let (vbox, pack) = match String.length group with
         0 -> (GPack.vbox ~show:true (), true)
       | _ -> try (Hashtbl.find button_tbl group, false) with
           Not_found ->

sw/ground_segment/joystick/input2ivy.ml

@@ -34,7 +34,6 @@
 *)
 
 open Printf
-open Unix
 open Random
 
 
@@ -557,7 +556,7 @@ let execute_actions = fun actions ac_id ->
 (**   this capability is mostly for bench-time trimming when a joystick does not have adequate buttons *)
 (**   it is not a very complete capability  *)
 let execute_kb_action = fun actions conditions ->
-  let ch = input_byte Pervasives.stdin in
+  let ch = input_byte stdin in
   (** esdx for left stick
       ijkm for right  *)
 

sw/ground_segment/tmtc/broadcaster.ml

@@ -25,14 +25,14 @@ let () =
 
     (* Forward telemetry on Ivy *)
     let buffer_size = 256 in
-    let buffer = Compat.bytes_create buffer_size in
+    let buffer = Bytes.create buffer_size in
     let get_tcp = fun _ ->
       begin
         try
           let n = input i buffer 0 buffer_size in
-          let data = Compat.bytes_sub buffer 0 n in
+          let data = Bytes.sub buffer 0 n in
 
-          Ivy.send (sprintf "%s %s" !ivy_to (Base64.encode_string data))
+          Ivy.send (sprintf "%s %s" !ivy_to (Base64.encode_string (Bytes.to_string data)))
         with
             exc -> prerr_endline (Printexc.to_string exc)
       end;

sw/ground_segment/tmtc/ivy2serial.ml

@@ -81,21 +81,21 @@ let () =
 
   (* The function to be called when data is available *)
   let buffer_size = 256 in
-  let buffer = Compat.bytes_create buffer_size in
+  let buffer = Bytes.create buffer_size in
   let get_datalink_message = fun _ ->
     begin
       try
         let n = input (Unix.in_channel_of_descr fd) buffer 0 buffer_size in
-        let b = Compat.bytes_sub buffer 0 n in
-        Debug.trace 'x' (Debug.xprint b);
+        let b = Bytes.sub buffer 0 n in
+        Debug.trace 'x' (Debug.xprint (Bytes.to_string b));
 
         let use_dl_message = fun payload ->
           Debug.trace 'x' (Debug.xprint (Protocol.string_of_payload payload));
           let (msg_id, ac_id, values) = Dl_Pprz.values_of_payload payload in
           let msg = Dl_Pprz.message_of_id msg_id in
           Dl_Pprz.message_send "ground_dl" msg.PprzLink.name values in
 
-        assert (PprzTransport.parse use_dl_message b = n)
+        assert (PprzTransport.parse use_dl_message (Bytes.to_string b) = n)
       with
           exc ->
             prerr_endline (Printexc.to_string exc)

sw/ground_segment/tmtc/ivy2udp.ml

@@ -62,8 +62,8 @@ let () =
       let (msg_id, vs) = Tm_Pprz.values_of_string args.(0) in
       let payload = Tm_Pprz.payload_of_values msg_id (int_of_string !id) vs in
       let buf = Pprz_transport.Transport.packet payload in
-      let n = Compat.bytes_length buf in
-      let n' = Unix.sendto socket buf 0 n [] sockaddr in
+      let n = String.length buf in
+      let n' = Unix.sendto socket (Bytes.of_string buf) 0 n [] sockaddr in
       assert (n = n')
     with _ -> () in
 
@@ -75,21 +75,21 @@ let () =
   Unix.bind socket sockaddr;
 
   let buffer_size = 256 in
-  let buffer = Compat.bytes_create buffer_size in
+  let buffer = Bytes.create buffer_size in
   let get_datalink_message = fun _ ->
     begin
       try
         let n = input (Unix.in_channel_of_descr socket) buffer 0 buffer_size in
-        let b = Compat.bytes_sub buffer 0 n in
-        Debug.trace 'x' (Debug.xprint b);
+        let b = Bytes.sub buffer 0 n in
+        Debug.trace 'x' (Debug.xprint (Bytes.to_string b));
 
         let use_dl_message = fun payload ->
           Debug.trace 'x' (Debug.xprint (Protocol.string_of_payload payload));
           let (msg_id, ac_id, values) = Dl_Pprz.values_of_payload payload in
           let msg = Dl_Pprz.message_of_id msg_id in
           Dl_Pprz.message_send "ground_dl" msg.PprzLink.name values in
 
-        assert (PprzTransport.parse use_dl_message b = n)
+        assert (PprzTransport.parse use_dl_message (Bytes.to_string b) = n)
       with
           exc ->
             prerr_endline (Printexc.to_string exc)

sw/ground_segment/tmtc/ivy_tcp_aircraft.ml

@@ -41,21 +41,21 @@ let () =
 
   (* Forward a datalink command on the bus *)
   let buffer_size = 256 in
-  let buffer = Compat.bytes_create buffer_size in
+  let buffer = Bytes.create buffer_size in
   let get_datalink_message = fun _ ->
     begin
       try
         let n = input i buffer 0 buffer_size in
-        let b = Compat.bytes_sub buffer 0 n in
-        Debug.trace 'x' (Debug.xprint b);
+        let b = Bytes.sub buffer 0 n in
+        Debug.trace 'x' (Debug.xprint (Bytes.to_string b));
 
         let use_dl_message = fun payload ->
           Debug.trace 'x' (Debug.xprint (Protocol.string_of_payload payload));
           let (msg_id, ac_id, values) = Dl_Pprz.values_of_payload payload in
           let msg = Dl_Pprz.message_of_id msg_id in
           Dl_Pprz.message_send "ground_dl" msg.PprzLink.name values in
 
-        assert (PprzTransport.parse use_dl_message b = n)
+        assert (PprzTransport.parse use_dl_message (Bytes.to_string b) = n)
       with
           exc ->
             prerr_endline (Printexc.to_string exc)

sw/ground_segment/tmtc/ivy_tcp_controller.ml

@@ -29,21 +29,21 @@ let () =
   let (i, o) = Unix.open_connection sockaddr in
 
   let buffer_size = 256 in
-  let buffer = Compat.bytes_create buffer_size in
+  let buffer = Bytes.create buffer_size in
   let get_message = fun _ ->
     begin
       try
         let n = input i buffer 0 buffer_size in
-        let b = Compat.bytes_sub buffer 0 n in
-        Debug.trace 'x' (Debug.xprint b);
+        let b = Bytes.sub buffer 0 n in
+        Debug.trace 'x' (Debug.xprint (Bytes.to_string b));
 
         let use_tele_message = fun payload ->
           Debug.trace 'x' (Debug.xprint (Protocol.string_of_payload payload));
           let (msg_id, ac_id, values) = Tm_Pprz.values_of_payload payload in
           let msg = Tm_Pprz.message_of_id msg_id in
           Tm_Pprz.message_send (string_of_int ac_id) msg.PprzLink.name values in
 
-        ignore (PprzTransport.parse use_tele_message b)
+        ignore (PprzTransport.parse use_tele_message (Bytes.to_string b))
       with
           exc ->
             prerr_endline (Printexc.to_string exc)

sw/ground_segment/tmtc/kml.ml

@@ -92,7 +92,7 @@ let circle = fun geo radius alt ->
     let wgs84 = of_utm WGS84 utm in
     coordinates wgs84 alt in
   let points = Array.init 360 degree_point in
-  Compat.bytes_concat " " (points.(359) :: Array.to_list points)
+  String.concat " " (points.(359) :: Array.to_list points)
 
 
 let ring_around_home = fun utm0 fp ->
@@ -237,7 +237,7 @@ let update_horiz_mode =
       let alt = ac.desired_altitude in
       match ac.horiz_mode with
           Segment (p1, p2) ->
-            let coordinates = Compat.bytes_concat " " (List.map (fun p -> coordinates p alt) [p1; p2]) in
+            let coordinates = String.concat " " (List.map (fun p -> coordinates p alt) [p1; p2]) in
             let kml_changes = update_linear_ring url_flight_plan "horiz_mode" coordinates in
             print_xml ac.name "route_changes.kml" kml_changes
         | Circle (p, r) ->

sw/ground_segment/tmtc/link.ml

@@ -195,7 +195,7 @@ let update_ms_since_last_msg =
       statuss
 
 let use_tele_message = fun ?udp_peername ?raw_data_size payload ->
-  let raw_data_size = match raw_data_size with None -> Compat.bytes_length (Protocol.string_of_payload payload) | Some d -> d in
+  let raw_data_size = match raw_data_size with None -> String.length (Protocol.string_of_payload payload) | Some d -> d in
   let buf = Protocol.string_of_payload payload in
   Debug.call 'l' (fun f ->  fprintf f "pprz receiving: %s\n" (Debug.xprint buf));
   try
@@ -278,18 +278,18 @@ module XB = struct (** XBee module *)
 
       | Xbee_transport.RX_Packet_64 (addr64, rssi, options, data) ->
         Debug.trace 'x' (sprintf "getting XBee RX64: %Lx %d %d %s" addr64 rssi options (Debug.xprint data));
-        use_tele_message ~raw_data_size:(Compat.bytes_length frame_data + oversize_packet) (Protocol.payload_of_string data)
+        use_tele_message ~raw_data_size:(String.length frame_data + oversize_packet) (Protocol.payload_of_string data)
       | Xbee_transport.RX868_Packet (addr64, options, data) ->
         Debug.trace 'x' (sprintf "getting XBee868 RX: %Lx %d %s" addr64 options (Debug.xprint data));
-        use_tele_message ~raw_data_size:(Compat.bytes_length frame_data + oversize_packet) (Protocol.payload_of_string data)
+        use_tele_message ~raw_data_size:(String.length frame_data + oversize_packet) (Protocol.payload_of_string data)
       | Xbee_transport.RX_Packet_16 (addr16, rssi, options, data) ->
         Debug.trace 'x' (sprintf "getting XBee RX16: from=%x %d %d %s" addr16 rssi options (Debug.xprint data));
-        use_tele_message ~raw_data_size:(Compat.bytes_length frame_data + oversize_packet) (Protocol.payload_of_string data)
+        use_tele_message ~raw_data_size:(String.length frame_data + oversize_packet) (Protocol.payload_of_string data)
 
 
   let send = fun ?ac_id device rf_data ->
     let ac_id = match ac_id with None -> 0xffff | Some a -> a in
-    let rf_data = Protocol.string_of_payload rf_data in
+    let rf_data = Protocol.bytes_of_payload rf_data in
     let frame_id = gen_frame_id () in
     let frame_data =
       if !Xbee_transport.mode868 then
@@ -303,7 +303,7 @@ module XB = struct (** XBee module *)
 
     let o = Unix.out_channel_of_descr device.fd in
     fprintf o "%s%!" packet;
-    Debug.call 'y' (fun f -> fprintf f "link sending (%d): (%s) %s\n" frame_id (Debug.xprint rf_data) (Debug.xprint packet));
+    Debug.call 'y' (fun f -> fprintf f "link sending (%d): (%s) %s\n" frame_id (Debug.xprint (Bytes.to_string rf_data)) (Debug.xprint packet));
 end (** XBee module *)
 
 
@@ -315,11 +315,11 @@ let local_broadcast_address =
 
 let udp_send = fun fd payload peername ->
   let buf = Pprz_transport.Transport.packet payload in
-  let len = Compat.bytes_length buf in
+  let len = String.length buf in
   let addr = if !udp_broadcast then (Unix.inet_addr_of_string !udp_broadcast_addr) else peername in
   Debug.call 'u' (fun f -> fprintf f "udp_send to %s port %i\n" (Unix.string_of_inet_addr addr) !udp_uplink_port);
   let sockaddr = Unix.ADDR_INET (addr, !udp_uplink_port) in
-  let n = Unix.sendto fd buf 0 len [] sockaddr in
+  let n = Unix.sendto fd (Bytes.of_string buf) 0 len [] sockaddr in
   assert (n = len)
 
 let send = fun ac_id device payload _priority ->
@@ -370,7 +370,7 @@ let parser_of_device = fun device ->
   match device.transport with
     | Pprz ->
         let use = fun s ->
-          let raw_data_size = Compat.bytes_length (Protocol.string_of_payload s) + 4 (*stx,len,ck_a, ck_b*) in
+          let raw_data_size = String.length (Protocol.string_of_payload s) + 4 (*stx,len,ck_a, ck_b*) in
           let udp_peername =
             if !udp then
               Some !last_udp_peername
@@ -479,7 +479,7 @@ let () =
 
     (** Listen on a udp port or a serial device or on pipe *)
     let on_serial_device =
-      Compat.bytes_length !port >= 4 && Compat.bytes_sub !port 0 4 = "/dev" in (* FIXME *)
+      String.length !port >= 4 && String.sub !port 0 4 = "/dev" in (* FIXME *)
     let fd =
       if !udp then
         begin
@@ -504,7 +504,7 @@ let () =
     let read_fd =
       let buffered_parser =
         (* Get the specific parser for the given transport protocol *)
-        let parser = parser_of_device device in
+        let parser = fun b -> parser_of_device device (Bytes.to_string b) in
         let read = if !udp then udp_read else Unix.read in
         (* Wrap the parser into the buffered bytes reader *)
         match Serial.input ~read parser with Serial.Closure f -> f in