Source file `opamVersionCompare.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
(******************************************************************************)
(*  This file is a modified version of the one found in the Dose library      *)
(*  See https://gitlab.com/irill/dose3/                                       *)
(*  The original can be found in src/versioning/debian.ml                     *)
(*                                                                            *)
(*  Copyright (C) 2011 Ralf Treinen <ralf.treinen@pps.jussieu.fr>             *)
(*                                                                            *)
(*  All rights reserved. This file is distributed under the terms of the      *)
(*  GNU Lesser General Public License version 2.1, with the special           *)
(*  exception on linking described in the file LICENSE.                       *)
(*                                                                            *)
(*  Work developed with the support of the Mancoosi Project                   *)
(*  http://www.mancoosi.org                                                   *)
(*                                                                            *)
(******************************************************************************)

let is_digit = function
  | '0'..'9' -> true
  | _ -> false

(* [skip_while_from i f w m] yields the index of the leftmost character
 * in the string [s], starting from [i], and ending at [m], that does
 * not satisfy the predicate [f], or [length w] if no such index exists.  *)
let rec skip_while_from i f w m =
  if (i : int) = m then i
  else if f w.[i] then skip_while_from (i + 1) f w m else i

(* splits a version into (prefix,revision). The revision starts on the
 * right-most occurrence of '-', or is empty in case the version does
 * not contain '-'.  *)
let extract_revision x =
  try
    let di = String.rindex x '-' in
    let before = String.sub x 0 di in
    let after = String.sub x (di+1) (String.length x - di -1) in
    (before,after)
  with
    | Not_found -> (x,"")

(* character comparison uses a modified character ordering: '~' first,
   then letters, then anything else *)
let compare_chars c1 c2 = match c1 with
  | '~' -> (match c2 with
      | '~' -> 0
      | _ -> -1)
  | 'a'..'z'|'A'..'Z' -> (match c2 with
      | '~' -> 1
      | 'a'..'z'|'A'..'Z' -> Char.compare c1 c2
      | _ -> -1)
  | _ -> (match c2 with
      | '~'|'a'..'z'|'A'..'Z' -> 1
      | _ -> Char.compare c1 c2)

(* return the first index of x, starting from xi, of a nun-null
 * character in x.  or (length x) in case x contains only 0's starting
 * from xi on.  *)
let skip_zeros x xi xl = skip_while_from xi (fun c -> c = '0') x xl

(* compare versions chunks, that is parts of version strings that are
 * epoch, upstream version, or revisision. Alternates string comparison
 * and numerical comparison.  *)
let compare_chunks x y =
  (* x and y may be empty *)
  let xl = String.length x
  and yl = String.length y
  in
  let rec loop_lexical xi yi =
    assert ((xi : int) <= xl && (yi : int) <= yl);
    match ((xi : int) = xl, (yi : int) = yl) with (* which of x and y is exhausted? *)
      | true,true -> 0
      | true,false ->
        (* if y continues numerically than we have to continue by
         * comparing numerically. In this case the x part is
         * interpreted as 0 (since empty). If the y part consists
         * only of 0's then both parts are equal, otherwise the y
         * part is larger. If y continues non-numerically then y is
         * larger anyway, so we only have to skip 0's in the y part
         * and check whether this exhausts the y part.  *)
        let ys = skip_zeros y yi yl in
        if (ys : int) = yl then 0 else if y.[ys]='~' then 1 else -1
      | false,true -> (* symmetric to the preceding case *)
        let xs = skip_zeros x xi xl in
        if (xs : int) = xl then 0 else if x.[xs]='~' then -1 else 1
      | false,false -> (* which of x and y continues numerically? *)
        match (is_digit x.[xi], is_digit y.[yi]) with
          | true,true ->
            (* both continue numerically. Skip leading zeros in the
             * remaining parts, and then continue by
             * comparing numerically. *)
            compare_numerical (skip_zeros x xi xl) (skip_zeros y yi yl)
          | true,false -> (* '~' is smaller than any numeric part *)
            if y.[yi]='~' then 1 else -1
          | false,true -> (* '~' is smaller than any numeric part *)
            if x.[xi]='~' then -1 else 1
          | false,false -> (* continue comparing lexically *)
            let comp = compare_chars x.[xi] y.[yi]
            in if comp = 0 then loop_lexical (xi+1) (yi+1) else comp
  and compare_numerical xi yi =
    assert ((xi : int) = xl || ((xi : int) < xl && x.[xi] <> '0'));
    (* leading zeros have been stripped *)
    assert ((yi : int) = yl || ((yi : int) < yl && y.[yi] <> '0'));
    (* leading zeros have been stripped *)
    let xn = skip_while_from xi is_digit x xl (* length of numerical part *)
    and yn = skip_while_from yi is_digit y yl (* length of numerical part *)
    in
    let comp = Int.compare (xn-xi) (yn-yi)
    in if comp = 0
      then (* both numerical parts have same length: compare digit by digit *)
        loop_numerical xi yi yn
      else
        (* if one numerical part is longer than the other we have found the
         * answer since leading 0 have been striped when switching
         * to numerical comparison.  *)
        comp
  and loop_numerical xi yi yn =
    assert ((xi : int) <= xl && (yi : int) <= yn && (yn : int) <= yl);
    (* invariant: the two numerical parts that remain to compare are
       of the same length *)
    if (yi : int) = yn
    then
      (* both numerical parts are exhausted, we switch to lexical
         comparison *)
      loop_lexical xi yi
    else
      (* both numerical parts are not exhausted, we continue comparing
         digit by digit *)
      let comp = Char.compare x.[xi] y.[yi]
      in if comp = 0 then loop_numerical (xi+1) (yi+1) yn else comp
  in loop_lexical 0 0

let compare (x : string) (y : string) =
  let normalize_comp_result x = if x=0 then 0 else if x < 0 then -1 else 1
  in
  if (x : string) = y then 0
  else
    let (u1,r1) = extract_revision x
    and (u2,r2) = extract_revision y in
    let u_comp = compare_chunks u1 u2 in
    if u_comp <> 0 then normalize_comp_result u_comp
    else normalize_comp_result (compare_chunks r1 r2)

let equal (x : string) (y : string) =
  if (x : string) = y then true else (compare x y) = 0