mes: Add Guile-style module support.
This change adds support for Guile-style modules, but does not enable it by default. It can be enabled by using the 'boot-5' boot script. * mes/module/mes/guile-module.mes: New file. * mes/module/mes/boot-5.mes: New file. * mes/module/mes/boot-0.mes (effective-version, include-from-path) (define-module, use-modules, effective-version): Move these... * mes/module/mes/guile.scm: ...here. * mes/module/mes/boot-0.mes: Move '%main' and the command-line interface code... * mes/module/mes/main.mes: ...to this new file. * mes/module/mes/boot-0.mes: Import '(mes guile)' and '(mes main)'. * mes/module/ice-9/rdelim.scm: New file. * tests/data/bar.scm: New file. * tests/data/foo.scm: New file. * tests/guile-module.test: New file. * build-aux/check-mes.sh (TESTS): Add it.
This commit is contained in:
parent
b0123a9c38
commit
16c48267e4
|
@ -50,6 +50,7 @@ tests/fluids.test
|
||||||
tests/catch.test
|
tests/catch.test
|
||||||
tests/getopt-long.test
|
tests/getopt-long.test
|
||||||
tests/guile.test
|
tests/guile.test
|
||||||
|
tests/guile-module.test
|
||||||
tests/syntax.test
|
tests/syntax.test
|
||||||
tests/let-syntax.test
|
tests/let-syntax.test
|
||||||
tests/pmatch.test
|
tests/pmatch.test
|
||||||
|
|
|
@ -0,0 +1,30 @@
|
||||||
|
;;; -*- scheme -*-
|
||||||
|
|
||||||
|
;;; GNU Mes --- Maxwell Equations of Software
|
||||||
|
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||||
|
;;; Copyright © 2022 Timothy Sample <samplet@ngyro.com>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of GNU Mes.
|
||||||
|
;;;
|
||||||
|
;;; GNU 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.
|
||||||
|
;;;
|
||||||
|
;;; GNU 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 GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(define-module (ice-9 rdelim))
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;;; This is a place holder so that '(mes test)' can use 'read-line'.
|
||||||
|
;;; When run from Guile, 'read-line' will come from '(ice-9 rdelim)'.
|
||||||
|
;;; When run from Mes, 'read-line' is part of the root module, but for
|
||||||
|
;;; Guile compatibility, other modules will still have to import
|
||||||
|
;;; '(ice-9 rdelim)'.
|
|
@ -178,119 +178,18 @@
|
||||||
(define-macro (use-modules . rest) #t)
|
(define-macro (use-modules . rest) #t)
|
||||||
;; end boot-03.scm
|
;; end boot-03.scm
|
||||||
|
|
||||||
(define (effective-version) %version)
|
;; boot-04.scm
|
||||||
|
|
||||||
(mes-use-module (srfi srfi-1))
|
(mes-use-module (srfi srfi-1))
|
||||||
(mes-use-module (srfi srfi-13))
|
(mes-use-module (srfi srfi-13))
|
||||||
(mes-use-module (mes fluids))
|
(mes-use-module (mes fluids))
|
||||||
(mes-use-module (mes catch))
|
(mes-use-module (mes catch))
|
||||||
(mes-use-module (mes posix))
|
(mes-use-module (mes posix))
|
||||||
|
(mes-use-module (mes guile))
|
||||||
|
;; end boot-04.scm
|
||||||
|
|
||||||
(define-macro (include-from-path file)
|
(mes-use-module (mes main))
|
||||||
(let loop ((path (cons* %moduledir "module" (string-split (or (getenv "GUILE_LOAD_PATH") "") #\:))))
|
|
||||||
(cond ((and=> (getenv "MES_DEBUG") (compose (lambda (o) (> o 2)) string->number))
|
|
||||||
(core:display-error (string-append "include-from-path: " file " [PATH:" (string-join path ":") "]\n")))
|
|
||||||
((and=> (getenv "MES_DEBUG") (compose (lambda (o) (> o 1)) string->number))
|
|
||||||
(core:display-error (string-append "include-from-path: " file "\n"))))
|
|
||||||
(if (null? path) (error "include-from-path: not found: " file)
|
|
||||||
(let ((file (string-append (car path) "/" file)))
|
|
||||||
(if (access? file R_OK) `(load ,file)
|
|
||||||
(loop (cdr path)))))))
|
|
||||||
|
|
||||||
(define-macro (define-module module . rest)
|
(top-main)
|
||||||
`(if ,(and (pair? module)
|
|
||||||
(= 1 (length module))
|
|
||||||
(symbol? (car module)))
|
|
||||||
(define (,(car module) . arguments) (main (command-line)))))
|
|
||||||
|
|
||||||
(define-macro (use-modules . rest) #t)
|
|
||||||
|
|
||||||
(mes-use-module (mes getopt-long))
|
|
||||||
|
|
||||||
(define %main #f)
|
|
||||||
|
|
||||||
(let ((tty? (isatty? 0)))
|
|
||||||
(define (parse-opts args)
|
|
||||||
(let* ((option-spec
|
|
||||||
'((no-auto-compile)
|
|
||||||
(command (single-char #\c) (value #t))
|
|
||||||
(compiled-path (single-char #\C) (value #t))
|
|
||||||
(help (single-char #\h))
|
|
||||||
(load-path (single-char #\L) (value #t))
|
|
||||||
(main (single-char #\e) (value #t))
|
|
||||||
(source (single-char #\s) (value #t))
|
|
||||||
(version (single-char #\v))
|
|
||||||
(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))
|
|
||||||
(command (option-ref options 'command #f))
|
|
||||||
(main (option-ref options 'main #f))
|
|
||||||
(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? #f)
|
|
||||||
(version? (option-ref options 'version #f)))
|
|
||||||
(or
|
|
||||||
(and version?
|
|
||||||
(display (string-append "mes (GNU Mes) " %version "\n"))
|
|
||||||
(exit 0))
|
|
||||||
(and (or help? usage?)
|
|
||||||
(display "Usage: mes [OPTION]... [FILE]...
|
|
||||||
Scheme interpreter for bootstrapping the GNU system.
|
|
||||||
|
|
||||||
Options:
|
|
||||||
[-s] FILE load source code from FILE, and exit
|
|
||||||
-c EXPR evaluate expression EXPR, and exit
|
|
||||||
-- stop scanning arguments; run interactively
|
|
||||||
|
|
||||||
The above switches stop argument processing, and pass all
|
|
||||||
remaining arguments as the value of (command-line).
|
|
||||||
|
|
||||||
-e, --main=MAIN after reading script, apply MAIN to command-line arguments
|
|
||||||
-h, --help display this help and exit
|
|
||||||
-L, --load-path=DIR add DIR to the front of the module load path
|
|
||||||
-v, --version display version information and exit
|
|
||||||
|
|
||||||
Ignored for Guile compatibility:
|
|
||||||
--auto-compile
|
|
||||||
--fresh-auto-compile
|
|
||||||
--no-auto-compile
|
|
||||||
-C, --compiled-path=DIR
|
|
||||||
|
|
||||||
Report bugs to: bug-mes@gnu.org
|
|
||||||
GNU Mes home page: <http://gnu.org/software/mes/>
|
|
||||||
General help using GNU software: <http://gnu.org/gethelp/>
|
|
||||||
" (or (and usage? (current-error-port)) (current-output-port)))
|
|
||||||
(exit (or (and usage? 2) 0)))
|
|
||||||
options)
|
|
||||||
(and=> (option-ref options 'load-path #f)
|
|
||||||
(lambda (dir)
|
|
||||||
(setenv "GUILE_LOAD_PATH" (string-append dir ":" (getenv "GUILE_LOAD_PATH")))))
|
|
||||||
(when command
|
|
||||||
(let* ((prev (set-current-input-port (open-input-string command)))
|
|
||||||
(expr (cons 'begin (read-input-file-env (current-environment))))
|
|
||||||
(set-current-input-port prev))
|
|
||||||
(primitive-eval expr)
|
|
||||||
(exit 0)))
|
|
||||||
(when main
|
|
||||||
(let ((proc-name (string->symbol main)))
|
|
||||||
(set! %main (lambda () (apply proc-name (command-line) '())))))
|
|
||||||
(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)
|
(primitive-load 0)
|
||||||
(if %main (%main))
|
(if %main (%main))
|
||||||
|
|
|
@ -0,0 +1,202 @@
|
||||||
|
;;; -*-scheme-*-
|
||||||
|
|
||||||
|
;;; GNU Mes --- Maxwell Equations of Software
|
||||||
|
;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of GNU Mes.
|
||||||
|
;;;
|
||||||
|
;;; GNU 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.
|
||||||
|
;;;
|
||||||
|
;;; GNU 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 GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;;; read-0.mes - bootstrap reader. This file is read by a minimal
|
||||||
|
;;; core reader. It only supports s-exps and line-comments; quotes,
|
||||||
|
;;; character literals, string literals cannot be used here.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
;; boot-00.scm
|
||||||
|
(define mes %version)
|
||||||
|
|
||||||
|
(define (defined? x)
|
||||||
|
(core:hashq-ref (initial-module) x #f))
|
||||||
|
|
||||||
|
(define (cond-expand-expander clauses)
|
||||||
|
(if (defined? (car (car clauses)))
|
||||||
|
(cdr (car clauses))
|
||||||
|
(cond-expand-expander (cdr clauses))))
|
||||||
|
|
||||||
|
(define-macro (cond-expand . clauses)
|
||||||
|
(cons 'begin (cond-expand-expander clauses)))
|
||||||
|
;; end boot-00.scm
|
||||||
|
|
||||||
|
;; boot-01.scm
|
||||||
|
(define (not x) (if x #f #t))
|
||||||
|
|
||||||
|
(define (display x . rest)
|
||||||
|
(if (null? rest) (core:display x)
|
||||||
|
(core:display-port x (car rest))))
|
||||||
|
|
||||||
|
(define (write x . rest)
|
||||||
|
(if (null? rest) (core:write x)
|
||||||
|
(core:write-port x (car rest))))
|
||||||
|
|
||||||
|
(define (newline . rest)
|
||||||
|
(core:display "\n"))
|
||||||
|
|
||||||
|
(define (cadr x) (car (cdr x)))
|
||||||
|
|
||||||
|
(define (map1 f lst)
|
||||||
|
(if (null? lst) (list)
|
||||||
|
(cons (f (car lst)) (map1 f (cdr lst)))))
|
||||||
|
|
||||||
|
(define map map1)
|
||||||
|
|
||||||
|
(define (cons* . rest)
|
||||||
|
(if (null? (cdr rest)) (car rest)
|
||||||
|
(cons (car rest) (core:apply cons* (cdr rest) (current-environment)))))
|
||||||
|
|
||||||
|
(define (apply f h . t)
|
||||||
|
(if (null? t) (core:apply f h (current-environment))
|
||||||
|
(apply f (apply cons* (cons h t)))))
|
||||||
|
|
||||||
|
(define (append . rest)
|
||||||
|
(if (null? rest) '()
|
||||||
|
(if (null? (cdr rest)) (car rest)
|
||||||
|
(append2 (car rest) (apply append (cdr rest))))))
|
||||||
|
;; end boot-01.scm
|
||||||
|
|
||||||
|
;; boot-02.scm
|
||||||
|
(define-macro (and . x)
|
||||||
|
(if (null? x) #t
|
||||||
|
(if (null? (cdr x)) (car x)
|
||||||
|
(list (quote if) (car x) (cons (quote and) (cdr x))
|
||||||
|
#f))))
|
||||||
|
|
||||||
|
(define-macro (or . x)
|
||||||
|
(if (null? x) #f
|
||||||
|
(if (null? (cdr x)) (car x)
|
||||||
|
(list (list (quote lambda) (list (quote r))
|
||||||
|
(list (quote if) (quote r) (quote r)
|
||||||
|
(cons (quote or) (cdr x))))
|
||||||
|
(car x)))))
|
||||||
|
|
||||||
|
(define-macro (mes-use-module module)
|
||||||
|
#t)
|
||||||
|
|
||||||
|
(define-macro (define-module module . rest)
|
||||||
|
#t)
|
||||||
|
|
||||||
|
;; end boot-02.scm
|
||||||
|
|
||||||
|
;; boot-03.scm
|
||||||
|
(define guile? #f)
|
||||||
|
(define mes? #t)
|
||||||
|
(define (primitive-eval e) (core:eval e (current-environment)))
|
||||||
|
(define eval core:eval)
|
||||||
|
|
||||||
|
(define (port-filename port) "<stdin>")
|
||||||
|
(define (port-line port) 0)
|
||||||
|
(define (port-column port) 0)
|
||||||
|
(define (ftell port) 0)
|
||||||
|
(define (false-if-exception x) x)
|
||||||
|
|
||||||
|
(define (cons* . rest)
|
||||||
|
(if (null? (cdr rest)) (car rest)
|
||||||
|
(cons (car rest) (core:apply cons* (cdr rest) (current-environment)))))
|
||||||
|
|
||||||
|
(define (apply f h . t)
|
||||||
|
(if (null? t) (core:apply f h (current-environment))
|
||||||
|
(apply f (apply cons* (cons h t)))))
|
||||||
|
|
||||||
|
(define-macro (load file)
|
||||||
|
(list 'begin
|
||||||
|
(list 'if (list 'and (list getenv "MES_DEBUG")
|
||||||
|
(list not (list equal2? (list getenv "MES_DEBUG") "0"))
|
||||||
|
(list not (list equal2? (list getenv "MES_DEBUG") "1")))
|
||||||
|
(list 'begin
|
||||||
|
(list core:display-error ";;; read ")
|
||||||
|
(list core:display-error file)
|
||||||
|
(list core:display-error "\n")))
|
||||||
|
(list 'primitive-load file)))
|
||||||
|
|
||||||
|
(define-macro (include file) (list 'load file))
|
||||||
|
|
||||||
|
(define (append . rest)
|
||||||
|
(if (null? rest) '()
|
||||||
|
(if (null? (cdr rest)) (car rest)
|
||||||
|
(append2 (car rest) (apply append (cdr rest))))))
|
||||||
|
|
||||||
|
(define %moduledir (string-append %datadir "/module/"))
|
||||||
|
|
||||||
|
(include (string-append %moduledir "mes/type-0.mes"))
|
||||||
|
|
||||||
|
(if (and (getenv "MES_DEBUG")
|
||||||
|
(not (equal2? (getenv "MES_DEBUG") "0"))
|
||||||
|
(not (equal2? (getenv "MES_DEBUG") "1")))
|
||||||
|
(begin
|
||||||
|
(core:display-error ";;; %moduledir=")
|
||||||
|
(core:display-error %moduledir)
|
||||||
|
(core:display-error "\n")))
|
||||||
|
|
||||||
|
(define-macro (include-from-path file)
|
||||||
|
(list 'load (list string-append %moduledir file)))
|
||||||
|
|
||||||
|
(define (string-join lst infix)
|
||||||
|
(if (null? lst) ""
|
||||||
|
(if (null? (cdr lst)) (car lst)
|
||||||
|
(string-append (car lst) infix (string-join (cdr lst) infix)))))
|
||||||
|
|
||||||
|
(include-from-path "mes/module.mes")
|
||||||
|
|
||||||
|
(mes-use-module (mes base))
|
||||||
|
(mes-use-module (mes quasiquote))
|
||||||
|
(mes-use-module (mes let))
|
||||||
|
(mes-use-module (mes scm))
|
||||||
|
|
||||||
|
(define-macro (define-module module . rest)
|
||||||
|
`(if ,(and (pair? module)
|
||||||
|
(= 1 (length module))
|
||||||
|
(symbol? (car module)))
|
||||||
|
(define (,(car module) . arguments) (main (command-line)))))
|
||||||
|
|
||||||
|
(define-macro (use-modules . rest) #t)
|
||||||
|
;; end boot-03.scm
|
||||||
|
|
||||||
|
;; boot-04.scm
|
||||||
|
(mes-use-module (srfi srfi-1))
|
||||||
|
(mes-use-module (srfi srfi-13))
|
||||||
|
(mes-use-module (mes fluids))
|
||||||
|
(mes-use-module (mes catch))
|
||||||
|
(mes-use-module (mes posix))
|
||||||
|
(mes-use-module (mes guile))
|
||||||
|
;; end boot-04.scm
|
||||||
|
|
||||||
|
(mes-use-module (mes main))
|
||||||
|
|
||||||
|
(mes-use-module (srfi srfi-9))
|
||||||
|
|
||||||
|
(define (defined? x)
|
||||||
|
(module-defined? (current-module) x))
|
||||||
|
|
||||||
|
(mes-use-module (mes guile-module))
|
||||||
|
|
||||||
|
;; Until more of Mes is modularized, the REPL can only work from the
|
||||||
|
;; root module.
|
||||||
|
(set-current-module the-root-module)
|
||||||
|
|
||||||
|
(top-main)
|
||||||
|
|
||||||
|
(primitive-load 0)
|
||||||
|
(if %main (%main))
|
File diff suppressed because it is too large
Load Diff
|
@ -22,10 +22,36 @@
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(mes-use-module (srfi srfi-13))
|
|
||||||
|
|
||||||
(define-macro (cond-expand-provide . rest) #t)
|
(define-macro (cond-expand-provide . rest) #t)
|
||||||
|
|
||||||
|
(define-macro (include-from-path file)
|
||||||
|
(let loop ((path (cons* %moduledir "module" (string-split (or (getenv "GUILE_LOAD_PATH") "") #\:))))
|
||||||
|
(cond ((and=> (getenv "MES_DEBUG") (compose (lambda (o) (> o 2)) string->number))
|
||||||
|
(core:display-error (string-append "include-from-path: " file " [PATH:" (string-join path ":") "]\n")))
|
||||||
|
((and=> (getenv "MES_DEBUG") (compose (lambda (o) (> o 1)) string->number))
|
||||||
|
(core:display-error (string-append "include-from-path: " file "\n"))))
|
||||||
|
(if (null? path) (error "include-from-path: not found: " file)
|
||||||
|
(let ((file (string-append (car path) "/" file)))
|
||||||
|
(if (access? file R_OK) `(load ,file)
|
||||||
|
(loop (cdr path)))))))
|
||||||
|
|
||||||
|
(define-macro (define-module module . rest)
|
||||||
|
`(if ,(and (pair? module)
|
||||||
|
(= 1 (length module))
|
||||||
|
(symbol? (car module)))
|
||||||
|
(define (,(car module) . arguments) (main (command-line)))))
|
||||||
|
|
||||||
|
(define-macro (defmacro name args . body)
|
||||||
|
`(define-macro ,(cons name args) ,@body))
|
||||||
|
|
||||||
|
(define-macro (set-procedure-property! proc key value)
|
||||||
|
proc)
|
||||||
|
|
||||||
|
(define-macro (use-modules . rest) #t)
|
||||||
|
|
||||||
|
(define (effective-version) %version)
|
||||||
|
|
||||||
|
(mes-use-module (srfi srfi-13))
|
||||||
(mes-use-module (mes catch))
|
(mes-use-module (mes catch))
|
||||||
(mes-use-module (mes posix))
|
(mes-use-module (mes posix))
|
||||||
(mes-use-module (srfi srfi-16))
|
(mes-use-module (srfi srfi-16))
|
||||||
|
|
|
@ -0,0 +1,109 @@
|
||||||
|
;;; -*-scheme-*-
|
||||||
|
|
||||||
|
;;; GNU Mes --- Maxwell Equations of Software
|
||||||
|
;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of GNU Mes.
|
||||||
|
;;;
|
||||||
|
;;; GNU 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.
|
||||||
|
;;;
|
||||||
|
;;; GNU 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 GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(mes-use-module (mes getopt-long))
|
||||||
|
|
||||||
|
(define %main #f)
|
||||||
|
(define (top-main)
|
||||||
|
(let ((tty? (isatty? 0)))
|
||||||
|
(define (parse-opts args)
|
||||||
|
(let* ((option-spec
|
||||||
|
'((no-auto-compile)
|
||||||
|
(command (single-char #\c) (value #t))
|
||||||
|
(compiled-path (single-char #\C) (value #t))
|
||||||
|
(help (single-char #\h))
|
||||||
|
(load-path (single-char #\L) (value #t))
|
||||||
|
(main (single-char #\e) (value #t))
|
||||||
|
(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))
|
||||||
|
(command (option-ref options 'command #f))
|
||||||
|
(main (option-ref options 'main #f))
|
||||||
|
(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? #f)
|
||||||
|
(version? (option-ref options 'version #f)))
|
||||||
|
(or
|
||||||
|
(and version?
|
||||||
|
(display (string-append "mes (GNU 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
|
||||||
|
-c EXPR evalute expression EXPR, and exit
|
||||||
|
-- stop scanning arguments; run interactively
|
||||||
|
|
||||||
|
The above switches stop argument processing, and pass all
|
||||||
|
remaining arguments as the value of (command-line).
|
||||||
|
|
||||||
|
-e, --main=MAIN after reading script, apply MAIN to command-line arguments
|
||||||
|
-h, --help display this help and exit
|
||||||
|
-L, --load-path=DIR add DIR to the front of the module load path
|
||||||
|
-v, --version display version information and exit
|
||||||
|
|
||||||
|
Ignored for Guile compatibility:
|
||||||
|
--auto-compile
|
||||||
|
--fresh-auto-compile
|
||||||
|
--no-auto-compile
|
||||||
|
-C, --compiled-path=DIR
|
||||||
|
|
||||||
|
Report bugs to: bug-mes@gnu.org
|
||||||
|
GNU Mes home page: <http://gnu.org/software/mes/>
|
||||||
|
General help using GNU software: <http://gnu.org/gethelp/>
|
||||||
|
" (or (and usage? (current-error-port)) (current-output-port)))
|
||||||
|
(exit (or (and usage? 2) 0)))
|
||||||
|
options)
|
||||||
|
(and=> (option-ref options 'load-path #f)
|
||||||
|
(lambda (dir)
|
||||||
|
(setenv "GUILE_LOAD_PATH" (string-append dir ":" (getenv "GUILE_LOAD_PATH")))))
|
||||||
|
(when command
|
||||||
|
(let* ((prev (set-current-input-port (open-input-string command)))
|
||||||
|
(expr (cons 'begin (read-input-file-env (current-module))))
|
||||||
|
(set-current-input-port prev))
|
||||||
|
(primitive-eval expr)
|
||||||
|
(exit 0)))
|
||||||
|
(when main
|
||||||
|
(let ((proc-name (string->symbol main)))
|
||||||
|
(set! %main (lambda () (apply proc-name (command-line) '())))))
|
||||||
|
(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)))))
|
|
@ -0,0 +1,28 @@
|
||||||
|
;;; GNU Mes --- Maxwell Equations of Software
|
||||||
|
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of GNU Mes.
|
||||||
|
;;;
|
||||||
|
;;; GNU 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.
|
||||||
|
;;;
|
||||||
|
;;; GNU 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 GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;;; bar.scm is used by tests/boot-6.test
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(define-module (data bar)
|
||||||
|
#:export (bar))
|
||||||
|
|
||||||
|
(define bar "bar")
|
|
@ -0,0 +1,28 @@
|
||||||
|
;;; GNU Mes --- Maxwell Equations of Software
|
||||||
|
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of GNU Mes.
|
||||||
|
;;;
|
||||||
|
;;; GNU 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.
|
||||||
|
;;;
|
||||||
|
;;; GNU 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 GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;;; foo.scm is used by tests/boot-6.test
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(define-module (data foo)
|
||||||
|
#:export (foo))
|
||||||
|
|
||||||
|
(define foo "foo")
|
|
@ -0,0 +1,56 @@
|
||||||
|
#! /bin/sh
|
||||||
|
# -*-scheme-*-
|
||||||
|
srcdir=${srcdir-.}
|
||||||
|
GUILE_LOAD_PATH=$srcdir/tests
|
||||||
|
export GUILE_LOAD_PATH
|
||||||
|
MES_BOOT=boot-5.scm
|
||||||
|
export MES_BOOT
|
||||||
|
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests guile-module)' -s "$0" "$@"
|
||||||
|
!#
|
||||||
|
|
||||||
|
;;; -*-scheme-*-
|
||||||
|
|
||||||
|
;;; GNU Mes --- Maxwell Equations of Software
|
||||||
|
;;; Copyright © 2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of GNU Mes.
|
||||||
|
;;;
|
||||||
|
;;; GNU 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.
|
||||||
|
;;;
|
||||||
|
;;; GNU 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 GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(define-module (tests guile-module)
|
||||||
|
#:use-module (data foo)
|
||||||
|
#:use-module (data bar)
|
||||||
|
#:use-module (mes test))
|
||||||
|
|
||||||
|
(define (defined? name)
|
||||||
|
(->bool (module-variable (current-module) name)))
|
||||||
|
|
||||||
|
(pass-if "first dummy" #t)
|
||||||
|
(pass-if-not "second dummy" #f)
|
||||||
|
|
||||||
|
(pass-if "defined foo"
|
||||||
|
(defined? 'foo))
|
||||||
|
|
||||||
|
(pass-if-equal "foo"
|
||||||
|
"foo"
|
||||||
|
(and (defined? 'foo) foo))
|
||||||
|
|
||||||
|
(pass-if "defined bar"
|
||||||
|
(defined? 'bar))
|
||||||
|
|
||||||
|
(pass-if-equal "bar"
|
||||||
|
"bar"
|
||||||
|
(and (defined? 'bar) bar))
|
||||||
|
|
||||||
|
(result 'report)
|
Loading…
Reference in New Issue