summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2022-05-12 07:54:52 -0700
committerKaz Kylheku <kaz@kylheku.com>2022-05-12 07:54:52 -0700
commitfca75faa1a6c3737b038d5fee6ce714a1f554280 (patch)
treefd36c5c47a0e22e4cd8fe723f7643cd9e919deb0
parent1162a735b61c1c5086fb6055471ee35cc8ed62a4 (diff)
downloadtxr-fca75faa1a6c3737b038d5fee6ce714a1f554280.tar.gz
txr-fca75faa1a6c3737b038d5fee6ce714a1f554280.tar.bz2
txr-fca75faa1a6c3737b038d5fee6ce714a1f554280.zip
New options: --in-package and --compile.
* txr.c (help): Mention new options. (do_compile_opt, do_in_package_opt): New static functions. (txr_main): Implement options. * Makefile (COMPILE_TL): Use the options instead of -e. * txr.1: Document.
-rw-r--r--Makefile3
-rw-r--r--txr.145
-rw-r--r--txr.c53
3 files changed, 98 insertions, 3 deletions
diff --git a/Makefile b/Makefile
index 4c1533fd..a53d2945 100644
--- a/Makefile
+++ b/Makefile
@@ -159,8 +159,7 @@ endef
define COMPILE_TL
$(call ABBREV,TXR)
-$(call SH,$(TXR) -e \
- "(progn (in-package sys) (compile-file \"$<\" \"$@.tmp\"))")
+$(call SH,$(TXR) --in-package=sys --compile=$<:$@.tmp)
$(call SH,mv $@.tmp $@)
endef
diff --git a/txr.1 b/txr.1
index a5ff6378..3479faee 100644
--- a/txr.1
+++ b/txr.1
@@ -818,7 +818,10 @@ option is processed. If the evaluation of every
.meta expression
evaluated this way terminates normally, and there is no
.meta script-file
-argument, then \*(TX terminates with a successful status.
+argument, then \*(TX terminates with a successful status,
+instead of entering the interactive listener. The
+.code -i
+option can be used to request the listener.
.meIP -p < expression
Just like
@@ -1052,6 +1055,46 @@ complement operators are handled using the derivative back-end.
This option makes it possible to test that back-end on test cases that it
wouldn't normally receive.
+.meIP >> --in-package= name
+This option changes to the specified package, by finding the package of the
+specified
+.meta name
+and assigning that to the
+.code *package*
+special variable. If the package is not found, a diagnostic is issued,
+and \*(TX terminates unsuccessfully.
+The package thus specified is visible to the subsequent occurrences of the
+.code -e
+family of options as well as of the
+.code --compile
+option. It does not affect the value of
+.code *package*
+which is in effect when a
+.meta script-file
+is executed or when the interactive listener is entered.
+
+.meIP <2> --compile= source-file [: target-file ]
+This option invokes the
+.code compile-update-file
+on
+.metn source-file .
+If
+.meta target-file
+is specified, it is passed to
+.code compile-update-file
+as the target argument; otherwise, that argument is defaulted.
+The option can be used multiple times to process multiple
+files. Unsuccessful compilation throws an exception, causing
+\*(TX to terminate abnormally. Similarly to the
+.code -e
+option, if this option is used at least once,
+and all of the invocations are successful, and there is no
+.meta script-file
+argument, then \*(TX terminates with a successful status instead
+of entering the interactive listener. The
+.code -i
+option can be used request the listener.
+
.coIP --
Signifies the end of the option list.
diff --git a/txr.c b/txr.c
index 0af94623..dc580f1b 100644
--- a/txr.c
+++ b/txr.c
@@ -165,6 +165,8 @@ static void help(void)
"--backtrace Enable backtraces.\n"
"--noninteractive Synonym for -n.\n"
"--compat=N Synonym for -C N.\n"
+"--in-package=name Switch to specified package\n"
+"--compile=src[:target] Compile a file.\n"
"--gc-delta=N Invoke garbage collection when malloc activity\n"
" increments by N megabytes since last collection.\n"
"--args... Allows multiple arguments to be encoded as a single\n"
@@ -434,6 +436,36 @@ static void requires_arg(val opt)
prog_string, opt, nao);
}
+static void do_compile_opt(val arg)
+{
+ val compile_update_file = intern(lit("compile-update-file"), user_package);
+ val col_pos = search_str(arg, lit(":"), nil, nil);
+ val source = arg;
+ val target = nil;
+
+ if (col_pos) {
+ target = sub_str(source, succ(col_pos), t);
+ source = sub_str(source, zero, col_pos);
+ }
+
+ funcall2(compile_update_file, source, target);
+}
+
+static int do_in_package_opt(val opt, val arg)
+{
+ val pkg_binding = lookup_var(nil, package_s);
+ val package = find_package(arg);
+
+ if (!package) {
+ format(std_error, lit("~a: option --~a: ~a package not found\n"),
+ prog_string, opt, arg, nao);
+ return 0;
+ }
+
+ rplacd(pkg_binding, package);
+ return 1;
+}
+
static int do_fixnum_opt(int (*opt_func)(val), val opt, val arg)
{
if (arg) {
@@ -716,6 +748,27 @@ int txr_main(int argc, char **argv)
continue;
}
+ if (equal(opt, lit("compile"))) {
+ if (!org) {
+ requires_arg(opt);
+ return EXIT_FAILURE;
+ }
+ reg_var(args_s, or2(orig_args, arg_list));
+ do_compile_opt(org);
+ evaled = t;
+ continue;
+ }
+
+ if (equal(opt, lit("in-package"))) {
+ if (!org) {
+ requires_arg(opt);
+ return EXIT_FAILURE;
+ }
+ if (!do_in_package_opt(opt, org))
+ return EXIT_FAILURE;
+ continue;
+ }
+
/* Long opts with no arguments */
if (0) noarg: {
drop_privilege();