Merge 1a38c0bba2 into 87b10adcca

src/cbor/containers_cbor.ml

@@ -45,7 +45,7 @@ let to_string_diagnostic (self : t) : string =
   Format.asprintf "@[<h>%a@]" pp_diagnostic self
 
 (* we use funtions from Bytes *)
-[@@@ifge 4.08]
+[@@@if ge 4.08]
 
 exception Indefinite
 

src/cbor/containers_cbor.mli

@@ -28,7 +28,7 @@ val pp_diagnostic : t CCFormat.printer
 val to_string_diagnostic : t -> string
 
 (* we use funtions from Bytes *)
-[@@@ifge 4.08]
+[@@@if ge 4.08]
 
 val encode : ?buf:Buffer.t -> t -> string
 val decode : string -> (t, string) result

src/cbor/tests/t_appendix_a.ml

@@ -1,6 +1,6 @@
 let verbose = try Sys.getenv "VERBOSE" = "1" with _ -> false
 
-[@@@ifge 4.08]
+[@@@if ge 4.08]
 
 module J = Yojson.Safe
 module Fmt = CCFormat

src/core/CCArray.ml

@@ -13,11 +13,11 @@ type 'a printer = Format.formatter -> 'a -> unit
 
 open CCShims_
 
-[@@@ifge 4.8]
+[@@@if ge 4.8]
 
 include Array
 
-[@@@elifge 4.6]
+[@@@elif ge 4.6]
 
 include Array
 
@@ -597,7 +597,7 @@ module Infix = struct
   let ( -- ) = ( -- )
   let ( --^ ) = ( --^ )
 
-  [@@@ifge 4.8]
+  [@@@if ge 4.8]
 
   type 'a t = 'a array
 

src/core/CCArray.mli

@@ -14,12 +14,12 @@ type 'a printer = Format.formatter -> 'a -> unit
 
 (** {2 Arrays} *)
 
-[@@@ifge 4.8]
+[@@@if ge 4.8]
 
 include module type of Array
 (** @inline *)
 
-[@@@elifge 4.6]
+[@@@elif ge 4.6]
 
 include module type of Array
 (** @inline *)
@@ -375,7 +375,7 @@ module Infix : sig
   (** [x --^ y] creates an array containing integers in the range [x .. y]. Right bound excluded.
       @since 0.17 *)
 
