new operator '~' for semantic versioning (ocaml#2976)

src/client/opamArg.ml

@@ -617,7 +617,8 @@ let atom_or_dir =
 let dep_formula =
   let module OpamParser = OpamParser.FullPos in
   let module OpamPrinter = OpamPrinter.FullPos in
-  let pp = OpamFormat.V.(package_formula `Conj (constraints version)) in
+  let pp = OpamFormat.V.(package_formula `Conj
+                           (constraints version OpamPackage.Version.next)) in
   let parse str =
     try
       let v = OpamParser.value_from_string str "<command-line>" in

src/format/opamFile.ml

@@ -1352,7 +1352,8 @@ module ConfigSyntax = struct
         (Pp.V.map_list ~depth:1 Pp.V.arg);
       "default-compiler", Pp.ppacc
         with_default_compiler default_compiler
-        (Pp.V.package_formula `Disj Pp.V.(constraints Pp.V.version));
+        (Pp.V.package_formula `Disj
+           Pp.V.(constraints Pp.V.version OpamPackage.Version.next));
       "depext", Pp.ppacc
         with_depext depext
         Pp.V.bool;
@@ -1511,7 +1512,8 @@ module InitConfigSyntax = struct
            (fun (name, (url, ta)) -> (name, Some url, ta)));
       "default-compiler", Pp.ppacc
         with_default_compiler default_compiler
-        (Pp.V.package_formula `Disj Pp.V.(constraints Pp.V.version));
+        (Pp.V.package_formula `Disj
+           Pp.V.(constraints Pp.V.version OpamPackage.Version.next));
       "jobs", Pp.ppacc_opt
         (with_jobs @* OpamStd.Option.some) jobs
         Pp.V.pos_int;
@@ -1729,7 +1731,8 @@ module Switch_configSyntax = struct
       (Pp.V.map_list ~depth:2 Pp.V.env_binding);
     "invariant", Pp.ppacc
       (fun invariant t -> {t with invariant}) (fun t -> t.invariant)
-      (Pp.V.package_formula `Conj Pp.V.(constraints version));
+      (Pp.V.package_formula `Conj
+         Pp.V.(constraints version OpamPackage.Version.next));
     "depext-bypass", Pp.ppacc
       (fun depext_bypass t -> { t with depext_bypass})
       (fun t -> t.depext_bypass)
@@ -2684,12 +2687,15 @@ module OPAMSyntax = struct
         (Pp.V.map_list ~depth:1 Pp.V.string);
 
       "depends", no_cleanup Pp.ppacc with_depends depends
-        (Pp.V.package_formula `Conj Pp.V.(filtered_constraints ext_version));
+        (Pp.V.package_formula `Conj
+           Pp.V.(filtered_constraints ext_version (fun f -> FNext f)));
       "depopts", with_cleanup cleanup_depopts Pp.ppacc with_depopts depopts
-        (Pp.V.package_formula `Disj Pp.V.(filtered_constraints ext_version));
+        (Pp.V.package_formula `Disj
+           Pp.V.(filtered_constraints ext_version (fun f -> FNext f)));
       "conflicts", with_cleanup cleanup_conflicts
         Pp.ppacc with_conflicts conflicts
-        (Pp.V.package_formula `Disj Pp.V.(filtered_constraints ext_version));
+        (Pp.V.package_formula `Disj
+           Pp.V.(filtered_constraints ext_version (fun f -> FNext f)));
       "conflict-class", no_cleanup Pp.ppacc with_conflict_class conflict_class
         (Pp.V.map_list ~depth:1 Pp.V.pkgname);
       "available", no_cleanup Pp.ppacc with_available available
@@ -2721,7 +2727,8 @@ module OPAMSyntax = struct
         (Pp.V.map_list ~depth:1 @@
          Pp.V.map_options_2
            (Pp.V.ident -| Pp.of_module "variable" (module OpamVariable))
-           (Pp.V.package_formula_items `Conj Pp.V.(filtered_constraints ext_version))
+           (Pp.V.package_formula_items `Conj
+              Pp.V.(filtered_constraints ext_version (fun f -> FNext f)))
            (Pp.singleton -| Pp.V.string));
 
       "messages", no_cleanup Pp.ppacc with_messages messages
@@ -2782,7 +2789,8 @@ module OPAMSyntax = struct
       "ocaml-version", no_cleanup
         Pp.ppacc_opt with_ocaml_version OpamStd.Option.none
         (Pp.V.list_depth 1 -| Pp.V.list -|
-         Pp.V.constraints Pp.V.compiler_version);
+           Pp.V.constraints Pp.V.compiler_version
+             (fun _ -> raise (Failure "unexpected '~' in compiler constraints")));
       "os", no_cleanup Pp.ppacc_opt with_os OpamStd.Option.none
         Pp.V.os_constraint;
       "descr", no_cleanup Pp.ppacc_opt with_descr OpamStd.Option.none
