add path<?' and symbol<?'

These comparisons are useful for sorting while avoiding the overhead
of conversions to bytes or strings.

Having `path<' reduces the cost of sorting in `directory-list'.

pkgs/racket-pkgs/racket-doc/scribblings/reference/data.scrbl

@@ -68,7 +68,8 @@ Returns a keyword whose @racket[display]ed form is the same as that of
 
 Returns @racket[#t] if the arguments are sorted, where the comparison
 for each pair of keywords is the same as using
-@racket[keyword->string] and @racket[string<?].}
+@racket[keyword->string] with @racket[string->bytes/utf-8] and
+@racket[bytes<?].}
 
 @; ----------------------------------------------------------------------
 @include-section["pairs.scrbl"]

pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl

@@ -467,8 +467,7 @@ are combined with @racket[path] using @racket[build-path].
 On Windows, an element of the result list may start with
 @litchar{\\?\REL\\}.
 
-The resulting paths are always sorted using
+The resulting paths are always sorted using @racket[path<?].}
-@racket[path-element->bytes] and @racket[bytes<?].}
 
 
 @defproc[(filesystem-root-list) (listof path?)]{

pkgs/racket-pkgs/racket-doc/scribblings/reference/paths.scrbl

@@ -186,6 +186,13 @@ reassembling the result with @racket[bytes->path-element] and
 @racket[build-path]).}
 
 