-  [@@@ifge 4.8]
+  [@@@if ge 4.8]
 
   include CCShims_syntax.LET with type 'a t := 'a array
   (** Let operators on OCaml >= 4.08.0, nothing otherwise

src/core/CCArrayLabels.mli

@@ -14,12 +14,12 @@ type 'a printer = Format.formatter -> 'a -> unit
 
 (** {2 Arrays} *)
 
-[@@@ifge 4.8]
+[@@@if ge 4.8]
 
 include module type of ArrayLabels with module Floatarray = Array.Floatarray
 (** @inline *)
 
-[@@@elifge 4.6]
+[@@@elif ge 4.6]
 
 include module type of ArrayLabels with module Floatarray = Array.Floatarray
 (** @inline *)
@@ -389,7 +389,7 @@ module Infix : sig
   (** [x --^ y] creates an array containing integers in the range [x .. y]. Right bound excluded.
       @since 0.17 *)
 
-  [@@@ifge 4.8]
+  [@@@if ge 4.8]
 
   include CCShims_syntax.LET with type 'a t := 'a array
   (** Let operators on OCaml >= 4.08.0, nothing otherwise

src/core/CCAtomic.ml

@@ -1,4 +1,4 @@
-[@@@ifge 4.12]
+[@@@if ge 4.12]
 
 include Atomic
 

src/core/CCFormat.ml

@@ -301,7 +301,7 @@ let mark_close_style st : string =
   else
     ""
 
-[@@@ifge 4.8]
+[@@@if ge 4.8]
 
 type stag += Style of ANSI_codes.style list
 

src/core/CCFormat.mli

@@ -334,7 +334,7 @@ module ANSI_codes : sig
       is a very shiny style. *)
 end
 
-[@@@ifge 4.8]
+[@@@if ge 4.8]
 
 val styling : ANSI_codes.style list -> 'a printer -> 'a printer
 (** [styling st p] is the same printer as [p], except it locally sets

src/core/CCFun.ml

@@ -9,7 +9,7 @@ let opaque_identity x = x
 include Sys
 include CCShims_.Stdlib
 
-[@@@ifge 4.8]
+[@@@if ge 4.8]
 
 include Fun
 

src/core/CCFun.mli

@@ -2,7 +2,7 @@
 
 (** Basic operations on Functions *)
 
-[@@@ifge 4.8]
+[@@@if ge 4.8]
 
 include module type of Fun
 (** @inline *)

src/core/CCInt.ml

@@ -1,12 +1,12 @@
 (* This file is free software, part of containers. See file "license" for more details. *)
 
-[@@@ifge 4.07]
+[@@@if ge 4.07]
 [@@@else_]
 
 module Stdlib = Pervasives
 
 [@@@endif]
-[@@@ifge 4.08]
+[@@@if ge 4.08]
 
 include Int
 

src/core/CCInt.mli

@@ -2,7 +2,7 @@
 
 (** Basic Int functions *)
 
-[@@@ifge 4.08]
+[@@@if ge 4.08]
 
 include module type of Int
 (** @inline *)

src/core/CCList.ml

@@ -48,7 +48,7 @@ let rec assq_opt x = function
 
 (* end of backport *)
 
-[@@@ifge 4.8]
+[@@@if ge 4.8]
 
 include List
 
@@ -1470,7 +1470,7 @@ module Infix = struct
   let ( -- ) = ( -- )
   let ( --^ ) = ( --^ )
 
-  [@@@ifge 4.8]
+  [@@@if ge 4.8]
 
   let ( let+ ) = ( >|= )
   let ( let* ) = ( >>= )

src/core/CCList.mli

@@ -10,7 +10,7 @@ type 'a gen = unit -> 'a option
 type 'a printer = Format.formatter -> 'a -> unit
 type 'a random_gen = Random.State.t -> 'a
 
-[@@@ifge 4.8]
+[@@@if ge 4.8]
 
 include module type of List with type 'a t := 'a list
 (** @inline *)
@@ -981,7 +981,7 @@ module Infix : sig
   (** [i --^ j] is the infix alias for [range']. Second bound [j] excluded.
       @since 0.17 *)
 
-  [@@@ifge 4.08]
+  [@@@if ge 4.08]
 
   include CCShims_syntax.LET with type 'a t := 'a t
   (** @inline *)

src/core/CCOption.ml

@@ -182,7 +182,7 @@ module Infix = struct
   let ( <$> ) = map
   let ( <+> ) = ( <+> )
 
-  [@@@ifge 4.8]
+  [@@@if ge 4.8]
 
   let ( let+ ) = ( >|= )
   let ( let* ) = ( >>= )

src/core/CCOption.mli

@@ -175,7 +175,7 @@ module Infix : sig
   val ( <+> ) : 'a t -> 'a t -> 'a t
   (** [o1 <+> o2] is [o1] if [o1] is [Some _], [o2] if [o1] is [None]. *)
 
-  [@@@ifge 4.08]
+  [@@@if ge 4.08]
 
   include CCShims_syntax.LET with type 'a t := 'a t
   (** Let operators on OCaml >= 4.08.0, nothing otherwise

src/core/CCParse.ml

@@ -248,7 +248,7 @@ module Infix = struct
   let ( ||| ) = both
   let[@inline] ( <?> ) p msg = set_error_message msg p
 
-  [@@@ifge 4.8]
+  [@@@if ge 4.8]
 
   let ( let+ ) = ( >|= )
   let ( let* ) = ( >>= )

src/core/CCParse.mli

@@ -675,7 +675,7 @@ module Infix : sig
       [a ||| b] parses [a], then [b], then returns the pair of their results.
       @since 3.6 *)
 
-  [@@@ifge 4.08]
+  [@@@if ge 4.08]
 
   include CCShims_syntax.LET with type 'a t := 'a t
   (** Let operators on OCaml >= 4.08.0, nothing otherwise

src/core/CCRandom.ml

@@ -178,7 +178,7 @@ let fix ?(sub1 = []) ?(sub2 = []) ?(subn = []) ~base fuel st =
 let pure x _st = x
 let ( <*> ) f g st = f st (g st)
 
-[@@@ifge 4.8]
+[@@@if ge 4.8]
 
 let ( let+ ) = ( >|= )
 let ( let* ) = ( >>= )

src/core/CCRandom.mli

@@ -152,7 +152,7 @@ val fix :
 val pure : 'a -> 'a t
 val ( <*> ) : ('a -> 'b) t -> 'a t -> 'b t
 
-[@@@ifge 4.08]
+[@@@if ge 4.08]
 
 include CCShims_syntax.LET with type 'a t := 'a t
 (** Let operators on OCaml >= 4.08.0, nothing otherwise

src/core/CCResult.ml

@@ -269,7 +269,7 @@ module Infix = struct
   let ( >>= ) e f = flat_map f e
   let ( <*> ) = ( <*> )
 
-  [@@@ifge 4.8]
+  [@@@if ge 4.8]
 
   let ( let+ ) = ( >|= )
   let ( let* ) = ( >>= )

src/core/CCResult.mli

@@ -191,7 +191,7 @@ module Infix : sig
       [Ok (a b)]. Otherwise, it fails, and the error of [a] is chosen
       over the error of [b] if both fail. *)
 
-  [@@@ifge 4.08]
+  [@@@if ge 4.08]
 
   val ( let+ ) : ('a, 'e) t -> ('a -> 'b) -> ('b, 'e) t
   (** @since 2.8 *)

src/core/CCShims_.ml

@@ -1,4 +1,4 @@
-[@@@ifge 4.07]
+[@@@if ge 4.07]
 
 module Stdlib = Stdlib
 

src/core/CCShims_syntax.mli

@@ -1,4 +1,4 @@
-[@@@ifge 4.8]
+[@@@if ge 4.8]
 
 (** Let operators on OCaml >= 4.08.0, nothing otherwise
   @since 2.8 *)

src/core/CCString.ml

@@ -388,7 +388,7 @@ module Split = struct
   let right ~by s = try Some (right_exn ~by s) with Not_found -> None
 end
 
-[@@@ifge 4.04]
+[@@@if ge 4.04]
 [@@@else_]
 
 let split_on_char c s : _ list =

src/core/CCUnit.ml

@@ -1,4 +1,4 @@
-[@@@ifge 4.08]
+[@@@if ge 4.08]
 
 include Unit
 

src/core/CCVector.ml

@@ -680,7 +680,7 @@ let pp ?(pp_start = fun _ () -> ()) ?(pp_stop = fun _ () -> ())
     v;
   pp_stop fmt ()
 
-[@@@ifge 4.8]
+[@@@if ge 4.8]
 
 let ( let+ ) = ( >|= )
 let ( let* ) = ( >>= )

src/core/CCVector.mli

@@ -397,7 +397,7 @@ val pp :
     By defaults [pp_start] and [pp_stop] does nothing and [pp_sep] defaults to
     (fun out -> Format.fprintf out ",@ "). *)
 
-[@@@ifge 4.08]
+[@@@if ge 4.08]
 
 val ( let+ ) : ('a, 'e) t -> ('a -> 'b) -> ('b, 'e) t
 (** @since 2.8 *)

src/core/cpp/cpp.ml

@@ -1,13 +1,16 @@
 module C = Configurator.V1
 
-type op = Le | Ge
+type conf = { os_type: string; major: int; minor: int }
+type comp = Le | Ge
+type condition = Version of comp * int * int | Os_type of string
 
 type line =
-  | If of op * int * int
+  | If of condition
-  | Elseif of op * int * int
+  | Elseif of condition
   | Else
   | Endif
   | Raw of string
+  | Eol
   | Eof
 
 let prefix ~pre s =
@@ -26,81 +29,132 @@ let prefix ~pre s =
     check 0
   )
 
-let eval ~major ~minor op i j =
+let get_tag_from_opt s pos =
-  match op with
+  let rec get_start pos =
-  | Le -> (major, minor) <= (i, j)
+    let p = String.index_from s pos '[' in
-  | Ge -> (major, minor) >= (i, j)
+    if p > String.length s - 5 then
+      raise_notrace Not_found
+    else if s.[p + 1] = '@' && s.[p + 2] = '@' && s.[p + 3] = '@' then
+      p
+    else
+      get_start (p + 1)
+  in
+  try
+    let start = get_start pos in
+    Some (get_start pos, String.index_from s (start + 4) ']')
+  with Not_found -> None
 
-let preproc_lines ~file ~major ~minor (ic : in_channel) : unit =
+let split_trim s c =
+  try
+    let p = String.index s c in
+    ( String.trim (String.sub s 0 p),
+      String.trim (String.sub s (p + 1) (String.length s - p - 1)) )
+  with Not_found -> s, ""
+
+let eval ~conf = function
+  | Os_type ty -> conf.os_type = ty
+  | Version (op, i, j) ->
+    (match op with
+    | Le -> (conf.major, conf.minor) <= (i, j)
+    | Ge -> (conf.major, conf.minor) >= (i, j))
+
+let preproc_lines ~file ~conf (ic : in_channel) : unit =
   let pos = ref 0 in
   let fail msg =
     failwith (Printf.sprintf "at line %d in '%s': %s" !pos file msg)
   in
   let pp_pos () = Printf.printf "#%d %S\n" !pos file in
 
-  let parse_line () : line =
+  let parse_condition condition =
-    match input_line ic with
+    flush_all ();
-    | exception End_of_file -> Eof
+    match split_trim condition ' ' with
-    | line ->
+    | "le", value -> Scanf.sscanf value "%d.%d" (fun x y -> Version (Le, x, y))
-      let line' = String.trim line in
+    | "ge", value -> Scanf.sscanf value "%d.%d" (fun x y -> Version (Ge, x, y))
-      incr pos;
+    | "os", value -> Os_type (String.lowercase_ascii value)
-      if line' <> "" && line'.[0] = '[' then
+    | _ -> failwith (Printf.sprintf "Syntax error condition: %s" condition)
-        if prefix line' ~pre:"[@@@ifle" then
+  in
-          Scanf.sscanf line' "[@@@ifle %d.%d]" (fun x y -> If (Le, x, y))
+
-        else if prefix line' ~pre:"[@@@ifge" then
+  let rec parse_from line pos =
-          Scanf.sscanf line' "[@@@ifge %d.%d]" (fun x y -> If (Ge, x, y))
+    match get_tag_from_opt line pos with
-        else if prefix line' ~pre:"[@@@elifle" then
+    | None -> [ Raw (String.sub line pos (String.length line - pos)); Eol ]
-          Scanf.sscanf line' "[@@@elifle %d.%d]" (fun x y -> Elseif (Le, x, y))
+    | Some (s, e) ->
-        else if prefix line' ~pre:"[@@@elifge" then
+      let tag = String.sub line (s + 4) (e - s - 4) |> String.trim in
-          Scanf.sscanf line' "[@@@elifge %d.%d]" (fun x y -> Elseif (Ge, x, y))
+      flush_all ();
-        else if line' = "[@@@else_]" then
+      let op, rest = split_trim tag ' ' in
-          Else
+      let next_token =
-        else if line' = "[@@@endif]" then
+        match op with
-          Endif
+        | "if" -> If (parse_condition rest)
-        else
+        | "elif" -> Elseif (parse_condition rest)
-          Raw line
+        | "else_" -> Else
+        | "endif" -> Endif
+        | _ -> Raw (String.sub line s (e - s + 1))
+      in
+      if s = 0 && s = String.length line then
+        [ next_token ]
       else
-        Raw line
+        next_token :: parse_from line (e + 1)
+  in
+
+  let parse_line () : line list =
+    match input_line ic with
+    | exception End_of_file -> [ Eof ]
+    | line -> parse_from line 0
+  in
+
+  let get_next =
+    let q = Queue.create () in
+    fun () ->
+      try Queue.pop q
+      with Queue.Empty ->
+        List.iter (fun x -> Queue.push x q) (parse_line ());
+        Queue.pop q
   in
 
   (* entry point *)
   let rec top () =
-    match parse_line () with
+    match get_next () with
     | Eof -> ()
-    | If (op, i, j) ->
+    | If condition ->
-      if eval ~major ~minor op i j then (
+      if eval ~conf condition then (
         pp_pos ();
         cat_block ()
       ) else
         skip_block ~elseok:true ()
     | Raw s ->
-      print_endline s;
+      print_string s;
+      top ()
+    | Eol ->
+      print_newline ();
       top ()
     | Elseif _ | Else | Endif -> fail "unexpected elseif|else|endif"
   (* current block is the valid one *)
   and cat_block () =
-    match parse_line () with
+    match get_next () with
     | Eof -> fail "unexpected EOF"
     | If _ -> fail "nested if not supported"
     | Raw s ->
-      print_endline s;
+      print_string s;
+      cat_block ()
+    | Eol ->
+      print_newline ();
       cat_block ()
     | Endif ->
+      flush_all ();
       pp_pos ();
       top ()
     | Elseif _ | Else -> skip_block ~elseok:false ()
   (* skip current block.
      @param elseok if true, we should evaluate "elseif" *)
   and skip_block ~elseok () =
-    match parse_line () with
+    match get_next () with
     | Eof -> fail "unexpected EOF"
     | If _ -> fail "nested if not supported"
-    | Raw _ -> skip_block ~elseok ()
+    | Raw _ | Eol -> skip_block ~elseok ()
     | Endif ->
       pp_pos ();
       top ()
-    | Elseif (op, i, j) ->
+    | Elseif condition ->
-      if elseok && eval ~major ~minor op i j then (
+      if elseok && eval ~conf condition then (
         pp_pos ();
         cat_block ()
       ) else
@@ -120,9 +174,10 @@ let () =
   let c = C.create "main" in
   let version = C.ocaml_config_var_exn c "version" in
   let major, minor = Scanf.sscanf version "%u.%u" (fun maj min -> maj, min) in
+  let os_type = String.lowercase_ascii (C.ocaml_config_var_exn c "os_type") in
 
   let ic = open_in file in
-  preproc_lines ~file ~major ~minor ic;
+  preproc_lines ~file ~conf:{ os_type; major; minor } ic;
 
   Printf.printf "(* file preprocessed in %.3fs *)\n" (Unix.gettimeofday () -. t0);
   ()

src/monomorphic/CCMonomorphic.ml

@@ -1,6 +1,6 @@
 (* This file is free software, part of containers. See file "license" for more details. *)
 
-[@@@ifge 4.07]
+[@@@if ge 4.07]
 [@@@else_]
 
 module Stdlib = Pervasives

src/testlib/containers_testlib.ml

@@ -31,7 +31,7 @@ module Test = struct
     in
     Printf.sprintf "(test :file '%s'%s :n %d)" self.__FILE__ what self.n
 
-  [@@@ifge 4.08]
+  [@@@if ge 4.08]
 
   let get_state (r : _ QCheck.TestResult.t) : _ QCheck.TestResult.state =
     QCheck.TestResult.get_state r

src/threads/CCPool.ml

@@ -519,7 +519,7 @@ module Make (P : PARAM) = struct
       let ( >|= ) a f = map f a
       let ( <*> ) = app
 
-      [@@@ifge 4.8]
+      [@@@if ge 4.8]
 
       let ( let+ ) = ( >|= )
       let ( let* ) = ( >>= )

src/threads/CCPool.mli

@@ -147,7 +147,7 @@ module Make (P : PARAM) : sig
       val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t
       val ( <*> ) : ('a -> 'b) t -> 'a t -> 'b t
 
-      [@@@ifge 4.08]
+      [@@@if ge 4.08]
 
       include CCShims_syntax.LET with type 'a t := 'a t
       (** Let operators on OCaml >= 4.08.0, nothing otherwise

tests/core/t_cbor.ml

@@ -1,7 +1,7 @@
 include (val Containers_testlib.make ~__FILE__ ())
 module Cbor = Containers_cbor
 
-[@@@ifge 4.08]
+[@@@if ge 4.08]
 
 let gen_c : Cbor.t Q.Gen.t =
   let open Q.Gen in

tests/core/t_format.ml

@@ -45,7 +45,7 @@ t @@ fun () ->
   assert_equal ~printer:CCFun.id "coucou\n" (Buffer.contents buf2);
   true;;
 
-[@@@ifge 4.8]
+[@@@if ge 4.8]
 
 t @@ fun () ->
   set_color_default true;