diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss index 9e161721da..200d132aff 100644 --- a/collects/scribble/manual.ss +++ b/collects/scribble/manual.ss @@ -567,7 +567,7 @@ defidform specform specform/subs specsubform specsubform/subs specspecsubform specspecsubform/subs specsubform/inline - defsubform + defsubform defsubform* schemegrammar schemegrammar* var svar void-const undefined-const) @@ -834,6 +834,9 @@ (define-syntax (defsubform stx) (syntax-case stx () [(_ . rest) #'(into-blockquote (defform . rest))])) + (define-syntax (defsubform* stx) + (syntax-case stx () + [(_ . rest) #'(into-blockquote (defform* . rest))])) (define-syntax specsubform (syntax-rules () [(_ #:literals (lit ...) spec desc ...) diff --git a/collects/scribblings/guide/module-paths.scrbl b/collects/scribblings/guide/module-paths.scrbl index 63df84441c..4d9e35fd82 100644 --- a/collects/scribblings/guide/module-paths.scrbl +++ b/collects/scribblings/guide/module-paths.scrbl @@ -43,8 +43,8 @@ Scheme. The @filepath{.ss} suffix is added automatically. Another example of this form is @scheme[scheme], which is commonly used at the initial import. The path @scheme[scheme] is shorthand for -@scheme[scheme/main]; when the last element of the path has no suffix, -then @scheme[/main] is automatically added to the end. Thus, +@scheme[scheme/main]; when an @scheme[id] has no @litchar{/}, then +@scheme[/main] is automatically added to the end. Thus, @scheme[scheme] or @scheme[scheme/main] refers to the module whose source is the @filepath{main.ss} file in the @filepath{scheme} collection. @@ -98,6 +98,34 @@ which are all equivalent to @scheme[scheme]. (require 'm) ]} +@; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +@specsubform[#:literals (planet) + (planet id)]{ + +Accesses a third-party library that is distributed through the +@|PLaneT| server. The library is downloaded the first time that it is +needed, and then the local copy is used afterward. + +The @scheme[id] encodes several pieces of information separated by a +@litchar{/}: the package owner, then package name with optional +version information, and an optional path to a specific library with +the package. Like @scheme[id] as shorthand for a @scheme[lib] path, a +@filepath{.ss} suffix is added automatically, and @schemeidfont{/main} +is used as the path if none is supplied. + +@examples[ +(eval:alts + (module m (lib "scheme") + (code:comment #, @t{Use @filepath{schematics}'s @filepath{random.plt} 1.0, file @filepath{random.ss}:}) + (require (planet schematics/random:1/random)) + (display (random-gaussian))) + (void)) +(eval:alts + (require 'm) + (display 0.9050686838895684)) +] +} + @; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @specsubform/subs[#:literals (planet = + -) (planet rel-string (user-string pkg-string vers ...)) @@ -107,9 +135,9 @@ which are all equivalent to @scheme[scheme]. (+ nat) (- nat)])]{ -Accesses a third-party library that is distributed through the -@|PLaneT| server. A @|PLaneT| reference starts like a @scheme[lib] -reference, with a relative path, but the path is followed by +A more general form to access a library from the @|PLaneT| server. In +this general form, a @|PLaneT| reference starts like a @scheme[lib] +reference with a relative path, but the path is followed by information about the producer, package, and version of the library. The specified package is downloaded and installed on demand. diff --git a/collects/scribblings/reference/pairs.scrbl b/collects/scribblings/reference/pairs.scrbl index 321b20666e..281d81a59a 100644 --- a/collects/scribblings/reference/pairs.scrbl +++ b/collects/scribblings/reference/pairs.scrbl @@ -445,11 +445,8 @@ Like @scheme[assoc], but finds an element using the predicate @section{Additional List Functions and Synonyms} @note-lib[scheme/list] -@(begin (define list-eval (make-base-eval)) - (list-eval '(require scheme/function)) - (define-syntax list-examples - (syntax-rules () - [(_ e ...) (examples #:eval list-eval e ...)]))) +@(define list-eval (make-base-eval)) +@interaction-eval[#:eval list-eval (require scheme/list)] @defthing[empty null?]{The empty list.} @@ -481,24 +478,32 @@ Like @scheme[assoc], but finds an element using the predicate @defproc[(last [lst list?]) any]{Returns the last element of the list.} -@defproc[(drop [lst list?] [pos nonnegative-exact-integer?]) list?]{ +@defproc[(drop [lst any/c] [pos nonnegative-exact-integer?]) list?]{ Synonym for @scheme[list-tail]. } -@defproc[(take [lst list?] [pos nonnegative-exact-integer?]) list?]{ -Returns a fresh list, holding the first @scheme[pos] elements of -@scheme[lst]. An exception is raised if the list has fewer than -@scheme[pos] elements. -} +@defproc[(take [lst any/c] [pos nonnegative-exact-integer?]) list?]{ +Returns a fresh list whose elements are the first @scheme[pos] elements of +@scheme[lst]. If @scheme[lst] has fewer than +@scheme[pos] elements, the @exnraise[exn:fail:contract]. -@defproc[(append* [lst list?] ... [lsts (list/c list?)]) list?]{ +The @scheme[lst] argument need not actually be a list; @scheme[lst] +must merely start with a chain of at least @scheme[pos] pairs. + +@examples[#:eval list-eval + (take '(1 2 3 4) 2) + (take 'non-list 0) +]} + +@defproc*[([(append* [lst list?] ... [lsts (listof list?)]) list?] + [(append* [lst list?] ... [lsts list?]) any/c])]{ Like @scheme[append], but the last argument is used as a list of arguments for @scheme[append]. In other words, the relationship between @scheme[append] and @scheme[append*] is similar to the one -between @scheme[list] and @scheme[list]. +between @scheme[list] and @scheme[list*]. -@list-examples[ +@examples[#:eval list-eval (cdr (append* (map (lambda (x) (list ", " x)) '("Alpha" "Beta" "Gamma")))) ]} @@ -512,7 +517,7 @@ pairs are interior nodes, and the resulting list contains all of the non-@scheme[null] leaves of the tree in the same order as an inorder traversal. -@list-examples[ +@examples[#:eval list-eval (flatten '((a) b (c (d) . e) ())) (flatten 'a) ]} diff --git a/collects/scribblings/reference/procedures.scrbl b/collects/scribblings/reference/procedures.scrbl index 96404483ae..5345a20a61 100644 --- a/collects/scribblings/reference/procedures.scrbl +++ b/collects/scribblings/reference/procedures.scrbl @@ -350,11 +350,8 @@ applied.} @section{Additional Procedure Functions} @note-lib[scheme/function] -@(begin (define fun-eval (make-base-eval)) - (fun-eval '(require scheme/function)) - (define-syntax fun-examples - (syntax-rules () - [(_ e ...) (examples #:eval fun-eval e ...)]))) +@(define fun-eval (make-base-eval)) +@interaction-eval[#:eval fun-eval (require scheme/function)] @defproc[(negate [proc procedure?]) procedure?]{ @@ -362,48 +359,65 @@ Returns a procedure that is just like @scheme[proc], except that it returns the negation of the result. The resulting procedure has the same arity as @scheme[proc]. -@fun-examples[ +@examples[#:eval fun-eval (filter (negate symbol?) '(1 a 2 b 3 c)) ]} @defproc*[([(curry [proc procedure?]) procedure?] - [(curry [proc procedure?] [v any/c] ...+) procedure?])]{ + [(curry [proc procedure?] [v any/c] ...+) any/c])]{ -@scheme[(curry proc)] returns a procedure that is a curried version of -@scheme[proc]. When the resulting procedure is applied on an -insufficient number of arguments, it returns a procedure that expects -additional arguments. At least one such application step is required -unless the current arguments are the most that @scheme[proc] can -consume (which is always the case when @scheme[proc] consumes any -number of arguments). +Returns a procedure that is a curried version of @scheme[proc]. In the +first application of the resulting procedure, unless it is given the +maximum number of arguments that it can accept, the result is a +procedure to accept additional arguments. In other words, given a +@scheme[proc] that accepts varying number of arguments, the first +application delays as long as possible: -If additional values are provided to the @scheme[curry] call (the -second form), they are used as the first step. (This means that -@scheme[curry] itself is curried.) +@examples[#:eval fun-eval +((curry list) 1 2) +((curry cons) 1) +((curry cons) 1 2) +] -@scheme[curry] provides limited support for keyworded functions: only -the @scheme[curry] call itself can receive keyworded arguments to be -eventually handed to @scheme[proc]. +After the first application of the result of @scheme[curry], each +further application accumulates arguments until sufficiently many +arguments have been accumulated, at which point the original +@scheme[proc] is called. In other words, given a @scheme[proc] that +accepts varying numbers of arguments, later applications delay as +little as possible: -@fun-examples[ +@examples[#:eval fun-eval +(((curry list) 1 2) 3) +(((curry list) 1) 3) +((((curry foldl) +) 0) '(1 2 3)) +] + +A function call @scheme[(curry proc v ...)] is equivalent to +@scheme[((curry proc) v ...)]. In other words, @scheme[curry] itself +is curried. + +The @scheme[curry] function provides limited support for keyworded +functions: only the @scheme[curry] call itself can receive keyworded +arguments to be eventually propagated to @scheme[proc]. + +@examples[#:eval fun-eval (map ((curry +) 10) '(1 2 3)) (map (curry + 10) '(1 2 3)) (map (compose (curry * 2) (curry + 10)) '(1 2 3)) (define foo (curry (lambda (x y z) (list x y z)))) (foo 1 2 3) (((((foo) 1) 2)) 3) -] +]} -} @defproc*[([(curryr [proc procedure?]) procedure?] - [(curryr [proc procedure?] [v any/c] ...+) procedure?])]{ + [(curryr [proc procedure?] [v any/c] ...+) any/c])]{ Like @scheme[curry], except that the arguments are collected in the opposite direction: the first step collects the rightmost group of arguments, and following steps add arguments to the left of these. -@fun-examples[ +@examples[#:eval fun-eval (map (curryr list 'foo) '(1 2 3)) ] diff --git a/collects/scribblings/reference/syntax.scrbl b/collects/scribblings/reference/syntax.scrbl index 896b182311..bd57de6edf 100644 --- a/collects/scribblings/reference/syntax.scrbl +++ b/collects/scribblings/reference/syntax.scrbl @@ -1,5 +1,6 @@ #lang scribble/doc @(require "mz.ss" + scribble/bnf (for-label (only-in scheme/require-transform make-require-transformer) scheme/require-syntax @@ -1305,6 +1306,7 @@ Legal only in a @tech{module begin context}, and handled by the (lib rel-string ...+) id (file string) + (planet id) (planet rel-string (user-string pkg-string vers ...) rel-string ...)] @@ -1472,9 +1474,39 @@ corresponds to the default @tech{module name resolver}. case, but @scheme[string] is a path---possibly absolute---using the current platform's path conventions.} - @defsubform[(planet rel-string (user-string pkg-string vers ...) - rel-string ...)]{ - Specifies a library available via the @PLaneT server. The + @defsubform*[((planet id) + (planet rel-string (user-string pkg-string vers ...) + rel-string ...))]{ + + Specifies a library available via the @PLaneT server. + + The first form is a shorthand for the second, where the @scheme[id]'s + character sequence must match the following @nonterm{spec} grammar: + + @BNF[ + (list @nonterm{spec} + (BNF-seq @nonterm{owner} @litchar{/} @nonterm{pkg} @nonterm{lib})) + (list @nonterm{owner} @nonterm{elem}) + (list @nonterm{pkg} + (BNF-alt @nonterm{elem} (BNF-seq @nonterm{elem} @litchar{:} @nonterm{version}))) + (list @nonterm{version} + (BNF-alt @nonterm{int} (BNF-seq @nonterm{int} @litchar{:} @nonterm{minor}))) + (list @nonterm{minor} + (BNF-alt @nonterm{int} + (BNF-seq @litchar{<=} @nonterm{int}) + (BNF-seq @litchar{>=} @nonterm{int}) + (BNF-seq @litchar{=} @nonterm{int})) + (BNF-seq @nonterm{int} @litchar{-} @nonterm{int})) + (list @nonterm{lib} (BNF-alt @nonterm{empty} (BNF-seq @litchar{/} @nonterm{path}))) + (list @nonterm{path} (BNF-alt @nonterm{elem} (BNF-seq @nonterm{elem} @litchar{/} @nonterm{path}))) + ] + + and where an @nonterm{elem} is a non-empty sequence of characters + that are ASCII letters, ASCII digits, @litchar{-}, @litchar{+}, or + @litchar{_}, and an @nonterm{int} is a non-empty sequence of ASCII + digits. + + In the more general second form of a @scheme[planet] module path, the @scheme[rel-string]s are similar to the @scheme[lib] form, except that the @scheme[(user-string pkg-string vers ...)] names a @|PLaneT|-based package instead of a @tech{collection}.} diff --git a/collects/setup/scribble.ss b/collects/setup/scribble.ss index 30170489cb..6e90b68d46 100644 --- a/collects/setup/scribble.ss +++ b/collects/setup/scribble.ss @@ -202,7 +202,15 @@ (for ([i infos] #:when (info-need-run? i)) (set-info-need-run?! i #f) (build-again! latex-dest i with-record-error)) - (make-loop #f (add1 iter))))) + ;; If we only build 1, then it reaches it own fixpoint + ;; even if the info doesn't seem to converge immediately. + ;; This is a useful shortcut when re-building a single + ;; document. + (unless (= 1 (for/fold ([count 0]) + ([i infos] + #:when (info-build? i)) + (add1 count))) + (make-loop #f (add1 iter)))))) (when infos (make-loop #t 0) ;; cache info to disk @@ -400,6 +408,13 @@ (lambda () #f)) #f)))) +(define-syntax-rule (render-time what expr) + expr + #; + (begin + (printf "... ~a ...\n" what) + (time expr))) + (define (build-again! latex-dest info with-record-error) (define doc (info-doc info)) (define renderer (make-renderer latex-dest doc)) @@ -410,16 +425,21 @@ (doc-src-file doc) (lambda () (parameterize ([current-directory (doc-src-dir doc)]) - (let* ([v (ensure-doc-prefix (dynamic-require-doc (doc-src-file doc)) + (let* ([v (ensure-doc-prefix (render-time + "load" + (dynamic-require-doc (doc-src-file doc))) (doc-src-file doc))] [dest-dir (pick-dest latex-dest doc)] - [ci (send renderer collect (list v) (list dest-dir))]) - (for ([i (info-deps info)]) - (send renderer deserialize-info (info-sci i) ci)) - (let* ([ri (send renderer resolve (list v) (list dest-dir) ci)] - [sci (send renderer serialize-info ri)] - [defs (send renderer get-defined ci)] - [undef (send renderer get-undefined ri)] + [ci (render-time "collect" + (send renderer collect (list v) (list dest-dir)))]) + (render-time + "deserialize" + (for ([i (info-deps info)]) + (send renderer deserialize-info (info-sci i) ci))) + (let* ([ri (render-time "resolve" (send renderer resolve (list v) (list dest-dir) ci))] + [sci (render-time "serialize" (send renderer serialize-info ri))] + [defs (render-time "defined" (send renderer get-defined ci))] + [undef (render-time "undefined" (send renderer get-undefined ri))] [in-delta? (not (equal? undef (info-undef info)))] [out-delta? (not (equal? (list sci defs) (list (info-sci info) @@ -438,7 +458,8 @@ (set-info-undef! info undef) (when in-delta? (set-info-deps! info null)) ; recompute deps outside (when (or out-delta? (info-need-out-write? info)) - (unless latex-dest (write-out info)) + (unless latex-dest + (render-time "xref-out" (write-out info))) (set-info-need-out-write?! info #f)) (when in-delta? (set-info-need-in-write?! info #t)) (unless latex-dest @@ -447,10 +468,12 @@ (for ([f (directory-list dir)] #:when (regexp-match? #"[.]html$" (path-element->bytes f))) (delete-file (build-path dir f))))) - (with-record-error - (doc-src-file doc) - (lambda () (send renderer render (list v) (list dest-dir) ri)) - void) + (render-time + "render" + (with-record-error + (doc-src-file doc) + (lambda () (send renderer render (list v) (list dest-dir) ri)) + void)) (set-info-time! info (/ (current-inexact-milliseconds) 1000)) (gc-point) (void))))) diff --git a/collects/tests/mzscheme/module.ss b/collects/tests/mzscheme/module.ss index c5009988de..d50b6e4cfa 100644 --- a/collects/tests/mzscheme/module.ss +++ b/collects/tests/mzscheme/module.ss @@ -301,4 +301,92 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(test #t module-path? "hello") +(test #t module-path? "hello.ss") +(test #f module-path? "hello*ss") +(test #f module-path? "foo.ss/hello") +(test #f module-path? "foo/") +(test #f module-path? "a/foo/") +(test #f module-path? "/foo.ss") +(test #f module-path? "/a/foo.ss") +(test #f module-path? "a/foo.ss/b") +(test #t module-path? "a/_/b") +(test #t module-path? "a/0123456789+-_/b.---") +(test #t module-path? "../foo.ss") +(test #t module-path? "x/../foo.ss") +(test #t module-path? "x/./foo.ss") +(test #t module-path? "x/.") +(test #t module-path? "x/..") + +(test #t module-path? 'hello) +(test #f module-path? 'hello/) +(test #f module-path? 'hello.ss) +(test #f module-path? 'hello/a.ss) +(test #f module-path? '/hello/a.ss) +(test #f module-path? '/hello) +(test #f module-path? '/a/hello) +(test #f module-path? 'a//hello) +(test #f module-path? '../hello) +(test #f module-path? './hello) +(test #f module-path? 'a/../hello) +(test #f module-path? 'b/./hello) +(test #f module-path? 'b/*/hello) + +(test #t module-path? '(lib "hello")) +(test #f module-path? '(lib "hello/")) +(test #f module-path? '(lib "hello/../b")) +(test #t module-path? '(lib "hello/a")) +(test #t module-path? '(lib "hello/a.ss")) +(test #f module-path? '(lib "hello.bb/a.ss")) +(test #f module-path? '(lib "/hello/a.ss")) +(test #t module-path? '(lib "hello/a.ss" "ack")) +(test #t module-path? '(lib "hello/a.ss" "ack" "bar")) +(test #t module-path? '(lib "hello/a.ss" "ack/bar")) +(test #f module-path? '(lib "hello/a.ss" "ack/")) +(test #f module-path? '(lib "hello/a.ss" "ack" "/bar")) +(test #f module-path? '(lib "hello/a.ss" "ack" "..")) +(test #f module-path? '(lib "hello/a.ss" "ack" bar)) +(test #f module-path? '(lib "hello/a.ss" . bar)) +(test #f module-path? '(lib . "hello/a.ss")) +(test #f module-path? '(lib)) + +(test #f module-path? '(planet)) +(test #f module-path? '(planet robby)) +(test #t module-path? '(planet robby/redex)) +(test #f module-path? '(planet robby/redex/)) +(test #f module-path? '(planet robby/redex/foo/)) +(test #f module-path? '(planet /robby/redex/foo)) +(test #f module-path? '(planet robby/redex.plt/foo)) +(test #f module-path? '(planet robby/redex/foo.ss)) +(test #f module-path? '(planet robby/redex/foo.ss/bar)) +(test #f module-path? '(planet robby/../foo)) +(test #t module-path? '(planet robby/redex/foo)) +(test #t module-path? '(planet robby/redex/foo/bar)) +(test #t module-path? '(planet robby/redex:7/foo)) +(test #t module-path? '(planet robby/redex:7)) +(test #t module-path? '(planet robby/redex:7:8/foo)) +(test #t module-path? '(planet robby/redex:7:<=8/foo)) +(test #t module-path? '(planet robby/redex:7:>=8/foo)) +(test #t module-path? '(planet robby/redex:7:8-9/foo)) +(test #t module-path? '(planet robby/redex:7:8-9)) +(test #t module-path? '(planet robby/redex:700:800-00900/foo)) +(test #f module-path? '(planet robby/redex:=7/foo)) +(test #f module-path? '(planet robby/redex::8/foo)) +(test #f module-path? '(planet robby/redex:7:/foo)) +(test #f module-path? '(planet robby/redex.plt:7:8/foo)) +(test #f module-path? '(planet robby/redex:a/foo)) +(test #f module-path? '(planet robby/redex:7:a/foo)) +(test #f module-path? '(planet robby/redex:7:a-10/foo)) +(test #f module-path? '(planet robby/redex:7:10-a/foo)) + +(test #f module-path? '(planet "foo.ss")) +(test #t module-path? '(planet "foo.ss" ("robby" "redex.plt"))) +(test #f module-path? '(planet "../foo.ss" ("robby" "redex.plt"))) +(test #t module-path? '(planet "foo.ss" ("robby" "redex.plt" (7 8)))) +(test #t module-path? '(planet "foo.ss" ("robby" "redex.plt" 7 8))) +(test #t module-path? '(planet "foo.ss" ("robby" "redex.plt" 7 (= 8)))) +(test #t module-path? '(planet "foo.ss" ("robby" "redex.plt") "sub" "deeper")) + +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (report-errs) diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index 4d082c4f82..ea3afaa593 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -1608,10 +1608,10 @@ static Scheme_Object *namespace_unprotect_module(int argc, Scheme_Object *argv[] return scheme_void; } -static int ok_path_string(Scheme_Object *obj, int dir_ok, int just_file_ok, int file_end_ok) +static int ok_path_string(Scheme_Object *obj, int dir_ok, int just_file_ok, int file_end_ok, int for_planet) { mzchar *s = SCHEME_CHAR_STR_VAL(obj); - int i = SCHEME_CHAR_STRLEN_VAL(obj), c; + int i = SCHEME_CHAR_STRLEN_VAL(obj), c, start_package_pos = 0, end_package_pos = 0; int prev_was_slash = 0, saw_slash = !file_end_ok, saw_dot = 0; if (!i) @@ -1621,6 +1621,87 @@ static int ok_path_string(Scheme_Object *obj, int dir_ok, int just_file_ok, int if (s[i - 1] == '/') return 0; + if (for_planet) { + /* Must have at least two slashes, and a version spec is allowed between them */ + int j, counter = 0, colon1_pos = 0, colon2_pos = 0; + for (j = 0; j < i; j++) { + c = s[j]; + if (c == '/') { + counter++; + if (counter == 1) + start_package_pos = j + 1; + else if (counter == 2) + end_package_pos = j; + } else if (c == ':') { + if (counter == 1) { + if (colon2_pos) + return 0; + else if (colon1_pos) + colon2_pos = j; + else + colon1_pos = j; + } + } + } + + if (counter == 1) + end_package_pos = i; + + if (end_package_pos <= start_package_pos) + return 0; + + if (colon1_pos) { + /* Check that the version spec is well-formed, leaving the rest to the loop below */ + int colon1_end = (colon2_pos ? colon2_pos : end_package_pos); + + if (colon1_end == (colon1_pos + 1)) + return 0; + for (j = colon1_pos + 1; j < colon1_end; j++) { + c = s[j]; + if (!((c >= '0') && (c <= '9'))) + return 0; + } + + if (colon2_pos) { + colon2_pos++; + c = s[colon2_pos]; + if ((c == '<') || (c == '>')) { + if (s[colon2_pos+1] == '=') + colon2_pos += 2; + else + return 0; + } else if (c == '=') { + colon2_pos += 1; + } else { + if ((c >= '0') && (c <= '9')) { + /* check for range: */ + for (j = colon2_pos; j < end_package_pos; j++) { + if (s[j] == '-') { + colon2_pos = j + 1; + break; + } else if (!((c >= '0') && (c <= '9'))) + return 0; + } + } + } + if (end_package_pos == colon2_pos) + return 0; + + for (j = colon2_pos; j < end_package_pos; j++) { + c = s[j]; + if (!((c >= '0') && (c <= '9'))) + return 0; + } + } + + /* tell loop below to ignore the version part: */ + start_package_pos = colon1_pos; + } else { + /* package must have normal directory syntax */ + start_package_pos = end_package_pos = 0; + } + } + while (i--) { c = s[i]; if (c == '/') { @@ -1645,11 +1726,14 @@ static int ok_path_string(Scheme_Object *obj, int dir_ok, int just_file_ok, int || (c == '_') || (c == '+')) { prev_was_slash = 0; - } else + } else if ((i < start_package_pos) || (i >= end_package_pos)) return 0; + else { + prev_was_slash = 0; + } } } - + if (!just_file_ok) { if (saw_dot && !saw_slash) { /* can't have a file name with no directory */ @@ -1722,14 +1806,14 @@ static int ok_planet_string(Scheme_Object *obj) int scheme_is_module_path(Scheme_Object *obj) { if (SCHEME_CHAR_STRINGP(obj)) { - return ok_path_string(obj, 1, 1, 1); + return ok_path_string(obj, 1, 1, 1, 0); } if (SCHEME_SYMBOLP(obj)) { obj = scheme_make_sized_offset_utf8_string((char *)(obj), SCHEME_SYMSTR_OFFSET(obj), SCHEME_SYM_LEN(obj)); - return ok_path_string(obj, 0, 0, 0); + return ok_path_string(obj, 0, 0, 0, 0); } if (SCHEME_PAIRP(obj)) { @@ -1751,7 +1835,7 @@ int scheme_is_module_path(Scheme_Object *obj) while (SCHEME_PAIRP(obj)) { a = SCHEME_CAR(obj); if (SCHEME_CHAR_STRINGP(a)) { - if (!ok_path_string(a, 0, is_first, is_first)) + if (!ok_path_string(a, 0, is_first, is_first, 0)) return 0; } else return 0; @@ -1786,13 +1870,27 @@ int scheme_is_module_path(Scheme_Object *obj) Scheme_Object *a, *subs; int len; - if (scheme_proper_list_length(obj) < 3) + len = scheme_proper_list_length(obj); + + if (len == 2) { + /* Symbolic shorthand? */ + obj = SCHEME_CDR(obj); + a = SCHEME_CAR(obj); + if (SCHEME_SYMBOLP(a)) { + obj = scheme_make_sized_offset_utf8_string((char *)(a), + SCHEME_SYMSTR_OFFSET(a), + SCHEME_SYM_LEN(a)); + return ok_path_string(obj, 0, 0, 0, 1); + } + } + + if (len < 3) return 0; obj = SCHEME_CDR(obj); a = SCHEME_CAR(obj); if (!SCHEME_CHAR_STRINGP(a)) return 0; - if (!ok_path_string(a, 0, 1, 1)) + if (!ok_path_string(a, 0, 1, 1, 0)) return 0; obj = SCHEME_CDR(obj); subs = SCHEME_CDR(obj); @@ -1847,7 +1945,7 @@ int scheme_is_module_path(Scheme_Object *obj) a = SCHEME_CAR(subs); if (!SCHEME_CHAR_STRINGP(a)) return 0; - if (!ok_path_string(a, 0, 0, 0)) + if (!ok_path_string(a, 0, 0, 0, 0)) return 0; }