suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add path<?' and symbol<?'

Browse Source 
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'.
This commit is contained in:
Matthew Flatt 2013-08-10 19:33:30 -06:00
parent 2ba615a20e
commit 7c95c5ad38
13 changed files with 1103 additions and 1046 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/racket-pkgs/racket-doc/scribblings/reference/data.scrbl
View File

@ -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"]

3
pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl
View File

@ -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
@racket[path-element->bytes] and @racket[bytes<?].}
The resulting paths are always sorted using @racket[path<?].}
@defproc[(filesystem-root-list) (listof path?)]{

7
pkgs/racket-pkgs/racket-doc/scribblings/reference/paths.scrbl
View File

@ -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)]{

8
pkgs/racket-pkgs/racket-doc/scribblings/reference/symbols.scrbl
View File

@ -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<?].}

6
pkgs/racket-pkgs/racket-test/tests/racket/basic.rktl
View File

@ -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)

7
pkgs/racket-pkgs/racket-test/tests/racket/path.rktl
View File

@ -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")

3
racket/collects/racket/HISTORY.txt
View File

@ -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

3
racket/collects/racket/private/kw-file.rkt
View File

@ -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-element->bytes)])
path<?)])
(if build?
(map (lambda (i) (build-path dir i)) content)
content)))))

2050
racket/src/racket/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

2
racket/src/racket/src/schminc.h
View File

@ -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

4
racket/src/racket/src/schvers.h
View File

@ -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)

24
racket/src/racket/src/string.c
View File

@ -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])) \
scheme_wrong_contract(scheme_name, "bytes?", 0, argc, argv); \
if (!PRED(argv[0])) \
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])) \
scheme_wrong_contract(scheme_name, "bytes?", i, argc, argv); \
if (!PRED(argv[i])) \
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 */
/**********************************************************************/

29
racket/src/racket/src/symbol.c
View File

@ -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[]);
@ -333,7 +334,8 @@ 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))
scheme_wrong_contract("keyword<?", "keyword?", 0, argc, argv);
if (!SAME_TYPE(SCHEME_TYPE(prev), ty))
scheme_wrong_contract(who, contract, 0, argc, argv);
for (i = 1; i < argc; i++) {
kw = argv[i];
if (!SCHEME_KEYWORDP(kw))
scheme_wrong_contract("keyword<?", "keyword?", i, argc, argv);
if (!SAME_TYPE(SCHEME_TYPE(kw), ty))
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]))
scheme_wrong_contract("keyword<?", "keyword?", i, argc, argv);
if (!SAME_TYPE(SCHEME_TYPE(argv[i]), ty))
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[])
{