* Made (planet "path") work like (planet path), except that the former

can have an extension (so it's more like the (lib ...) form now.)
  (Note: I assume that the one-before-last argument in return
  ok_path_string(a, 0, 0, 1, 1) is what makes it not reject a suffix)
* Documented the new form
* Made the `-p' flag get a new-style planet path, and have it work the
  same as `-l' (not constructing an `eval')
* BTW, renamed `mzcmd_REQUIRE' to `mzcmd_REQUIRE_FILE', and changed
  "missing file after" error message in `-l' to "missing library name
  after"

svn: r9171
This commit is contained in:
Eli Barzilay 2008-04-06 14:08:21 +00:00
parent 5ae133c211
commit 5efae47be8
4 changed files with 38 additions and 58 deletions

View File

@ -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"))]

View File

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

View File

@ -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 <file>, --load <file> : Like -e '(load \"<file>\")' without printing\n"
" -t <file>, --require <file> : Like -e '(require (file \"<file>\"))'\n"
" -l <path>, --lib <path> : Like -e '(require (lib \"<path>\"))'\n"
" -p <fl> <u> <pkg> : Like -e '(require (planet \"<fl>\" (\"<u>\" \"<pkg>\"))'\n"
" -p <package> : Like -e '(require (planet \"<package>\")'\n"
" -r <file>, --script <file> : Same as -f <file> -N <file> --\n"
" -u <file>, --require-script <file> : Same as -t <file> -N <file> --\n"
" -k <n> <m> : Load executable-embedded code from file offset <n> to <m>\n"

View File

@ -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);
}
}