T5088: add lexical_numeric_compare function

3 files changed, 86 insertions, 0 deletions

diff --git a/src/lexical_numeric_compare.c b/src/lexical_numeric_compare.c
new file mode 100644
index 0000000..e1395d7
--- /dev/null
+++ b/src/lexical_numeric_compare.c
@@ -0,0 +1,79 @@
+/*
+ * lexicographical-numeric compare
+ */
+#include <string.h>
+#include <ctype.h>
+#include <caml/mlvalues.h>
+#include <caml/fail.h>
+
+CAMLprim value caml_lex_numeric_compare(value str1, value str2) {
+    const char* inconsistent = "internal indexing error";
+    mlsize_t len, len1, len2;
+    int pos, pos1, pos2;
+    const char * s1, * s2;
+    const char * p1, * p2;
+    int n1, n2;
+    int res;
+
+    if (str1 == str2) return Val_int(0);
+    len1 = caml_string_length(str1);
+    len2 = caml_string_length(str2);
+    len = len1 <= len2 ? len1 : len2;
+    s1 = String_val(str1);
+    s2 = String_val(str2);
+    p1 = s1;
+    p2 = s2;
+    pos = 0;
+
+    do {
+        while ((pos < len) && (!isdigit(*s1) || !isdigit(*s2))) {
+            s1++;
+            s2++;
+            pos++;
+        }
+        if (pos > 0) {
+            res = memcmp(p1, p2, pos);
+            if (res < 0) return Val_int(-1);
+            if (res > 0) return Val_int(1);
+            if (pos == len) {
+                if (len1 < len2) return Val_int(-1);
+                if (len2 < len1) return Val_int(1);
+                return Val_int(0);
+            }
+        }
+        p1 = s1;
+        p2 = s2;
+        len = len - pos;
+        len1 = len1 - pos;
+        len2 = len2 - pos;
+        pos1 = pos2 = 0;
+        n1 = n2 = 0;
+        while ((pos1 < len1) && isdigit(*s1)) {
+            n1 = n1 * 10 + *s1 - '0';
+            s1++;
+            pos1++;
+        }
+        while ((pos2 < len2) && isdigit(*s2)) {
+            n2 = n2 * 10 + *s2 - '0';
+            s2++;
+            pos2++;
+        }
+        if (n1 < n2) return Val_int(-1);
+        if (n2 < n1) return Val_int(1);
+        if ((pos1 == len1) || (pos2 == len2)) {
+            if (len1 < len2) return Val_int(-1);
+            if (len2 < len1) return Val_int(1);
+            return Val_int(0);
+
+        }
+        // if here, pos1 == pos2, or something is horribly wrong
+        if (pos1 != pos2) caml_failwith(inconsistent);
+        pos = pos1;
+        p1 = s1;
+        p2 = s2;
+        len = len - pos;
+        len1 = len1 - pos;
+        len2 = len2 - pos;
+        pos = 0;
+    } while (*s1 && *s2);
+}
diff --git a/src/util.ml b/src/util.ml
index 10e7a25..bb30645 100644
--- a/src/util.ml
+++ b/src/util.ml
@@ -1,5 +1,7 @@
 exception Syntax_error of ((int * int) option * string)
 
+external lex_numeric_compare: string -> string -> int = "caml_lex_numeric_compare"
+
 external length : string -> int = "%string_length"
 external unsafe_get : string -> int -> char = "%string_unsafe_get"
 
@@ -29,3 +31,6 @@ let default default_value opt =
   match opt with
   | None -> default_value
   | Some value -> value
+
+let lexical_numeric_compare s t =
+    lex_numeric_compare s t
diff --git a/src/util.mli b/src/util.mli
index 7254fe1..f51adb1 100644
--- a/src/util.mli
+++ b/src/util.mli
@@ -5,3 +5,5 @@ val get_lexing_position : Lexing.lexbuf -> int * int
 val escape_string : string -> string
 
 val default : 'a -> 'a option -> 'a
+
+val lexical_numeric_compare : string -> string -> int