change module-path? for planet path shorthand; doc edits
svn: r9048
This commit is contained in:
Matthew Flatt
parent
3b1d5169f9
commit
34d83b3551
|
|
@ -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 ...)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
]}
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
]
|
||||
|
||||
|
|
|
|||
|
|
@ -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}.}
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user