artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mes: Guile-like command-line interface.

Browse source 
* 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.
This commit is contained in:
Jan Nieuwenhuizen 2018-04-22 11:51:28 +02:00
parent a26eae418b
commit 630718f134
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
36 changed files with 102 additions and 99 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
make.scm
View file

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

55
module/mes/boot-0.scm
View file

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

4
module/mes/repl.mes
View file

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

6
scripts/mescc.mes
View file

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

44
scripts/repl.mes
View file

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

28
src/mes.c
View file

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

2
src/reader.c
View file

@ -439,8 +439,6 @@ reader_read_string ()
return MAKE_STRING (lst);
}
int g_tiny = 0;
int
dump ()
{

3
tests/base.test
View file

@ -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 $?
!#

2
tests/boot.test
View file

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

2
tests/catch.test
View file

@ -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 $?
!#

2
tests/closure.test
View file

@ -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 $?
!#

2
tests/cwv.test
View file

@ -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 $?
!#

3
tests/display.test
View file

@ -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 $?
!#

2
tests/fluids.test
View file

@ -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 $?
!#

2
tests/getopt-long.test
View file

@ -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 $?
!#

2
tests/guile.test
View file

@ -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 $?
!#

2
tests/let-syntax.test
View file

@ -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 $?
!#

2
tests/let.test
View file

@ -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 $?
!#

2
tests/match.test
View file

@ -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 $?
!#

2
tests/math.test
View file

@ -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 $?
!#

2
tests/module.test
View file

@ -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 $?
!#

2
tests/optargs.test
View file

@ -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 $?
!#

2
tests/peg.test
View file

@ -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 $?
!#

2
tests/pmatch.test
View file

@ -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 $?
!#

2
tests/psyntax.test
View file

@ -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 $?
!#

2
tests/quasiquote.test
View file

@ -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 $?
!#

3
tests/read.test
View file

@ -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 $?
!#

2
tests/record.test
View file

@ -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 $?
!#

2
tests/scm.test
View file

@ -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 $?
!#

2
tests/srfi-1.test
View file

@ -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 $?
!#

2
tests/srfi-13.test
View file

@ -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 $?
!#

2
tests/srfi-14.test
View file

@ -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 $?
!#

2
tests/srfi-16.test
View file

@ -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 $?
!#

2
tests/srfi-43.test
View file

@ -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 $?
!#

2
tests/syntax.test
View file

@ -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 $?
!#

2
tests/vector.test
View file

@ -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 $?
!#