diff options
author | John Estabrook <jestabro@vyos.io> | 2023-03-23 13:41:32 -0500 |
---|---|---|
committer | GitHub <noreply@github.com> | 2023-03-23 13:41:32 -0500 |
commit | 334819524a78c920b0184f6f6a99daabf57c520e (patch) | |
tree | 61a6852ce28d015084bf6fa352cb2f3050f6e1de | |
parent | fd8bdc522481e2562c714601fc85298ce13b3de1 (diff) | |
parent | 6c34f11f04b478431f68819438d653e329ac0cb7 (diff) | |
download | vyos1x-config-334819524a78c920b0184f6f6a99daabf57c520e.tar.gz vyos1x-config-334819524a78c920b0184f6f6a99daabf57c520e.zip |
Merge pull request #14 from jestabro/lexical_numeric
T5088: add lexical_numeric_compare function
-rw-r--r-- | dune-project | 2 | ||||
-rw-r--r-- | src/dune | 5 | ||||
-rw-r--r-- | src/lexical_numeric_compare.c | 79 | ||||
-rw-r--r-- | src/util.ml | 5 | ||||
-rw-r--r-- | src/util.mli | 2 |
5 files changed, 91 insertions, 2 deletions
diff --git a/dune-project b/dune-project index 26da116..fab305c 100644 --- a/dune-project +++ b/dune-project @@ -1,3 +1,3 @@ -(lang dune 1.9) +(lang dune 2.0) (using menhir 2.0) (name vyos1x-config) @@ -7,4 +7,7 @@ (name vyos1x) (public_name vyos1x-config) (libraries yojson menhirLib) - (preprocess (pps ppx_deriving_yojson))) + (preprocess (pps ppx_deriving_yojson)) + (foreign_stubs + (language c) + (names lexical_numeric_compare))) 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 |