diff --git a/collects/planet/parsereq.ss b/collects/planet/parsereq.ss index 008367bbae..d445cd09ff 100644 --- a/collects/planet/parsereq.ss +++ b/collects/planet/parsereq.ss @@ -24,8 +24,8 @@ (make-request (pkg-spec->full-pkg-spec pkg-spec stx) file-name path)] - [((? symbol? s)) - (let ([str (symbol->string s)]) + [((? (lambda (x) (or (symbol? x) (string? x))) s)) + (let ([str (if (symbol? s) (symbol->string s) s)]) (define (yell msg) (λ (str) (raise-syntax-error #f (format msg str) stx))) (try-parsing str ([owner (get-next-slash #:on-error (yell "Illegal syntax; expected an owner, received ~e"))] diff --git a/collects/scribblings/guide/module-paths.scrbl b/collects/scribblings/guide/module-paths.scrbl index 4d9e35fd82..7826becdca 100644 --- a/collects/scribblings/guide/module-paths.scrbl +++ b/collects/scribblings/guide/module-paths.scrbl @@ -111,7 +111,7 @@ The @scheme[id] encodes several pieces of information separated by a 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. +is used as the path if no sub-path element is supplied. @examples[ (eval:alts @@ -126,6 +126,15 @@ is used as the path if none is supplied. ] } +@; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +@specsubform[#:literals (planet) + (planet package-string)]{ + +Like the symbol form of a @scheme[planet], but using a string instead +of an identifier. Also, the @scheme[package-string] can end with a +file suffix, in case the relevant suffix is not @filepath{.ss}. +} + @; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @specsubform/subs[#:literals (planet = + -) (planet rel-string (user-string pkg-string vers ...)) diff --git a/src/mzscheme/cmdline.inc b/src/mzscheme/cmdline.inc index 659dfd09f1..a622428eb5 100644 --- a/src/mzscheme/cmdline.inc +++ b/src/mzscheme/cmdline.inc @@ -126,32 +126,6 @@ static char *protect_quote_backslash(const char *file) return (char *)file; } -static char *make_require_planet(const char *file, const char *file_sfx, - const char *user, - const char *pkg, char *pkg_sfx) -{ - char *s; - - pkg = protect_quote_backslash(pkg); - user = protect_quote_backslash(user); - - s = (char *)malloc(strlen(file) - + strlen(file_sfx) - + strlen(user) - + strlen(pkg) - + strlen(pkg_sfx) + 46); - strcpy(s, "(require (planet \""); - strcat(s, file); - strcat(s, file_sfx); - strcat(s, "\" (\""); - strcat(s, user); - strcat(s, "\" \""); - strcat(s, pkg); - strcat(s, pkg_sfx); - strcat(s, "\")))"); - return s; -} - static char *make_embedded_load(const char *start, const char *end) { char *s; @@ -171,9 +145,10 @@ static char *make_embedded_load(const char *start, const char *end) #define mzcmd_EVAL 0 #define mzcmd_LOAD 1 #define mzcmd_MAIN 2 -#define mzcmd_REQUIRE 3 +#define mzcmd_REQUIRE_FILE 3 #define mzcmd_REQUIRE_LIB 4 -#define mzcmd_EMBEDDED 5 +#define mzcmd_REQUIRE_PLANET 5 +#define mzcmd_EMBEDDED 6 /* To avoid having to create a specific mark procedure for prcise GC, split argument information into purely atomic @@ -250,8 +225,9 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) break; } } else if ((fa->eval_kind[i] == mzcmd_EVAL) - || (fa->eval_kind[i] == mzcmd_REQUIRE) + || (fa->eval_kind[i] == mzcmd_REQUIRE_FILE) || (fa->eval_kind[i] == mzcmd_REQUIRE_LIB) + || (fa->eval_kind[i] == mzcmd_REQUIRE_PLANET) || (fa->eval_kind[i] == mzcmd_EMBEDDED)) { Scheme_Thread * volatile p; p = scheme_get_current_thread(); @@ -272,16 +248,18 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) scheme_apply(eload, 3, a); } else { Scheme_Object *a[1], *nsreq; + char *name; nsreq = scheme_builtin_value("namespace-require"); if (fa->eval_kind[i] == mzcmd_REQUIRE_LIB) { - a[0] = scheme_make_pair(scheme_intern_symbol("lib"), - scheme_make_pair(scheme_make_utf8_string(fa->evals_and_loads[i]), - scheme_make_null())); + name = "lib"; + } else if (fa->eval_kind[i] == mzcmd_REQUIRE_PLANET) { + name = "planet"; } else { - a[0] = scheme_make_pair(scheme_intern_symbol("file"), - scheme_make_pair(scheme_make_utf8_string(fa->evals_and_loads[i]), - scheme_make_null())); + name = "file"; } + a[0] = scheme_make_pair(scheme_intern_symbol(name), + scheme_make_pair(scheme_make_utf8_string(fa->evals_and_loads[i]), + scheme_make_null())); scheme_apply(nsreq, 1, a); } } else { @@ -795,13 +773,13 @@ static int run_from_cmd_line(int argc, char *_argv[], argv++; --argc; evals_and_loads[num_enl] = argv[0]; - eval_kind[num_enl++] = mzcmd_REQUIRE; + eval_kind[num_enl++] = mzcmd_REQUIRE_FILE; if (!init_ns) no_init_ns = 1; break; case 'l': if (argc < 2) { - PRINTF("%s: missing file after %s switch\n", + PRINTF("%s: missing library name after %s switch\n", prog, real_switch); goto show_need_help; } @@ -813,24 +791,15 @@ static int run_from_cmd_line(int argc, char *_argv[], no_init_ns = 1; break; case 'p': - if (argc < 4) { - PRINTF("%s: missing %s after %s switch\n", - prog, - ((argc > 2) - ? "package" - : ((argc > 1) - ? "user and package" - : "file, user, and package")), - real_switch); + if (argc < 2) { + PRINTF("%s: missing package name after %s switch\n", + prog, real_switch); goto show_need_help; } argv++; --argc; - se = make_require_planet(argv[0], "", argv[1], argv[2], ""); - evals_and_loads[num_enl] = se; - argv += 2; - argc -= 2; - eval_kind[num_enl++] = mzcmd_EVAL; + evals_and_loads[num_enl] = argv[0]; + eval_kind[num_enl++] = mzcmd_REQUIRE_PLANET; if (!init_ns) no_init_ns = 1; break; @@ -940,7 +909,7 @@ static int run_from_cmd_line(int argc, char *_argv[], no_more_switches = 1; sprog = argv[0]; evals_and_loads[num_enl] = argv[0]; - eval_kind[num_enl++] = mzcmd_REQUIRE; + eval_kind[num_enl++] = mzcmd_REQUIRE_FILE; argv++; --argc; } @@ -1094,7 +1063,7 @@ static int run_from_cmd_line(int argc, char *_argv[], " -f , --load : Like -e '(load \"\")' without printing\n" " -t , --require : Like -e '(require (file \"\"))'\n" " -l , --lib : Like -e '(require (lib \"\"))'\n" - " -p : Like -e '(require (planet \"\" (\"\" \"\"))'\n" + " -p : Like -e '(require (planet \"\")'\n" " -r , --script : Same as -f -N --\n" " -u , --require-script : Same as -t -N --\n" " -k : Load executable-embedded code from file offset to \n" diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index 4a6b70f248..788a118a53 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -1876,11 +1876,11 @@ int scheme_is_module_path(Scheme_Object *obj) } else if (SAME_OBJ(SCHEME_CAR(obj), planet_symbol)) { Scheme_Object *a, *subs; int len; - + len = scheme_proper_list_length(obj); if (len == 2) { - /* Symbolic shorthand? */ + /* Symbolic or string shorthand? */ obj = SCHEME_CDR(obj); a = SCHEME_CAR(obj); if (SCHEME_SYMBOLP(a)) { @@ -1888,6 +1888,8 @@ int scheme_is_module_path(Scheme_Object *obj) SCHEME_SYMSTR_OFFSET(a), SCHEME_SYM_LEN(a)); return ok_path_string(obj, 0, 0, 0, 1); + } else if (SCHEME_CHAR_STRINGP(a)) { + return ok_path_string(a, 0, 0, 1, 1); } }