mes: Guile-like command-line interface.

* module/mes/boot-0.scm (tty?): Guile-like command-line interface. * scripts/repl.mes: Remove. * scripts/mescc.mes: Update. * tests/*.test: Update scripts. * module/mes/repl.mes (repl): Add ,quit.
2018-04-22 11:51:28 +02:00 · 2018-04-22 11:51:28 +02:00 · 630718f134
parent a26eae418b
commit 630718f134
36 changed files with 102 additions and 99 deletions
--- a/make.scm
+++ b/make.scm
@ -512,7 +512,6 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$

 (add-target (install "guile/mescc.scm" #:dir "bin" #:substitutes #t))
 (add-target (install "scripts/mescc.mes" #:dir "bin" #:substitutes #t))
-(add-target (install "scripts/repl.mes" #:dir "bin" #:substitutes #t))
 (define bootstrap? #f)
 (if bootstrap?
    (add-target (install "src/mes.mes" #:dir "bin" #:installed-name "mes"))
--- a/module/mes/boot-0.scm
+++ b/module/mes/boot-0.scm
@ -225,5 +225,60 @@
 (mes-use-module (mes posix))
 ;; ;; end boot-0.scm

+(mes-use-module (mes getopt-long))
+
 (primitive-load 0)
+(let ((tty? (isatty? 0)))
+  (define (parse-opts args)
+    (let* ((option-spec
+            '((dump)
+              (help (single-char #\h))
+              (load)
+              (source (single-char #\s) (value #t))
+              (version (single-char #\V)))))
+      (getopt-long args option-spec #:stop-at-first-non-option #t)))
+  (define (source-arg? o)
+    (equal? "-s" o))
+  (let* ((s-index (list-index source-arg? %argv))
+         (args (if s-index (list-head %argv (+ s-index 2)) %argv))
+         (options (parse-opts args))
+         (source (option-ref options 'source #f))
+         (files (if s-index (list-tail %argv (+ s-index 1))
+                    (option-ref options '() '())))
+         (help? (option-ref options 'help #f))
+         (usage? (and (not help?) (null? files) (not tty?)))
+         (version? (option-ref options 'version #f)))
+    (or
+     (and version?
+          (display (string-append "mes (Mes) " %version "\n"))
+          (exit 0))
+     (and (or help? usage?)
+          (display "Usage: mes [OPTION]... [FILE]...
+Evaluate code with Mes, interactively or from a script.
+
+  [-s] FILE      load source code from FILE, and exit
+  --             stop scanning arguments; run interactively
+
+The above switches stop argument processing, and pass all
+remaining arguments as the value of (command-line).
+
+  --dump             dump binary program to stdout
+  -h, --help         display this help and exit
+  --load             load binary program [module/mes/boot-0.32-mo]
+  -v, --version      display version information and exit
+" (or (and usage? (current-error-port)) (current-output-port)))
+          (exit (or (and usage? 2) 0)))
+     options)
+    (cond ((pair? files)
+           (let* ((file (car files))
+                  (port (if (equal? file "-") 0
+                            (open-input-file file))))
+             (set! %argv files)
+             (set-current-input-port port)))
+          ((and (null? files) tty?)
+           
+           (mes-use-module (mes repl))
+           (set-current-input-port 0)
+           (repl))
+          (else #t))))
 (primitive-load 0)
--- a/module/mes/repl.mes
+++ b/module/mes/repl.mes
@ -98,6 +98,7 @@ along with Mes.  If not, see <http://www.gnu.org/licenses/>.

  ,expand SEXP         - Expand SEXP
  ,help                - Show this help
+  ,quit                - Quit this session
  ,show TOPIC          - Show info on TOPIC [c, w]
  ,use MODULE          - load MODULE
 ")
@ -132,6 +133,8 @@ along with Mes.  If not, see <http://www.gnu.org/licenses/>.
             (topic (find (negate char-whitespace?) (symbol->list word))))
        (display (assoc-ref topic-alist topic))
        *unspecified*))
+    (define (quit . x)
+      (exit 0))
    (define (use a)
      (lambda ()
        (let ((module (read)))
@ -139,6 +142,7 @@ along with Mes.  If not, see <http://www.gnu.org/licenses/>.
    (define (meta command a)
      (let ((command-alist `((expand . ,(expand a))
                             (help . ,help)
+                             (quit . ,quit)
                             (show . ,show)
                             (use . ,(use a)))))
        ((or (assoc-ref command-alist command)
--- a/scripts/mescc.mes
+++ b/scripts/mescc.mes
@ -10,8 +10,7 @@ then
 fi
 MES_MODULEDIR=${MES_MODULEDIR-$MES_PREFIX/"module"}
 export MES_MODULEDIR
-$MES $MES_FLAGS -- "$@" < $0
-#paredit:||
+$MES -s $0 "$@"
 exit $?
 !#

@ -121,8 +120,7 @@ Usage: mescc.mes [OPTION]... FILE...
      (string-suffix? ".mes-o" o)))

 (define (main args)
-  (let* ((args (cons* (car args) (cdr (member "--" args))))
-         (options (parse-opts args))
+  (let* ((options (parse-opts args))
         (files (option-ref options '() '()))
         (file (car files))
         (preprocess? (option-ref options 'E #f))
--- a/scripts/repl.mes
+++ b/scripts/repl.mes
@ -1,44 +0,0 @@
-#! /bin/sh
-# -*-scheme-*-
-MES=${MES-$(dirname $0)/mes}
-prefix=module/
-cat $0 /dev/stdin | $MES $MES_FLAGS -- "$@"
-#paredit:|
-exit $?
-!#
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; This file is part of Mes.
-;;;
-;;; Mes is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; Mes is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-(mes-use-module (mes repl))
-(mes-use-module (mes syntax))
-(primitive-load 0)
-
-(let* ((files (cdr (command-line)))
-       (file (if (pair? files) (car files)))
-       (file (if (and (equal? file "--") (pair? files) (pair? (cdr files))) (cadr files) file)))
-    (cond ((equal? file "--help")
-           (format (current-error-port) "Usage: repl.mes [--help|--version]\n")
-           (exit 0))
-          ((equal? file "--version")
-           (format (current-error-port) "mescc.mes (mes) ~a\n" %version)
-           (exit 0))))
-
-(repl)
-()
-
--- a/src/mes.c
+++ b/src/mes.c
@ -29,7 +29,9 @@
 // minimal for boot-0.scm
 // int ARENA_SIZE = 100000; // 32b: 1MiB, 64b: 2 MiB
 // take a bit more to run all tests
-int ARENA_SIZE = 400000; // 32b: 1MiB, 64b: 2 MiB
+// int ARENA_SIZE = 400000; // 32b: 1MiB, 64b: 2 MiB
+// take a bit extra for loading repl
+int ARENA_SIZE = 1000000; // 32b: 2MiB, 64b: 4 MiB
 #if !_POSIX_SOURCE
 //int MAX_ARENA_SIZE = 60000000; // 32b: ~ 300MiB
 int MAX_ARENA_SIZE = 166600000; // 32b: ~ 2GiB
@ -2268,20 +2270,22 @@ load_env (SCM a) ///((internal))
 SCM
 bload_env (SCM a) ///((internal))
 {
-#if 1 //__MESC__
+#if !_POSIX_SOURCE
  char *mo = "mes/read-0-32.mo";
-  g_stdin = open ("module/mes/read-0-32.mo", O_RDONLY);
-  char *read0 = MODULEDIR "mes/read-0-32.mo";
+  g_stdin = open ("module/mes/boot-0.32-mo", O_RDONLY);
+  char *read0 = MODULEDIR "mes/boot-0.32-mo";
  g_stdin = g_stdin >= 0 ? g_stdin : open (read0, O_RDONLY);
 #else
-  char *mo ="mes/read-0.mo";
-  g_stdin = open ("module/mes/read-0.mo", O_RDONLY);
-  g_stdin = g_stdin >= 0 ? g_stdin : open (MODULEDIR "mes/read-0.mo", O_RDONLY);
+  char *mo ="mes/boot-0.mo";
+  g_stdin = open ("module/mes/boot-0.mo", O_RDONLY);
+  g_stdin = g_stdin >= 0 ? g_stdin : open (MODULEDIR "mes/boot-0.mo", O_RDONLY);
 #endif

  if (g_stdin < 0)
    {
-      eputs ("no such file: ");eputs (mo);eputs ("\n");
+      eputs ("no such file: ");
+      eputs (mo);
+      eputs ("\n");
      return 1;
    } 
  assert (getchar () == 'M');
@ -2362,20 +2366,12 @@ main (int argc, char *argv[])
    ARENA_SIZE = atoi (p);
  if (p = getenv ("MES_SAFETY"))
    GC_SAFETY = atoi (p);
-  if (argc > 1 && !strcmp (argv[1], "--help"))
-    return puts ("Usage: mes [--dump|--load] < FILE\n");
-  if (argc > 1 && !strcmp (argv[1], "--version"))
-    {
-      puts ("Mes ");puts (VERSION);puts ("\n");
-      return 0;
-    };
  g_stdin = STDIN;
  g_stdout = STDOUT;
  r0 = mes_environment ();

  SCM program = (argc > 1 && !strcmp (argv[1], "--load"))
    ? bload_env (r0) : load_env (r0);
-  g_tiny = argc > 2 && !strcmp (argv[2], "--tiny");
  if (argc > 1 && !strcmp (argv[1], "--dump"))
    return dump ();

--- a/src/reader.c
+++ b/src/reader.c
@ -439,8 +439,6 @@ reader_read_string ()
  return MAKE_STRING (lst);
 }

-int g_tiny = 0;
-
 int
 dump ()
 {
--- a/tests/base.test
+++ b/tests/base.test
@ -1,8 +1,7 @@
 #! /bin/sh
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
-#export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/boot.test
+++ b/tests/boot.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 export MES_BOOT=boot-02.scm
-$MES $MES_FLAGS "$@" < $0
+$MES < $0
 exit $?
 !#

--- a/tests/catch.test
+++ b/tests/catch.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/closure.test
+++ b/tests/closure.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/cwv.test
+++ b/tests/cwv.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/display.test
+++ b/tests/display.test
@ -1,8 +1,7 @@
 #! /bin/sh
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
-#export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/fluids.test
+++ b/tests/fluids.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/getopt-long.test
+++ b/tests/getopt-long.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/guile.test
+++ b/tests/guile.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/let-syntax.test
+++ b/tests/let-syntax.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/let.test
+++ b/tests/let.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/match.test
+++ b/tests/match.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/math.test
+++ b/tests/math.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/module.test
+++ b/tests/module.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/optargs.test
+++ b/tests/optargs.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/peg.test
+++ b/tests/peg.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-166000000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/pmatch.test
+++ b/tests/pmatch.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/psyntax.test
+++ b/tests/psyntax.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-200000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/quasiquote.test
+++ b/tests/quasiquote.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 #paredit:||
 exit $?
 !#
--- a/tests/read.test
+++ b/tests/read.test
@ -2,8 +2,7 @@
 # -*-scheme-*-
 # ***REMOVE THIS BLOCK COMMENT INITIALLY***
 MES=${MES-$(dirname $0)/../src/mes}
-#export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/record.test
+++ b/tests/record.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/scm.test
+++ b/tests/scm.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/srfi-1.test
+++ b/tests/srfi-1.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/srfi-13.test
+++ b/tests/srfi-13.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/srfi-14.test
+++ b/tests/srfi-14.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/srfi-16.test
+++ b/tests/srfi-16.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/srfi-43.test
+++ b/tests/srfi-43.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/syntax.test
+++ b/tests/syntax.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#

--- a/tests/vector.test
+++ b/tests/vector.test
@ -2,7 +2,7 @@
 # -*-scheme-*-
 MES=${MES-$(dirname $0)/../src/mes}
 #export MES_ARENA=${MES_ARENA-40000}
-$MES $MES_FLAGS "$@" < $0
+$MES -s $0
 exit $?
 !#