+@defproc[(path<? [a-path path?] [b-path path?] ...) boolean?]{
+
+Returns @racket[#t] if the arguments are sorted, where the comparison
+for each pair of paths is the same as using
+@racket[path->bytes] and @racket[bytes<?].}
+
+
 @defproc[(path-convention-type [path path-for-some-system?])
          (or/c 'unix 'windows)]{
 

pkgs/racket-pkgs/racket-doc/scribblings/reference/symbols.scrbl

@@ -100,3 +100,11 @@ used as an ephemeron key (see @secref["ephemerons"]).
  optional @racket[base] argument is a prefix symbol or string.}
 
 @examples[(gensym "apple")]
+
+
+@defproc[(symbol<? [a-sym symbol?] [b-sym symbol?] ...) boolean?]{
+
+Returns @racket[#t] if the arguments are sorted, where the comparison
+for each pair of symbols is the same as using
+@racket[symbol->string] witk @racket[string->bytes/utf-8] and
+@racket[bytes<?].}

pkgs/racket-pkgs/racket-test/tests/racket/basic.rktl

@@ -395,6 +395,12 @@
 (test 'JollyWog string->symbol (symbol->string 'JollyWog))
 #ci(test 'JollyWog string->symbol (symbol->string 'JollyWog))
 
+(test #t symbol<? 'a 'b)
+(test #t symbol<? 'a 'b 'c)
+(test #f symbol<? 'a 'c 'b)
+(test #t symbol<? 'a 'aa)
+(test #f symbol<? 'aa 'a)
+
 (arity-test symbol? 1 1)
 
 (test #t keyword? '#:a)

pkgs/racket-pkgs/racket-test/tests/racket/path.rktl

@@ -5,6 +5,13 @@
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(test #t path<? (bytes->path #"a") (bytes->path #"b"))
+(test #f path<? (bytes->path #"b") (bytes->path #"a"))
+(test #t path<? (bytes->path #"a") (bytes->path #"b") (bytes->path #"c"))
+(test #f path<? (bytes->path #"a") (bytes->path #"c") (bytes->path #"b"))
+(test #t path<? (bytes->path #"a") (bytes->path #"aa"))
+(test #f path<? (bytes->path #"aa") (bytes->path #"a"))
+
 (test (string->path "x.zo") path-replace-suffix "x.rkt" ".zo")
 (test (string->path "x.zo") path-replace-suffix "x.rkt" #".zo")
 (test (string->path "x.zo") path-replace-suffix "x" #".zo")

racket/collects/racket/HISTORY.txt

@@ -1,3 +1,6 @@
+Version 5.90.0.6
+Added path<?, symbol<?
+
 Version 5.90.0.4
 Add current-library-collection-links, find-library-collection-links
 Changed module search to use current-library-collection-paths

racket/collects/racket/private/kw-file.rkt

@@ -138,8 +138,7 @@
       (unless (path-string? dir)
         (raise-argument-error 'directory-list "path-string?" dir))
       (let ([content (sort (k:directory-list dir)
-                           bytes<?
+                           path<?)])
-                           path-element->bytes)])
         (if build?
             (map (lambda (i) (build-path dir i)) content)
             content)))))

racket/src/racket/src/schminc.h

@@ -14,7 +14,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1110
+#define EXPECTED_PRIM_COUNT 1112
 #define EXPECTED_UNSAFE_COUNT 100
 #define EXPECTED_FLFXNUM_COUNT 69
 #define EXPECTED_EXTFL_COUNT 45

racket/src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "5.90.0.5"
+#define MZSCHEME_VERSION "5.90.0.6"
 
 #define MZSCHEME_VERSION_X 5
 #define MZSCHEME_VERSION_Y 90
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 5
+#define MZSCHEME_VERSION_W 6
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

racket/src/racket/src/string.c

@@ -325,6 +325,8 @@ static Scheme_Object *byte_string_convert(int argc, Scheme_Object *argv[]);
 static Scheme_Object *byte_string_convert_end(int argc, Scheme_Object *argv[]);
 static Scheme_Object *byte_converter_p(int argc, Scheme_Object *argv[]);
 
+static Scheme_Object *path_lt (int argc, Scheme_Object *argv[]);
+
 #ifdef MZ_PRECISE_GC
 static void register_traversers(void);
 #endif
@@ -950,6 +952,13 @@ scheme_init_string (Scheme_Env *env)
 						       MZCONFIG_CMDLINE_ARGS),
 			     env);
 
+
+  scheme_add_global_constant("path<?",
+			     scheme_make_immed_prim(path_lt,
+						    "path<?",
+						    2, -1),
+			     env);
+
 #ifdef MZ_PRECISE_GC
   register_traversers();
 #endif
@@ -1210,15 +1219,15 @@ byte_p(int argc, Scheme_Object *argv[])
 
 /* comparisons */
 
-#define GEN_BYTE_STRING_COMP(name, scheme_name, comp, op) \
+#define GEN_BYTE_STRING_PATH_COMP(name, scheme_name, comp, op, PRED, contract)     \
 static Scheme_Object * name (int argc, Scheme_Object *argv[]) \
 {  char *s, *prev; int i, sl, pl; int falz = 0;\
-   if (!SCHEME_BYTE_STRINGP(argv[0])) \
+  if (!PRED(argv[0])) \
-    scheme_wrong_contract(scheme_name, "bytes?", 0, argc, argv); \
+    scheme_wrong_contract(scheme_name, contract, 0, argc, argv); \
    prev = SCHEME_BYTE_STR_VAL(argv[0]); pl = SCHEME_BYTE_STRTAG_VAL(argv[0]); \
    for (i = 1; i < argc; i++) { \
-     if (!SCHEME_BYTE_STRINGP(argv[i])) \
+     if (!PRED(argv[i])) \
-      scheme_wrong_contract(scheme_name, "bytes?", i, argc, argv); \
+      scheme_wrong_contract(scheme_name, contract, i, argc, argv); \
      s = SCHEME_BYTE_STR_VAL(argv[i]); sl = SCHEME_BYTE_STRTAG_VAL(argv[i]); \
      if (!falz) if (!(comp(scheme_name, \
                            (unsigned char *)prev, pl, \
@@ -1228,10 +1237,15 @@ static Scheme_Object * name (int argc, Scheme_Object *argv[]) \
   return falz ? scheme_false : scheme_true; \
 }
 
+#define GEN_BYTE_STRING_COMP(name, scheme_name, comp, op) \
+  GEN_BYTE_STRING_PATH_COMP(name, scheme_name, comp, op, SCHEME_BYTE_STRINGP, "bytes?") \
+
 GEN_BYTE_STRING_COMP(byte_string_eq, "bytes=?", mz_strcmp, ==)
 GEN_BYTE_STRING_COMP(byte_string_lt, "bytes<?", mz_strcmp, <)
 GEN_BYTE_STRING_COMP(byte_string_gt, "bytes>?", mz_strcmp, >)
 
+GEN_BYTE_STRING_PATH_COMP(path_lt, "path<?", mz_strcmp, <, SCHEME_PATHP, "path?")
+
 /**********************************************************************/
 /*                   byte string <-> char string                      */
 /**********************************************************************/

racket/src/racket/src/symbol.c

@@ -66,6 +66,7 @@ THREAD_LOCAL_DECL(static int gensym_counter);
 void scheme_set_case_sensitive(int v) { scheme_case_sensitive =  v; }
 
 /* locals */
+static Scheme_Object *symbol_lt (int argc, Scheme_Object *argv[]);
 static Scheme_Object *symbol_p_prim (int argc, Scheme_Object *argv[]);
 static Scheme_Object *symbol_unreadable_p_prim (int argc, Scheme_Object *argv[]);
 static Scheme_Object *symbol_interned_p_prim (int argc, Scheme_Object *argv[]);
@@ -334,6 +335,7 @@ scheme_init_symbol (Scheme_Env *env)
   p = scheme_make_folding_prim(symbol_interned_p_prim, "symbol-interned?", 1, 1, 1);
   scheme_add_global_constant("symbol-interned?", p, env);
 
+  GLOBAL_FOLDING_PRIM("symbol<?",                 symbol_lt,                       2, -1, 1, env);  
   GLOBAL_IMMED_PRIM("string->symbol",             string_to_symbol_prim,            1, 1, env);
   GLOBAL_IMMED_PRIM("string->uninterned-symbol",  string_to_uninterned_symbol_prim, 1, 1, env);
   GLOBAL_IMMED_PRIM("string->unreadable-symbol",  string_to_unreadable_symbol_prim, 1, 1, env);
@@ -842,19 +844,20 @@ keyword_p_prim (int argc, Scheme_Object *argv[])
   return SCHEME_KEYWORDP(argv[0]) ? scheme_true : scheme_false;
 }
 
-static Scheme_Object *keyword_lt (int argc, Scheme_Object *argv[])
+static Scheme_Object *symkey_lt (const char *who, Scheme_Type ty, const char *contract,
+                                  int argc, Scheme_Object *argv[])
 {
   Scheme_Object *prev = argv[0], *kw;
   GC_CAN_IGNORE unsigned char *a, *b;
   int i, al, bl, t;
 
-  if (!SCHEME_KEYWORDP(prev))
+  if (!SAME_TYPE(SCHEME_TYPE(prev), ty))
-    scheme_wrong_contract("keyword<?", "keyword?", 0, argc, argv);
+    scheme_wrong_contract(who, contract, 0, argc, argv);
 
   for (i = 1; i < argc; i++) {
     kw = argv[i];
-    if (!SCHEME_KEYWORDP(kw))
+    if (!SAME_TYPE(SCHEME_TYPE(kw), ty))
-      scheme_wrong_contract("keyword<?", "keyword?", i, argc, argv);
+      scheme_wrong_contract(who, contract, i, argc, argv);
 
     a = (unsigned char *)SCHEME_SYM_VAL(prev);
     al = SCHEME_SYM_LEN(prev);
@@ -879,8 +882,8 @@ static Scheme_Object *keyword_lt (int argc, Scheme_Object *argv[])
     if (al >= bl) {
       /* Check remaining types */
       for (i++; i < argc; i++) {
-        if (!SCHEME_KEYWORDP(argv[i]))
+        if (!SAME_TYPE(SCHEME_TYPE(argv[i]), ty))
-          scheme_wrong_contract("keyword<?", "keyword?", i, argc, argv);
+          scheme_wrong_contract(who, contract, i, argc, argv);
       }
       return scheme_false;
     }
@@ -891,6 +894,16 @@ static Scheme_Object *keyword_lt (int argc, Scheme_Object *argv[])
   return scheme_true;
 }
 
+static Scheme_Object *keyword_lt (int argc, Scheme_Object *argv[])
+{
+  return symkey_lt("keyword<?", scheme_keyword_type, "keyword?", argc, argv);
+}
+
+static Scheme_Object *symbol_lt (int argc, Scheme_Object *argv[])
+{
+  return symkey_lt("symbol<?", scheme_symbol_type, "symbol?", argc, argv);
+}
+
 static Scheme_Object *
 string_to_keyword_prim (int argc, Scheme_Object *argv[])
 {