change module-path? for planet path shorthand; doc edits

svn: r9048

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

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,
+@scheme[scheme/main]; when an @scheme[id] has no @litchar{/}, then
-then @scheme[/main] is automatically added to the end. Thus,
+@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
+A more general form to access a library from the @|PLaneT| server. In
-@|PLaneT| server. A @|PLaneT| reference starts like a @scheme[lib]
+this general form, a @|PLaneT| reference starts like a @scheme[lib]
-reference, with a relative path, but the path is followed by
+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.
 

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))
+@(define list-eval (make-base-eval))
-        (list-eval '(require scheme/function))
+@interaction-eval[#:eval list-eval (require scheme/list)]
-        (define-syntax list-examples
-          (syntax-rules ()
-            [(_ e ...) (examples #:eval list-eval e ...)])))
 
 @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?]{
+@defproc[(take [lst any/c] [pos nonnegative-exact-integer?]) list?]{
-Returns a fresh list, holding the first @scheme[pos] elements of
+Returns a fresh list whose elements are the first @scheme[pos] elements of
-@scheme[lst].  An exception is raised if the list has fewer than
+@scheme[lst].  If @scheme[lst] has fewer than
-@scheme[pos] elements.
+@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)
 ]}

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))
+@(define fun-eval (make-base-eval))
-        (fun-eval '(require scheme/function))
+@interaction-eval[#:eval fun-eval (require scheme/function)]
-        (define-syntax fun-examples
-          (syntax-rules ()
-            [(_ e ...) (examples #:eval fun-eval e ...)])))
 
 @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
+Returns a procedure that is a curried version of @scheme[proc]. In the
-@scheme[proc].  When the resulting procedure is applied on an
+first application of the resulting procedure, unless it is given the
-insufficient number of arguments, it returns a procedure that expects
+maximum number of arguments that it can accept, the result is a
-additional arguments.  At least one such application step is required
+procedure to accept additional arguments. In other words, given a
-unless the current arguments are the most that @scheme[proc] can
+@scheme[proc] that accepts varying number of arguments, the first
-consume (which is always the case when @scheme[proc] consumes any
+application delays as long as possible:
-number of arguments).
 
-If additional values are provided to the @scheme[curry] call (the
+@examples[#:eval fun-eval
-second form), they are used as the first step.  (This means that
+((curry list) 1 2)
-@scheme[curry] itself is curried.)
+((curry cons) 1)
+((curry cons) 1 2)
+]
 
-@scheme[curry] provides limited support for keyworded functions: only
+After the first application of the result of @scheme[curry], each
-the @scheme[curry] call itself can receive keyworded arguments to be
+further application accumulates arguments until sufficiently many
-eventually handed to @scheme[proc].
+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))
 ]
 

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 ...)
+ @defsubform*[((planet id)
-                     rel-string ...)]{
+               (planet rel-string (user-string pkg-string vers ...)
- Specifies a library available via the @PLaneT server. The
+                       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}.}

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))])
+              [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))
+            (send renderer deserialize-info (info-sci i) ci)))
-         (let* ([ri (send renderer resolve (list v) (list dest-dir) ci)]
+         (let* ([ri (render-time "resolve" (send renderer resolve (list v) (list dest-dir) ci))]
-                [sci (send renderer serialize-info ri)]
+                [sci (render-time "serialize" (send renderer serialize-info ri))]
-                [defs (send renderer get-defined ci)]
+                [defs (render-time "defined" (send renderer get-defined ci))]
-                [undef (send renderer get-undefined ri)]
+                [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)))))
+           (render-time
+            "render"
             (with-record-error
              (doc-src-file doc)
              (lambda () (send renderer render (list v) (list dest-dir) ri))
-            void)
+             void))
            (set-info-time! info (/ (current-inexact-milliseconds) 1000))
            (gc-point)
            (void)))))

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)

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,8 +1726,11 @@ 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;
+      }
     }
   }
 
@@ -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;
       }