change the way Scribble generates keys based on modules
svn: r10170
This commit is contained in:
Matthew Flatt
parent
a33a97de59
commit
21fd7b93b3
|
|
@ -183,7 +183,9 @@
|
|||
(let ([s (path->string p)])
|
||||
;; this is the same check that setup/setup-unit is doing in
|
||||
;; `make-cc*'
|
||||
(unless (or (regexp-match? #rx"^[.]" s) (equal? "compiled" s)
|
||||
(unless (or (regexp-match? #rx"^[.]" s)
|
||||
(equal? "compiled" s)
|
||||
(equal? "doc" s)
|
||||
(and (pair? omit-paths) (member s omit-paths)))
|
||||
(let ([p (build-path dir p)])
|
||||
(compile-directory p (get-info/full p)))))))))
|
||||
|
|
|
|||
|
|
@ -394,12 +394,8 @@
|
|||
(and (checker id) lib)))
|
||||
(or source-libs null))
|
||||
(and (pair? libs) (car libs)))])
|
||||
(and lib (let ([p (resolved-module-path-name
|
||||
(module-path-index-resolve
|
||||
(module-path-index-join lib #f)))])
|
||||
(if (path? p)
|
||||
(intern-taglet (path->main-collects-relative p))
|
||||
p)))))
|
||||
(and lib (module-path-index->taglet
|
||||
(module-path-index-join lib #f)))))
|
||||
|
||||
(define (id-to-target-maker id dep?)
|
||||
(*id-to-target-maker 'def id dep?))
|
||||
|
|
@ -452,10 +448,8 @@
|
|||
(lambda () (car content))))))
|
||||
|
||||
(define (make-binding-redirect-elements mod-path redirects)
|
||||
(let ([taglet (path->main-collects-relative
|
||||
(resolved-module-path-name
|
||||
(module-path-index-resolve
|
||||
(module-path-index-join mod-path #f))))])
|
||||
(let ([taglet (module-path-index->taglet
|
||||
(module-path-index-join mod-path #f))])
|
||||
(make-element
|
||||
#f
|
||||
(map
|
||||
|
|
@ -1980,11 +1974,7 @@
|
|||
(define (id-info id)
|
||||
(let ([b (identifier-label-binding id)])
|
||||
(if b
|
||||
(list (let ([p (resolved-module-path-name (module-path-index-resolve
|
||||
(caddr b)))])
|
||||
(if (path? p)
|
||||
(intern-taglet (path->main-collects-relative p))
|
||||
p))
|
||||
(list (caddr b)
|
||||
(list-ref b 3)
|
||||
(list-ref b 4)
|
||||
(list-ref b 5)
|
||||
|
|
|
|||
|
|
@ -77,7 +77,7 @@
|
|||
(let* ([key (and id-element-cache
|
||||
(let ([b (identifier-label-binding c)])
|
||||
(vector (syntax-e c)
|
||||
(module-path-index-resolve (caddr b))
|
||||
(module-path-index->taglet (caddr b))
|
||||
(cadddr b)
|
||||
(list-ref b 5))))])
|
||||
(or (and key
|
||||
|
|
|
|||
|
|
@ -2,10 +2,16 @@
|
|||
(require "struct.ss"
|
||||
"basic.ss"
|
||||
setup/main-collects
|
||||
syntax/modcode)
|
||||
syntax/modcode
|
||||
syntax/modcollapse
|
||||
|
||||
;; Needed to normalize planet version numbers:
|
||||
(only-in planet/resolver get-planet-module-path/pkg)
|
||||
(only-in planet/private/data pkg-maj pkg-min))
|
||||
|
||||
(provide find-scheme-tag
|
||||
intern-taglet)
|
||||
intern-taglet
|
||||
module-path-index->taglet)
|
||||
|
||||
(define module-info-cache (make-hasheq))
|
||||
|
||||
|
|
@ -34,7 +40,35 @@
|
|||
(hash-set! interned v (make-weak-box v))
|
||||
v)))
|
||||
v)))
|
||||
|
||||
|
||||
(define (module-path-index->taglet mod)
|
||||
;; Derive the name from the module path:
|
||||
(let ([p (collapse-module-path-index
|
||||
mod
|
||||
(current-directory))])
|
||||
(if (path? p)
|
||||
;; If we got a path back anyway, then it's best to use the resolved
|
||||
;; name; if the current directory has changed since we
|
||||
;; the path-index was resolved, then p might not be right
|
||||
(intern-taglet
|
||||
(path->main-collects-relative
|
||||
(resolved-module-path-name (module-path-index-resolve mod))))
|
||||
(let ([p (if (and (pair? p)
|
||||
(eq? (car p) 'planet))
|
||||
;; Normalize planet verion number based on current
|
||||
;; linking:
|
||||
(let-values ([(path pkg)
|
||||
(get-planet-module-path/pkg p #f #f)])
|
||||
(list* 'planet
|
||||
(cadr p)
|
||||
(list (car (caddr p))
|
||||
(cadr (caddr p))
|
||||
(pkg-maj pkg)
|
||||
(pkg-min pkg))
|
||||
(cdddr p)))
|
||||
;; Otherwise the path is fully normalized:
|
||||
p)])
|
||||
(intern-taglet p)))))
|
||||
|
||||
(define (find-scheme-tag part ri stx/binding phase-level)
|
||||
;; The phase-level argument is used only when `stx/binding'
|
||||
|
|
@ -59,22 +93,19 @@
|
|||
stx/binding]
|
||||
[else
|
||||
(and (not (symbol? (car stx/binding)))
|
||||
(let ([p (module-path-index-join
|
||||
(main-collects-relative->path (car stx/binding))
|
||||
#f)])
|
||||
(list #f
|
||||
(cadr stx/binding)
|
||||
p
|
||||
(cadr stx/binding)
|
||||
(if (= 2 (length stx/binding))
|
||||
0
|
||||
(caddr stx/binding))
|
||||
(if (= 2 (length stx/binding))
|
||||
0
|
||||
(cadddr stx/binding))
|
||||
(if (= 2 (length stx/binding))
|
||||
0
|
||||
(cadddr (cdr stx/binding))))))])])
|
||||
(list #f
|
||||
(cadr stx/binding)
|
||||
(car stx/binding)
|
||||
(cadr stx/binding)
|
||||
(if (= 2 (length stx/binding))
|
||||
0
|
||||
(caddr stx/binding))
|
||||
(if (= 2 (length stx/binding))
|
||||
0
|
||||
(cadddr stx/binding))
|
||||
(if (= 2 (length stx/binding))
|
||||
0
|
||||
(cadddr (cdr stx/binding)))))])])
|
||||
(and
|
||||
(pair? b)
|
||||
(let ([seen (make-hasheq)]
|
||||
|
|
@ -96,10 +127,7 @@
|
|||
[queue (cdr queue)])
|
||||
(let* ([rmp (module-path-index-resolve mod)]
|
||||
[eb (and (equal? 0 export-phase) ;; look for the phase-0 export; good idea?
|
||||
(list (let ([p (resolved-module-path-name rmp)])
|
||||
(if (path? p)
|
||||
(intern-taglet (path->main-collects-relative p))
|
||||
p))
|
||||
(list (module-path-index->taglet mod)
|
||||
id))])
|
||||
(when (and eb
|
||||
(not search-key))
|
||||
|
|
|
|||
|
|
@ -104,25 +104,14 @@
|
|||
(= 2 (length id/binding)))
|
||||
(let loop ([src (car id/binding)])
|
||||
(cond
|
||||
[(path? src)
|
||||
(if (complete-path? src)
|
||||
(search (list src (cadr id/binding)))
|
||||
(loop (path->complete-path src)))]
|
||||
[(path-string? src)
|
||||
(loop (path->complete-path src))]
|
||||
[(resolved-module-path? src)
|
||||
(let ([n (resolved-module-path-name src)])
|
||||
(if (pair? n)
|
||||
(loop n)
|
||||
(search n)))]
|
||||
[(module-path-index? src)
|
||||
(loop (module-path-index-resolve src))]
|
||||
[(module-path? src)
|
||||
(loop (module-path-index-join src #f))]
|
||||
[else
|
||||
(raise-type-error 'xref-binding-definition->tag
|
||||
"list starting with module path, resolved module path, module path index, path, or string"
|
||||
src)]))]
|
||||
[(module-path-index? src)
|
||||
(search src)]
|
||||
[(module-path? src)
|
||||
(loop (module-path-index-join src #f))]
|
||||
[else
|
||||
(raise-type-error 'xref-binding-definition->tag
|
||||
"list starting with module path or module path index"
|
||||
src)]))]
|
||||
[else (raise-type-error 'xref-binding-definition->tag
|
||||
"identifier, 2-element list, or 7-element list"
|
||||
id/binding)]))]))
|
||||
|
|
|
|||
|
|
@ -206,16 +206,19 @@ Legal only in a @tech{module begin context}, and handled by the
|
|||
(planet id)
|
||||
(planet string)
|
||||
(planet rel-string
|
||||
(user-string pkg-string vers ...)
|
||||
(user-string pkg-string vers)
|
||||
rel-string ...)]
|
||||
[id-maybe-renamed id
|
||||
[orig-id bind-id]]
|
||||
[phase-level exact-integer #f]
|
||||
[vers nat
|
||||
(nat nat)
|
||||
(= nat)
|
||||
(+ nat)
|
||||
(- nat)])]{
|
||||
[vers code:blank
|
||||
nat
|
||||
(code:line nat minor-vers)]
|
||||
[minor-vers nat
|
||||
(nat nat)
|
||||
((unsyntax (schemeidfont "=")) nat)
|
||||
((unsyntax (schemeidfont "+")) nat)
|
||||
((unsyntax (schemeidfont "-")) nat)])]{
|
||||
|
||||
In a @tech{top-level context}, @scheme[require] instantiates modules
|
||||
(see @secref["module-eval-model"]). In a @tech{module context},
|
||||
|
|
@ -374,7 +377,7 @@ corresponds to the default @tech{module name resolver}.
|
|||
|
||||
@defsubform*[((planet id)
|
||||
(planet string)
|
||||
(planet rel-string (user-string pkg-string vers ...)
|
||||
(planet rel-string (user-string pkg-string vers)
|
||||
rel-string ...))]{
|
||||
|
||||
Specifies a library available via the @PLaneT server.
|
||||
|
|
@ -415,8 +418,18 @@ corresponds to the default @tech{module name resolver}.
|
|||
|
||||
In the more general last 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}.}
|
||||
that the @scheme[(user-string pkg-string vers)] names a
|
||||
@|PLaneT|-based package instead of a @tech{collection}. A version
|
||||
specification can include an optional major and minor version, where
|
||||
the minor version can be a specific number or a constraint:
|
||||
@scheme[(_nat _nat)] specifies an inclusive range, @scheme[((unsyntax
|
||||
(schemeidfont "=")) _nat)] specifies an exact match,
|
||||
@scheme[((unsyntax (schemeidfont "+")) _nat)] specifies a minimum
|
||||
version and is equivalent to just @scheme[_nat], and
|
||||
@scheme[((unsyntax (schemeidfont "-")) _nat)] specifies a maximum
|
||||
version. The @schemeidfont{=}, @schemeidfont{+}, and @schemeidfont{-}
|
||||
identifiers in a minor-version constraint are recognized
|
||||
symbolically.}
|
||||
|
||||
No identifier can be bound multiple times in a given @tech{phase
|
||||
level} by an import, unless all of the bindings refer to the same
|
||||
|
|
|
|||
|
|
@ -46,9 +46,7 @@ get all cross-reference information for installed documentation.}
|
|||
@defproc[(xref-binding->definition-tag [xref xref?]
|
||||
[binding (or/c identifier?
|
||||
(list/c (or/c module-path?
|
||||
module-path-index?
|
||||
path?
|
||||
resolved-module-path?)
|
||||
module-path-index?)
|
||||
symbol?)
|
||||
(listof module-path-index?
|
||||
symbol?
|
||||
|
|
|
|||
|
|
@ -675,8 +675,8 @@ for making @filepath{.plt} archives:}
|
|||
Returns @scheme[#t] unless @scheme[p], after stripping its
|
||||
directory path and converting to a byte string, matches one of the
|
||||
following regular expressions: @litchar{^CVS$}, @litchar{^[.]svn$},
|
||||
@litchar{^[.]cvsignore}, @litchar{^compiled$}, @litchar{~$}, @litchar{^#.*#$},
|
||||
@litchar{^[.]#}, or @litchar{[.]plt$}.}
|
||||
@litchar{^[.]cvsignore}, @litchar{^compiled$}, @litchar{^doc},
|
||||
@litchar{~$}, @litchar{^#.*#$}, @litchar{^[.]#}, or @litchar{[.]plt$}.}
|
||||
|
||||
@defproc[(mztar (path path-string?)
|
||||
(output output-port?)
|
||||
|
|
|
|||
|
|
@ -178,7 +178,7 @@
|
|||
(define (std-filter path)
|
||||
(let-values ([(base name dir?) (split-path path)])
|
||||
(let ([name (path->bytes name)])
|
||||
(not (or (regexp-match #rx#"^(?:CVS|[.]svn|[.]cvsignore|compiled)$"
|
||||
(not (or (regexp-match #rx#"^(?:CVS|[.]svn|[.]cvsignore|compiled|doc)$"
|
||||
name)
|
||||
(regexp-match #rx#"~$|^#.*#$|^[.]#" name)
|
||||
(regexp-match #rx#"[.]plt$" name))))))
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@
|
|||
|
||||
(define verbose (make-parameter #t))
|
||||
|
||||
(define-struct doc (src-dir src-file dest-dir flags under-main? category))
|
||||
(define-struct doc (src-dir src-spec src-file dest-dir flags under-main? category))
|
||||
(define-struct info (doc sci provides undef searches deps
|
||||
build? time out-time need-run?
|
||||
need-in-write? need-out-write?
|
||||
|
|
@ -55,7 +55,7 @@
|
|||
(define (scribblings-flag? sym)
|
||||
(memq sym '(main-doc main-doc-root user-doc-root user-doc multi-page
|
||||
depends-all depends-all-main no-depend-on always-run)))
|
||||
(define (validate-scribblings-infos infos dir)
|
||||
(define (validate-scribblings-infos infos)
|
||||
(define (validate path [flags '()] [cat '(library)] [name #f])
|
||||
(and (string? path) (relative-path? path)
|
||||
(list? flags) (andmap scribblings-flag? flags)
|
||||
|
|
@ -74,8 +74,9 @@
|
|||
(apply validate i)))
|
||||
infos)])
|
||||
(and (not (memq #f infos)) infos))))
|
||||
(define (get-docs i dir)
|
||||
(let ([s (validate-scribblings-infos (i 'scribblings) dir)])
|
||||
(define (get-docs i rec)
|
||||
(let ([s (validate-scribblings-infos (i 'scribblings))]
|
||||
[dir (directory-record-path rec)])
|
||||
(if s
|
||||
(map (lambda (d)
|
||||
(let* ([flags (cadr d)]
|
||||
|
|
@ -86,6 +87,14 @@
|
|||
(or (memq 'main-doc flags)
|
||||
(pair? (path->main-collects-relative dir))))])
|
||||
(make-doc dir
|
||||
(let ([spec (directory-record-spec rec)])
|
||||
(list* (car spec)
|
||||
(car d)
|
||||
(if (eq? 'planet (car spec))
|
||||
(list (append (cdr spec)
|
||||
(list (directory-record-maj rec)
|
||||
(list '= (directory-record-min rec)))))
|
||||
(cdr spec))))
|
||||
(build-path dir (car d))
|
||||
(doc-path dir (cadddr d) flags)
|
||||
flags under-main? (caddr d))))
|
||||
|
|
@ -95,9 +104,9 @@
|
|||
"bad 'scribblings info: ~e from: ~e" (i 'scribblings) dir)
|
||||
null))))
|
||||
(define docs
|
||||
(let* ([dirs (find-relevant-directories '(scribblings))]
|
||||
[infos (map get-info/full dirs)])
|
||||
(filter-user-docs (append-map get-docs infos dirs) make-user?)))
|
||||
(let* ([recs (find-relevant-directory-records '(scribblings) 'all-available)]
|
||||
[infos (map get-info/full (map directory-record-path recs))])
|
||||
(filter-user-docs (append-map get-docs infos recs) make-user?)))
|
||||
(define-values (main-docs user-docs) (partition doc-under-main? docs))
|
||||
(define (can-build*? docs) (can-build? only-dirs docs))
|
||||
(define auto-main? (and auto-start-doc? (ormap can-build*? main-docs)))
|
||||
|
|
@ -396,7 +405,7 @@
|
|||
(lambda ()
|
||||
(parameterize ([current-directory (doc-src-dir doc)])
|
||||
(let* ([v (ensure-doc-prefix
|
||||
(dynamic-require-doc (doc-src-file doc))
|
||||
(dynamic-require-doc (doc-src-spec doc))
|
||||
(doc-src-file doc))]
|
||||
[dest-dir (pick-dest latex-dest doc)]
|
||||
[ci (send renderer collect (list v) (list dest-dir))]
|
||||
|
|
@ -459,7 +468,7 @@
|
|||
(parameterize ([current-directory (doc-src-dir doc)])
|
||||
(let* ([v (ensure-doc-prefix (render-time
|
||||
"load"
|
||||
(dynamic-require-doc (doc-src-file doc)))
|
||||
(dynamic-require-doc (doc-src-spec doc)))
|
||||
(doc-src-file doc))]
|
||||
[dest-dir (pick-dest latex-dest doc)]
|
||||
[ci (render-time "collect"
|
||||
|
|
@ -524,7 +533,7 @@
|
|||
(parameterize ([current-namespace (namespace-anchor->empty-namespace anchor)])
|
||||
(thunk)))
|
||||
|
||||
(define (dynamic-require-doc path)
|
||||
(define (dynamic-require-doc mod-path)
|
||||
;; Use a separate namespace so that we don't end up with all the
|
||||
;; documentation loaded at once.
|
||||
;; Use a custodian to compensate for examples executed during the build
|
||||
|
|
@ -540,7 +549,7 @@
|
|||
;; hard-wiring the "manual.ss" library:
|
||||
(namespace-attach-module ns 'scribble/manual p)
|
||||
(parameterize ([current-namespace p])
|
||||
(call-in-nested-thread (lambda () (dynamic-require path 'doc)))))))
|
||||
(call-in-nested-thread (lambda () (dynamic-require mod-path 'doc)))))))
|
||||
|
||||
(define (write- info name sel)
|
||||
(let* ([doc (info-doc info)]
|
||||
|
|
|
|||
|
|
@ -187,7 +187,9 @@
|
|||
"ignoring `compile-subcollections' entry in info ~a\n"
|
||||
path-name))
|
||||
;; this check is also done in compiler/compiler-unit, in compile-directory
|
||||
(and (not (or (regexp-match? #rx"^[.]" basename) (equal? "compiled" basename)
|
||||
(and (not (or (regexp-match? #rx"^[.]" basename)
|
||||
(equal? "compiled" basename)
|
||||
(equal? "doc" basename)
|
||||
(eq? 'all (info 'compile-omit-paths void))))
|
||||
(make-cc collection path
|
||||
(if name (string-append path-name " (" name ")") path-name)
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@
|
|||
(define cached-xref #f)
|
||||
|
||||
(define (get-dests)
|
||||
(for*/list ([dir (find-relevant-directories '(scribblings))]
|
||||
(for*/list ([dir (find-relevant-directories '(scribblings) 'all-available)]
|
||||
[d ((get-info/full dir) 'scribblings)])
|
||||
(unless (and (list? d) (pair? d))
|
||||
(error 'xref "bad scribblings entry: ~e" d))
|
||||
|
|
|
|||
|
|
@ -1,7 +1,9 @@
|
|||
|
||||
(module modcollapse mzscheme
|
||||
(require mzlib/list
|
||||
scheme/string
|
||||
mzlib/contract
|
||||
(only scheme/base regexp-split)
|
||||
"private/modhelp.ss")
|
||||
|
||||
(define (collapse-module-path s relto-mp)
|
||||
|
|
@ -100,23 +102,94 @@
|
|||
(loop s2))))])
|
||||
(let ([m (regexp-match #rx"^(.*)/([^/]*)$" simpler)])
|
||||
(if m
|
||||
`(lib ,(caddr m) ,(cadr m))
|
||||
(normalize-lib `(lib ,(caddr m) ,(cadr m)))
|
||||
(error 'combine-relative-elements
|
||||
"relative path escapes collection: ~s relative to ~s"
|
||||
elements relto-mp))))))]
|
||||
[(eq? (car relto-mp) 'planet)
|
||||
(let ([pathstr (attach-to-relative-path-string
|
||||
elements (cadr relto-mp))])
|
||||
`(planet ,pathstr ,(caddr relto-mp)))]
|
||||
(normalize-planet `(planet ,pathstr ,(caddr relto-mp))))]
|
||||
[else (error 'combine-relative-elements
|
||||
"don't know how to deal with: ~s" relto-mp)]))
|
||||
|
||||
(define (normalize-lib s)
|
||||
(if (null? (cddr s))
|
||||
;; single-string version:
|
||||
(let ([e (cadr s)])
|
||||
(cond
|
||||
[(regexp-match? #rx"[.]" e)
|
||||
;; It has a suffix:
|
||||
(if (regexp-match? #rx"/" e)
|
||||
;; It has a path, so it's fine:
|
||||
s
|
||||
;; No path, so add "mzlib/":
|
||||
`(lib ,(string-append "mzlib/" e)))]
|
||||
[(regexp-match? #rx"/" e)
|
||||
;; It has a separator, so add a suffix:
|
||||
`(lib ,(string-append e ".ss"))]
|
||||
[else
|
||||
;; No separator or suffix, so add "/main.ss":
|
||||
`(lib ,(string-append e "/main.ss"))]))
|
||||
;; multi-string version:
|
||||
(if (regexp-match? #rx"[.]" (cadr s))
|
||||
;; there's a suffix, so we can collapse to a single string:
|
||||
`(lib ,(string-join (append (cddr s)
|
||||
(list (cadr s)))
|
||||
"/"))
|
||||
;; No suffix, so we must keep the old style:
|
||||
s)))
|
||||
|
||||
(define (normalize-planet s)
|
||||
(cond
|
||||
[(symbol? (cadr s))
|
||||
;; normalize via string form:
|
||||
(normalize-planet `(planet ,(symbol->string (cadr s))))]
|
||||
[(null? (cddr s))
|
||||
;; normalize to long form:
|
||||
(let* ([strs (regexp-split #rx"/" (cadr s))])
|
||||
(let ([owner (car strs)]
|
||||
[pkg+vers (regexp-split #rx":" (cadr strs))]
|
||||
[path (cddr strs)])
|
||||
`(planet ,(if (null? path)
|
||||
"main.ss"
|
||||
(let ([str (car (last-pair path))])
|
||||
(if (regexp-match? #rx"[.]" str)
|
||||
str
|
||||
(string-append str ".ss"))))
|
||||
(,owner
|
||||
,(car pkg+vers)
|
||||
,@(if (null? (cdr pkg+vers))
|
||||
null
|
||||
`(,(string->number (cadr pkg+vers))
|
||||
,(let ([vers (caddr pkg+vers)])
|
||||
(cond
|
||||
[(regexp-match? #rx"<=" vers)
|
||||
`(- ,(string->number (substring vers 2)))]
|
||||
[(regexp-match? #rx">=" vers)
|
||||
`(+ ,(string->number (substring vers 2)))]
|
||||
[(regexp-match? #rx"=" vers)
|
||||
(string->number (substring vers 1))]
|
||||
[(regexp-match #rx"(.*)-(.*)" vers)
|
||||
=> (lambda (m)
|
||||
`(,(string->number (cadr m))
|
||||
,(string->number (caddr m))))]
|
||||
[else (error 'collapse-module-path
|
||||
"confused when normalizing planet path: ~e"
|
||||
s)])))))
|
||||
,@(if (null? path)
|
||||
null
|
||||
(reverse (cdr (reverse path)))))))]
|
||||
[else
|
||||
;; Long form is the normal form:
|
||||
s]))
|
||||
|
||||
(cond [(string? s)
|
||||
;; Parse Unix-style relative path string
|
||||
(combine-relative-elements (explode-relpath-string s))]
|
||||
[(symbol? s)
|
||||
;; Convert to `lib' form:
|
||||
`(lib ,(symbol->string s))]
|
||||
(normalize-lib `(lib ,(symbol->string s)))]
|
||||
[(and (or (not (pair? s)) (not (list? s))) (not (path? s)))
|
||||
#f]
|
||||
[(or (path? s) (eq? (car s) 'file))
|
||||
|
|
@ -128,8 +201,8 @@
|
|||
(cond [(eq? base 'relative)
|
||||
(combine-relative-elements (cons name elements))]
|
||||
[else (loop base (cons name elements))])))))]
|
||||
[(eq? (car s) 'lib) s]
|
||||
[(eq? (car s) 'planet) s]
|
||||
[(eq? (car s) 'lib) (normalize-lib s)]
|
||||
[(eq? (car s) 'planet) (normalize-planet s)]
|
||||
[(eq? (car s) 'quote) s]
|
||||
[else #f]))
|
||||
|
||||
|
|
|
|||
|
|
@ -2054,7 +2054,7 @@ int scheme_is_module_path(Scheme_Object *obj)
|
|||
}
|
||||
} else if (SAME_OBJ(SCHEME_CAR(obj), planet_symbol)) {
|
||||
Scheme_Object *a, *subs;
|
||||
int len;
|
||||
int len, counter;
|
||||
|
||||
len = scheme_proper_list_length(obj);
|
||||
|
||||
|
|
@ -2096,11 +2096,15 @@ int scheme_is_module_path(Scheme_Object *obj)
|
|||
if (!ok_planet_string(a))
|
||||
return 0;
|
||||
|
||||
/* planet allows a major and minor version number: */
|
||||
counter = 0;
|
||||
for (obj = SCHEME_CDR(obj); !SCHEME_NULLP(obj); obj = SCHEME_CDR(obj)) {
|
||||
if (counter == 2)
|
||||
return 0;
|
||||
a = SCHEME_CAR(obj);
|
||||
if (ok_planet_number(a)) {
|
||||
/* ok */
|
||||
} else if (SCHEME_PAIRP(a)) {
|
||||
} else if ((counter == 1) && SCHEME_PAIRP(a)) {
|
||||
if (scheme_proper_list_length(a) != 2)
|
||||
return 0;
|
||||
if (ok_planet_number(SCHEME_CAR(a))) {
|
||||
|
|
@ -2127,6 +2131,7 @@ int scheme_is_module_path(Scheme_Object *obj)
|
|||
return 0;
|
||||
} else
|
||||
return 0;
|
||||
counter++;
|
||||
}
|
||||
|
||||
for (; !SCHEME_NULLP(subs); subs = SCHEME_CDR(subs)) {
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user