From fca75faa1a6c3737b038d5fee6ce714a1f554280 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Thu, 12 May 2022 07:54:52 -0700
Subject: 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.
---
 Makefile |  3 +--
 txr.1    | 45 ++++++++++++++++++++++++++++++++++++++++++++-
 txr.c    | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 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();
-- 
cgit v1.2.3