Merge pull request #37 from dinosaure/bytes_set16u

Use %caml_bytes_set16u when it's available (with dune-configurator)

base64.opam

@@ -17,7 +17,8 @@ representation.  It is specified in RFC 4648.
 depends: [
   "ocaml" {>="4.03.0"}
   "base-bytes"
-  "dune" {>= "1.0.1"}
+  "dune-configurator"
+  "dune" {>= "2.0"}
   "bos" {with-test}
   "rresult" {with-test}
   "alcotest" {with-test}

config/config.ml

@@ -0,0 +1,48 @@
+module Config = Configurator.V1
+
+let pre407 = {ocaml|external unsafe_set_uint16 : bytes -> int -> int -> unit = "%caml_string_set16u" [@@noalloc]|ocaml}
+let standard = {ocaml|external unsafe_set_uint16 : bytes -> int -> int -> unit = "%caml_bytes_set16u" [@@noalloc]|ocaml}
+
+type t =
+  { major : int
+  ; minor : int
+  ; patch : int option
+  ; extra : string option }
+
+let v ?patch ?extra major minor = { major; minor; patch; extra; }
+
+let parse s =
+  try Scanf.sscanf s "%d.%d.%d+%s" (fun major minor patch extra -> v ~patch ~extra major minor)
+  with End_of_file | Scanf.Scan_failure _ ->
+    ( try Scanf.sscanf s "%d.%d+%s" (fun major minor extra -> v ~extra major minor)
+      with End_of_file | Scanf.Scan_failure _ ->
+        ( try Scanf.sscanf s "%d.%d.%d" (fun major minor patch -> v ~patch major minor)
+          with End_of_file | Scanf.Scan_failure _ ->
+            Scanf.sscanf s "%d.%d" (fun major minor -> v major minor) ) )
+
+let ( >|= ) x f = match x with
+  | Some x -> Some (f x )
+  | None -> None
+
+let ocaml_cp ~src ~dst =
+  let ic = open_in src in
+  let oc = open_out dst in
+  let bf = Bytes.create 0x1000 in
+  let rec go () = match input ic bf 0 (Bytes.length bf) with
+    | 0 -> ()
+    | len -> output oc bf 0 len ; go ()
+    | exception End_of_file -> () in
+  go () ; close_in ic ; close_out oc
+;;
+
+let () =
+  Config.main ~name:"config-base64" @@ fun t ->
+  match Config.ocaml_config_var t "version" >|= parse with
+  | Some version ->
+    let dst = "unsafe.ml" in
+
+    if (version.major, version.minor) >= (4, 7)
+    then ocaml_cp ~src:"unsafe_stable.ml" ~dst
+    else ocaml_cp ~src:"unsafe_pre407.ml" ~dst
+  | None -> Config.die "OCaml version is not available"
+  | exception exn -> Config.die "Got an exception: %s" (Printexc.to_string exn)

config/dune

@@ -0,0 +1,3 @@
+(executable
+ (name config)
+ (libraries dune-configurator))

src/base64.ml

@@ -32,8 +32,8 @@ let (//) x y =
 
 let unsafe_get_uint8 t off = Char.code (String.unsafe_get t off)
 let unsafe_set_uint8 t off v = Bytes.unsafe_set t off (Char.chr v)
+let unsafe_set_uint16 = Unsafe.unsafe_set_uint16
 
-external unsafe_set_uint16 : bytes -> int -> int -> unit = "%caml_string_set16u" [@@noalloc]
 external unsafe_get_uint16 : string -> int -> int = "%caml_string_get16u" [@@noalloc]
 external swap16 : int -> int = "%bswap16" [@@noalloc]
 

src/dune

@@ -1,11 +1,16 @@
 (library
  (name base64)
- (modules base64)
+ (modules unsafe base64)
  (public_name base64)
  (libraries bytes))
 
+(rule
+ (targets unsafe.ml)
+ (deps (:config ../config/config.exe) unsafe_pre407.ml unsafe_stable.ml)
+ (action (run %{config})))
+
 (library
  (name base64_rfc2045)
  (modules base64_rfc2045)
  (public_name base64.rfc2045)
- (libraries bytes))
+ (libraries bytes))

src/unsafe_pre407.ml

@@ -0,0 +1 @@
+external unsafe_set_uint16 : bytes -> int -> int -> unit = "%caml_string_set16u" [@@noalloc]

src/unsafe_stable.ml

@@ -0,0 +1 @@
+external unsafe_set_uint16 : bytes -> int -> int -> unit = "%caml_bytes_set16u" [@@noalloc]