@@ -3613,7 +3621,8 @@ module CompSyntax = struct
         (Pp.V.map_list ~depth:1 Pp.V.command);
 
       "packages", Pp.ppacc with_packages packages
-        (Pp.V.package_formula `Conj (Pp.V.constraints Pp.V.version));
+        (Pp.V.package_formula `Conj
+           (Pp.V.constraints Pp.V.version OpamPackage.Version.next));
       "env", Pp.ppacc with_env env
         (Pp.V.map_list ~depth:2 Pp.V.env_binding);
       "preinstalled", Pp.ppacc_opt with_preinstalled

src/format/opamFilter.ml

@@ -41,6 +41,8 @@ let to_string t =
       (match converter with
        | Some (it,ifu) -> "?"^it^":"^ifu
        | None -> "")
+    | FNext f    ->
+       Printf.sprintf "#next(%s)" (aux f)
     | FOp(e,s,f) ->
       paren ~cond:(context <> `Or && context <> `And)
         (Printf.sprintf "%s %s %s"
@@ -71,6 +73,7 @@ let rec map_up f = function
   | FOp (l, op, r) -> f (FOp (map_up f l, op, map_up f r))
   | FAnd (l, r) -> f (FAnd (map_up f l, map_up f r))
   | FOr (l, r) -> f (FOr (map_up f l, map_up f r))
+  | FNext x -> f (FNext (map_up f x))
   | FNot x -> f (FNot (map_up f x))
   | FUndef x -> f (FUndef (map_up f x))
   | (FBool _ | FString _ | FIdent _ | FDefined _) as flt -> f flt
@@ -347,6 +350,12 @@ let rec reduce_aux ?no_undef_expand ~default_str env =
   | FBool b -> FBool b
   | FString s -> FString s
   | FIdent i -> resolve_ident ?no_undef_expand env i
+  | FNext f ->
+     (match reduce f with
+      | FUndef x -> FUndef (FNext x)
+      | f -> FString (OpamPackage.Version.(value_string f
+                                           |> of_string |> next
+                                           |> to_string)))
   | FOp (e,relop,f) ->
     (match reduce e, reduce f with
      | FUndef x, FUndef y -> FUndef (FOp (x, relop, y))

src/format/opamFormat.ml

@@ -306,7 +306,13 @@ module V = struct
         | Int i -> FString (string_of_int i)
         | Ident _ -> FIdent (parse ~pos:v.pos filter_ident v)
         | Group g -> parse_filter ~pos:v.pos g.pelem
-        | Relop (op,e,f) -> FOp (aux e, op.pelem, aux f)
+        | Relop (op,e,f) ->
+           (match op.pelem with
+            | `Sem -> (* rewrite `Sem case *)
+               FAnd (FOp (aux e, `Geq, aux f),
+                     FOp (aux e, `Lt, FNext (aux f)))
+            | `Eq | `Neq | `Gt | `Geq | `Lt | `Leq as op ->
+               FOp (aux e, op, aux f))
         | Pfxop ({ pelem = `Not; _}, e) -> FNot (aux e)
         | Pfxop ({ pelem = `Defined; _}, e) -> FDefined (aux e)
         | Logop ({ pelem = `And; _}, e, f)-> FAnd (aux e, aux f)
@@ -331,9 +337,15 @@ module V = struct
         | FString s  -> print string s
         | FIdent fid -> print filter_ident fid
         | FBool b    -> print bool b
+        | FAnd (FOp (f1, `Geq, v1), FOp(f2, `Lt, FNext v2))
+             when f1 = f2 && v1 = v2 ->
+           (* match rewrote `Sem *)
+           group_if ~cond:(context <> `Or && context <> `And) @@ nullify_pos @@
+           Relop (nullify_pos `Sem, aux ~context:`Relop f1, aux ~context:`Relop v1)
         | FOp (e,s,f) ->
+           let s :> relop_kind with_pos = nullify_pos s in
           group_if ~cond:(context <> `Or && context <> `And) @@ nullify_pos @@
-          Relop (nullify_pos s, aux ~context:`Relop e, aux ~context:`Relop f)
+          Relop (s, aux ~context:`Relop e, aux ~context:`Relop f)
         | FOr (e,f) ->
           group_if ~cond:(context <> `Or) @@ nullify_pos @@
           Logop (nullify_pos `Or, aux ~context:`Or e, aux ~context:`Or f)
@@ -346,7 +358,7 @@ module V = struct
         | FDefined f ->
           group_if ~cond:(context = `Relop) @@ nullify_pos @@
           Pfxop (nullify_pos `Defined, aux ~context:`Defined f)
-        | FUndef _ -> assert false
+        | FUndef _  | FNext _ -> assert false
       in
       match f with
       | FBool true -> []
@@ -358,10 +370,16 @@ module V = struct
 
   let command = map_option (map_list arg) (opt filter)
 
-  let constraints version =
+  let constraints version next =
     let rec parse_constraints ~pos:_ l =
       let rec aux v = match v.pelem with
-        | Prefix_relop (op, v) -> Atom (op.pelem, parse version ~pos:v.pos v)
+        | Prefix_relop (op, v) ->
+           let ver = parse version ~pos:v.pos v in
+           (match op.pelem with
+            | `Sem -> (* rewrite `Sem case *)
+               And (Atom (`Geq, ver), Atom (`Lt, next ver))
+            | `Eq | `Neq | `Gt | `Geq | `Lt | `Leq as op ->
+               Atom (op, ver))
         | Logop ({ pelem = `And; _}, l, r) -> And (aux l, aux r)
         | Logop ({ pelem = `Or; _}, l, r) -> Or (aux l, aux r)
         | Pfxop ({ pelem = `Not; _}, v) ->
@@ -381,9 +399,14 @@ module V = struct
         in
         match cs with
         | Empty       -> assert false
+        | And (Atom (`Geq, v1), Atom (`Lt, v2))
+             when next v1 = v2 ->
+          (* match rewrote `Sem *)
+          group_if @@ nullify_pos @@
+          Prefix_relop (nullify_pos `Sem, print version v1)
         | Atom (r, v) ->
           group_if @@ nullify_pos @@
-          Prefix_relop (nullify_pos r, print version v)
+          Prefix_relop ((nullify_pos r :> relop_kind with_pos), print version v)
         | And (x, y)  ->
           group_if @@ nullify_pos @@
           Logop (nullify_pos `And, aux ~in_and:true x, aux ~in_and:true y)
@@ -400,11 +423,17 @@ module V = struct
     pp ~name:(version.ppname ^ "-constraints")
       parse_constraints print_constraints
 
-  let filtered_constraints version =
+  let filtered_constraints version next =
     let rec parse_cs ~pos:_ items =
       let rec aux_parse v = match v.pelem with
         | Prefix_relop (op, v) ->
-          Atom (Constraint (op.pelem, parse version ~pos:v.pos v))
+           let ver = parse version ~pos:v.pos v in
+           (match op.pelem with
+            | `Sem -> (* rewrite `Sem case *)
+               And (Atom (Constraint (`Geq, ver)),
+                    Atom (Constraint (`Lt, next ver)))
+            | `Eq | `Neq | `Gt | `Geq | `Lt | `Leq as op ->
+               Atom (Constraint (op, ver)))
         | Logop ({ pelem = `And; _}, a, b) ->
           OpamFormula.ands [aux_parse a; aux_parse b]
         | Logop ({ pelem = `Or; _}, a, b) ->
@@ -429,6 +458,12 @@ module V = struct
         in
         match cs with
         | Empty -> assert false
+        | And (Atom (Constraint (`Geq, v1)),
+               Atom (Constraint (`Lt, v2)))
+             when (next v1) = v2 ->
+           (* match rewrote `Sem *)
+           group_if @@ nullify_pos @@
+             Prefix_relop (nullify_pos `Sem, print version v1)
         | And (x, y) ->
           group_if @@ nullify_pos @@
           Logop (nullify_pos `And, aux ~in_and:true x, aux ~in_and:true y)
@@ -438,7 +473,7 @@ module V = struct
         | Block g -> nullify_pos @@ Group (nullify_pos @@ print_cs g)
         | Atom (Constraint (op,v)) ->
           group_if @@ nullify_pos @@
-          Prefix_relop (nullify_pos op, print version v)
+          Prefix_relop ((nullify_pos op :> relop_kind with_pos), print version v)
         | Atom (Filter flt) ->
           (match filter.print flt with
            | f1::fr ->

src/format/opamFormat.mli

@@ -134,12 +134,14 @@ module V : sig
 
   (** Simple dependency constraints *)
   val constraints :
-    (value, 'a) t ->
-    (value list, (OpamFormula.relop * 'a) OpamFormula.formula) t
+    (value, 'version) t ->
+    ('version -> 'version) ->
+    (value list, (OpamFormula.relop * 'version) OpamFormula.formula) t
 
   (** Dependency constraints mixed with filters *)
   val filtered_constraints :
     (value, 'version) t ->
+    ('version -> 'version) ->
     (value list, 'version filter_or_constraint OpamFormula.formula) t
 
   (** Package versions *)

src/format/opamFormula.ml

@@ -63,7 +63,10 @@ let atom_of_string str =
     let sversion = Re.Group.get sub 3 in
     let name = OpamPackage.Name.of_string sname in
     let sop = if sop = "." then "=" else sop in
-    let op = OpamLexer.FullPos.relop sop in
+    let op = match OpamLexer.FullPos.relop sop with
+      | `Eq | `Neq | `Gt | `Geq | `Lt | `Leq as sop -> sop
+      | `Sem -> raise (Failure "unexpected '~' in atomic constraint")
+    in
     let version = OpamPackage.Version.of_string sversion in
     name, Some (op, version)
   with Not_found | Failure _ | OpamLexer.Error _ ->

src/format/opamFormula.mli

@@ -13,7 +13,7 @@
     functions *)
 
 (** binary operations (compatible with the Dose type for Cudf operators!) *)
-type relop = OpamParserTypes.FullPos.relop_kind (* = [ `Eq | `Neq | `Geq | `Gt | `Leq | `Lt ] *)
+type relop = [ `Eq | `Neq | `Geq | `Gt | `Leq | `Lt ]
 
 (** Version constraints for OPAM *)
 type version_constraint = relop * OpamPackage.Version.t

src/format/opamPackage.ml

@@ -39,6 +39,34 @@ module Version = struct
   let equal v1 v2 =
     compare v1 v2 = 0
 
+  let next v =
+    let re = Re.(compile @@ seq [ start;
+      group @@ rep @@ diff any (alt [ digit; char '~' ]);
+      group @@ opt @@ seq [
+        rep1 @@ digit;
+        rep @@ seq [
+          char '.';
+          rep1 @@ digit ]]
+      ])
+    in
+    let res = Re.exec re v in
+    let pfx = Re.Group.get res 1 in
+    let num = Re.Group.get res 2 in
+    let nums = String.split_on_char '.' num in
+    let incr_compat_num nums =
+      let aux = function
+        | [] -> ["1"]
+        | [n] -> [int_of_string n |> (+)1 |> string_of_int ]
+        | n0::n1::ns ->
+           let nn0,nn1 = int_of_string n0, int_of_string n1 in
+           if not (nn1=0 && ns=[])
+           then (string_of_int (nn1+1))::ns
+           else (string_of_int (nn0+1))::n1::ns
+      in List.rev nums |> aux |> List.rev
+    in
+    let next = incr_compat_num nums |> String.concat "." in
+    pfx^next
+
   let to_json x =
     `String (to_string x)
   let of_json = function

src/format/opamPackage.mli

@@ -24,6 +24,10 @@ module Version: sig
 
   (** Are two package versions equal? *)
   val equal: t -> t -> bool
+
+  (** Next version from semantic versioning perspective (#2976) *)
+  val next: t -> t
+
 end
 
 (** Names *)

src/format/opamTypes.mli

@@ -174,14 +174,15 @@ type repository = {
 
 (** {2 Variable-based filters} *)
 
-type relop = OpamParserTypes.FullPos.relop_kind
+type relop = OpamFormula.relop
 
 type filter =
   | FBool of bool
   | FString of string
   | FIdent of (name option list * variable * (string * string) option)
   (** packages (or None for self-ref through "_"), variable name,
       string converter (val_if_true, val_if_false_or_undef) *)
+  | FNext of filter
   | FOp of filter * relop * filter
   | FAnd of filter * filter
   | FOr of filter * filter

src/state/opamFileTools.ml

@@ -786,7 +786,7 @@ let t_lint ?check_extra_files ?(check_upstream=false) ?(all=false) t =
          | FOp (fl,_,fr) -> (aux acc true fl) @ aux acc true fr
          | FAnd (fl, fr) | FOr (fl, fr)  ->
            (aux acc false fl) @ aux acc false fr
-         | FNot f | FDefined f | FUndef f -> aux acc false f
+         | FNot f | FNext f | FDefined f | FUndef f -> aux acc false f
        in
        aux [] false
      in
@@ -1137,7 +1137,7 @@ let read_repo_opam ~repo_name ~repo_root dir =
 
 let dep_formula_to_string f =
   let pp =
-    OpamFormat.V.(package_formula `Conj (constraints version))
+    OpamFormat.V.(package_formula `Conj (constraints version OpamPackage.Version.next))
   in
   OpamPrinter.FullPos.value (OpamPp.print pp f)