diff --git a/module/mes/getopt-long.scm b/mes/module/ice-9/getopt-long.scm
similarity index 99%
rename from module/mes/getopt-long.scm
rename to mes/module/ice-9/getopt-long.scm
index 71e04438..ce74df92 100644
--- a/module/mes/getopt-long.scm
+++ b/mes/module/ice-9/getopt-long.scm
@@ -19,6 +19,12 @@
;;; (regexps removed by Jan (janneke) Nieuwenhuizen)
;;; (srfi-9 backport by Jan (janneke) Nieuwenhuizen)
+(define-module (ice-9 getopt-long)
+ #:use-module (ice-9 optargs)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:export (getopt-long option-ref))
+
;;; Commentary:
;;; This module implements some complex command line option parsing, in
@@ -159,12 +165,6 @@
;;; Code:
-(define-module (mes getopt-long)
- #:use-module (ice-9 optargs)
- #:use-module (srfi srfi-1)
- #:use-module (srfi srfi-9)
- #:export (getopt-long option-ref))
-
(define-record-type option-spec
(%make-option-spec name value required? option-spec->single-char predicate value-policy)
option-spec?
diff --git a/mes/module/ice-9/optargs.scm b/mes/module/ice-9/optargs.scm
index da94ceda..a88616b2 100644
--- a/mes/module/ice-9/optargs.scm
+++ b/mes/module/ice-9/optargs.scm
@@ -58,17 +58,27 @@
;;; Code:
(define-module (ice-9 optargs)
+ #:use-module (mes mes-0)
#:use-module (system base pmatch)
- #:replace (lambda*)
- #:export-syntax (let-optional
- let-optional*
- let-keywords
- let-keywords*
- define*
- define*-public
- defmacro*
- defmacro*-public))
+ #:export (lambda*
+ let-optional
+ let-optional*
+ let-keywords
+ let-keywords*
+ define*
+ define*-public
+ defmacro*
+ defmacro*-public
+ define-macro*
+ define*-guts
+ parse-arglist
+ every?
+ ext-decl?
+ let-optional-template
+ let-keywords-template
+ rest-arg->keyword-binding-list))
+;
;; let-optional rest-arg (binding ...) . body
;; let-optional* rest-arg (binding ...) . body
;; macros used to bind optional arguments
@@ -151,7 +161,7 @@
=> cdr)
(else
,(cadr key)))))))
- `(let ((,kb-list-gensym ((if (not mes?) (@@ (mes optargs) rest-arg->keyword-binding-list)
+ `(let ((,kb-list-gensym ((if (not mes?) #f ;;(@@ (ice-9 optargs) rest-arg->keyword-binding-list)
rest-arg->keyword-binding-list)
,REST-ARG ',(map (lambda (x) (symbol->keyword (if (pair? x) (car x) x)))
BINDINGS)
@@ -419,6 +429,9 @@
(defmacro* ,NAME ,ARGLIST ,@BODY)
(export-syntax ,NAME)))
+(define-macro (define-macro* NAME+ARGLIST . BODY)
+ `(define-macro ,(car NAME+ARGLIST) #f (lambda* ,(cdr NAME+ARGLIST) ,@BODY)))
+
;;; Support for optional & keyword args with the interpreter.
(define *uninitialized* (list 'uninitialized))
(define (parse-lambda-case spec inits predicate args)
diff --git a/mes/module/mes/boot-0.scm b/mes/module/mes/boot-0.scm
index 6a81c6fc..212b4fce 100644
--- a/mes/module/mes/boot-0.scm
+++ b/mes/module/mes/boot-0.scm
@@ -178,7 +178,11 @@
(mes-use-module (mes guile))
;; end boot-04.scm
+(include-from-path "ice-9/optargs.scm")
+(include-from-path "srfi/srfi-9.mes")
+(include-from-path "ice-9/getopt-long.scm")
(mes-use-module (mes main))
+
(top-main)
(primitive-load 0)
(primitive-load (open-input-string %main))
diff --git a/mes/module/mes/boot-5.mes b/mes/module/mes/boot-5.mes
index 8c13b179..11c47c60 100644
--- a/mes/module/mes/boot-5.mes
+++ b/mes/module/mes/boot-5.mes
@@ -179,12 +179,11 @@
;; end boot-04.scm
;; FIXME: need no load before booting guile module -- srfi-1 stuff
-(mes-use-module (mes getopt-long))
-(mes-use-module (mes main))
(mes-use-module (srfi srfi-9))
(mes-use-module (mes syntax))
(mes-use-module (mes boot-6))
+(include-from-path "mes/main.mes")
(top-main)
(primitive-load 0)
(primitive-load (open-input-string %main))
diff --git a/mes/module/mes/boot-6.mes b/mes/module/mes/boot-6.mes
index ee0a2be6..154e4e30 100644
--- a/mes/module/mes/boot-6.mes
+++ b/mes/module/mes/boot-6.mes
@@ -2156,26 +2156,6 @@
-;;; {with-fluids}
-;;;
-
-;; with-fluids is a convenience wrapper for the builtin procedure
-;; `with-fluids*'. The syntax is just like `let':
-;;
-;; (with-fluids ((fluid val)
-;; ...)
-;; body)
-
-(defmacro with-fluids (bindings . body)
- (let ((fluids (map car bindings))
- (values (map cadr bindings)))
- (if (and (= (length fluids) 1) (= (length values) 1))
- `(with-fluid* ,(car fluids) ,(car values) (lambda () ,@body))
- `(with-fluids* (list ,@fluids) (list ,@values)
- (lambda () ,@body)))))
-
-
-
;;; {Module System Macros}
;;;
diff --git a/mes/module/mes/getopt-long.mes b/mes/module/mes/getopt-long.mes
index a5ba1418..eeb40432 100644
--- a/mes/module/mes/getopt-long.mes
+++ b/mes/module/mes/getopt-long.mes
@@ -25,5 +25,5 @@
(mes-use-module (srfi srfi-1))
(mes-use-module (srfi srfi-9))
(mes-use-module (srfi srfi-13))
-(mes-use-module (mes optargs))
-(include-from-path "mes/getopt-long.scm")
+(mes-use-module (ice-9 optargs))
+(include-from-path "ice-9/getopt-long.scm")
diff --git a/mes/module/mes/guile.mes b/mes/module/mes/guile.mes
index ec5c880b..e2bd3666 100644
--- a/mes/module/mes/guile.mes
+++ b/mes/module/mes/guile.mes
@@ -44,6 +44,9 @@
(define-macro (defmacro name args . body)
`(define-macro ,(cons name args) ,@body))
+(define-macro (set-object-property! object key value)
+ object)
+
(define-macro (set-procedure-property! proc key value)
proc)
diff --git a/mes/module/mes/main.mes b/mes/module/mes/main.mes
index caad46af..78ed5a7c 100644
--- a/mes/module/mes/main.mes
+++ b/mes/module/mes/main.mes
@@ -22,7 +22,10 @@
;;; Code:
-(mes-use-module (mes getopt-long))
+(define-module (mes main)
+ #:use-module (ice-9 getopt-long)
+ #:use-module (mes repl)
+ #:export (top-main))
(define %main #f)
(define (top-main)
@@ -105,7 +108,3 @@ General help using GNU software:
(set-current-input-port 0)
(repl))
(else #t)))))
-
-(define (top-load *undefined*)
- (primitive-load 0)
- (primitive-load (open-input-string %main)))
diff --git a/mes/module/mes/optargs.mes b/mes/module/mes/optargs.mes
deleted file mode 100644
index aa42e4af..00000000
--- a/mes/module/mes/optargs.mes
+++ /dev/null
@@ -1,38 +0,0 @@
-;;; -*-scheme-*-
-
-;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen
-;;;
-;;; 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 .
-
-;;; Commentary:
-
-;;; Optargs (define*, lambda* et al.) from Guile
-
-;;; Code:
-
-(mes-use-module (mes scm))
-
-(define-macro (defmacro name args . body)
- `(define-macro ,(cons name args) ,@body))
-
-(define-macro (set-procedure-property! proc key value)
- proc)
-
-(include-from-path "mes/optargs.scm")
-
-(define-macro (define-macro* NAME+ARGLIST . BODY)
- `(define-macro ,(car NAME+ARGLIST) #f (lambda* ,(cdr NAME+ARGLIST) ,@BODY)))
diff --git a/mes/module/mes/repl.mes b/mes/module/mes/repl.mes
index f3f2f30f..0b4139a4 100644
--- a/mes/module/mes/repl.mes
+++ b/mes/module/mes/repl.mes
@@ -1,7 +1,7 @@
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen
+;;; Copyright © 2016,2017,2018,2020 Jan (janneke) Nieuwenhuizen
;;;
;;; This file is part of GNU Mes.
;;;
@@ -24,9 +24,13 @@
;;; Code:
-(mes-use-module (mes scm))
+;;; XXX FIXME
(mes-use-module (srfi srfi-14))
+(define-module (mes repl)
+ ;;#:use-module (srfi srfi-14)
+ #:export (repl))
+
(define welcome
(string-append "GNU Mes " %version "
Copyright (C) 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen
diff --git a/mes/module/mes/syntax.mes b/mes/module/mes/syntax.mes
index f8229624..124bbc86 100644
--- a/mes/module/mes/syntax.mes
+++ b/mes/module/mes/syntax.mes
@@ -25,7 +25,15 @@
;;; syntax-rules is adapted from scheme48-1.1/scheme/alt/syntax.scm
;;; Code:
-(mes-use-module (mes scm))
+
+(define-module (mes syntax)
+ #:export (define-syntax
+ define-syntax-rule
+ syntax-error
+ silent-syntax-error
+ id-pattern
+ let-syntax))
+
(include-from-path "mes/syntax.scm")
(define (syntax-error message thing)
diff --git a/mes/module/srfi/srfi-0.mes b/mes/module/srfi/srfi-0.mes
index 85799d24..7dd6cbfa 100644
--- a/mes/module/srfi/srfi-0.mes
+++ b/mes/module/srfi/srfi-0.mes
@@ -1,7 +1,7 @@
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan (janneke) Nieuwenhuizen
+;;; Copyright © 2016,2020 Jan (janneke) Nieuwenhuizen
;;;
;;; This file is part of GNU Mes.
;;;
@@ -24,6 +24,9 @@
;;; Code:
+(define-module (srfi srfi-0)
+ #:export (cend-expand))
+
(define mes '(0 1))
(define (cond-expand-expander clauses)
diff --git a/mes/module/srfi/srfi-1.mes b/mes/module/srfi/srfi-1.mes
index 41eb7671..5e0948c7 100644
--- a/mes/module/srfi/srfi-1.mes
+++ b/mes/module/srfi/srfi-1.mes
@@ -25,7 +25,34 @@
;;; Code:
(define-module (srfi srfi-1)
- #:export (find))
+ #:export (every
+ find
+ filter
+ append-map
+ filter-map
+ fold
+ fold-right
+ unfold
+ remove
+ reverse!
+ srfi-1:member
+ mes:member
+ member
+ mes:iota
+ srfi-1:iota
+ iota
+ srfi-1:iota
+ delete-duplicates
+ any
+ any1
+ every
+ every1
+ list-index
+ lset-union
+ lset-intersection
+ lset-difference
+ reverse!
+ take-while))
(define (find pred lst)
(let loop ((lst lst))
diff --git a/mes/module/srfi/srfi-14.mes b/mes/module/srfi/srfi-14.mes
index 2e925ec5..cb465477 100644
--- a/mes/module/srfi/srfi-14.mes
+++ b/mes/module/srfi/srfi-14.mes
@@ -1,7 +1,7 @@
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen
+;;; Copyright © 2016,2018,2020 Jan (janneke) Nieuwenhuizen
;;;
;;; This file is part of GNU Mes.
;;;
@@ -24,6 +24,24 @@
;;; Code:
+(define-module (srfi srfi-14)
+ #:export (char-set
+ char-set?
+ char-set=
+ char-set:whitespace
+ char-set:digit
+ char-set:upper-case
+ char-set lst
+ string->char-set
+ string->char-set!
+ char-set-adjoin
+ char-set-contains?
+ char-set-complement
+ char-whitespace?
+ char-set-copy
+ char-upcase
+ char-downcase))
+
;; FIXME: have structs
(define (char-set . x)
(cons '*char-set* x))
diff --git a/mes/module/srfi/srfi-43.mes b/mes/module/srfi/srfi-43.mes
index 5ab749cc..e6b78f18 100644
--- a/mes/module/srfi/srfi-43.mes
+++ b/mes/module/srfi/srfi-43.mes
@@ -1,7 +1,7 @@
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen
+;;; Copyright © 2016,2018,2020 Jan (janneke) Nieuwenhuizen
;;;
;;; This file is part of GNU Mes.
;;;
@@ -24,6 +24,10 @@
;;; Code:
+(define-module (srfi srfi-43)
+ #:export (vector-map
+ vector-for-each))
+
(define (vector-map f v)
(let* ((k (vector-length v))
(n (make-vector k)))
diff --git a/mes/module/srfi/srfi-8.mes b/mes/module/srfi/srfi-8.mes
index 909f7bd8..bfeee140 100644
--- a/mes/module/srfi/srfi-8.mes
+++ b/mes/module/srfi/srfi-8.mes
@@ -1,7 +1,7 @@
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen
+;;; Copyright © 2018,2020 Jan (janneke) Nieuwenhuizen
;;;
;;; This file is part of GNU Mes.
;;;
@@ -24,6 +24,9 @@
;;; Code:
+(define-module (ice-9 receive)
+ #:export (receive))
+
(define-macro (receive vars vals . body)
`(call-with-values (lambda () ,vals)
(lambda ,vars . ,body)))
diff --git a/mes/module/srfi/srfi-9-struct.mes b/mes/module/srfi/srfi-9-struct.mes
index 2eab50cc..210993b6 100644
--- a/mes/module/srfi/srfi-9-struct.mes
+++ b/mes/module/srfi/srfi-9-struct.mes
@@ -1,7 +1,7 @@
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2017,2018,2019 Jan (janneke) Nieuwenhuizen
+;;; Copyright © 2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen
;;;
;;; This file is part of GNU Mes.
;;;
@@ -22,6 +22,22 @@
;;; srfi-9.mes - records, based on struct.
+;;; Code:
+
+(define-module (srfi srfi-9)
+ #:export (define-record-type
+ make-record-type
+ record-type?
+ struct-vtable
+ record-type-name
+ record-type-descriptor
+ record-type-fields
+ record-predicate
+ record?
+ record-constructor
+ record-accessor
+ record-modifier))
+
(define-macro (define-record-type name constructor+field-names predicate . fields)
(let ((type (make-record-type name (map car fields))))
`(begin
diff --git a/mes/module/srfi/srfi-9-vector.mes b/mes/module/srfi/srfi-9-vector.mes
index 5ff3773e..7def79a5 100644
--- a/mes/module/srfi/srfi-9-vector.mes
+++ b/mes/module/srfi/srfi-9-vector.mes
@@ -1,7 +1,7 @@
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2017,2018,2019 Jan (janneke) Nieuwenhuizen
+;;; Copyright © 2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen
;;;
;;; This file is part of GNU Mes.
;;;
@@ -22,6 +22,20 @@
;;; srfi-9-vector.mes - records, based on vector
+(define-module (srfi srfi-9)
+ #:export (define-record-type
+ make-record-type
+ record-type?
+ struct-vtable
+ record-type-name
+ record-type-descriptor
+ record-type-fields
+ record-predicate
+ record?
+ record-constructor
+ record-accessor
+ record-modifier))
+
(define-macro (define-record-type type constructor+field-names predicate . fields)
(let ((record (make-record-type type (map car fields))))
`(begin
diff --git a/mes/module/srfi/srfi-9/gnu-struct.mes b/mes/module/srfi/srfi-9/gnu-struct.mes
index 9a972afe..27347e81 100644
--- a/mes/module/srfi/srfi-9/gnu-struct.mes
+++ b/mes/module/srfi/srfi-9/gnu-struct.mes
@@ -1,7 +1,7 @@
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2017,2018,2019 Jan (janneke) Nieuwenhuizen
+;;; Copyright © 2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen
;;;
;;; This file is part of GNU Mes.
;;;
@@ -22,6 +22,12 @@
;;; srfi-9.mes - GNU immutable records.
+;;; Code:
+
+(define-module (srfi srfi-9 gnu)
+ #:export (define-immutable-record-type
+ set-field))
+
(define-macro (define-immutable-record-type type constructor+parameters predicate . fields)
`(define-record-type ,type ,constructor+parameters ,predicate ,@(map (lambda (f) (list-head f 2)) fields)))
diff --git a/mes/module/srfi/srfi-9/gnu-vector.mes b/mes/module/srfi/srfi-9/gnu-vector.mes
index c5ae945f..67d35522 100644
--- a/mes/module/srfi/srfi-9/gnu-vector.mes
+++ b/mes/module/srfi/srfi-9/gnu-vector.mes
@@ -1,7 +1,7 @@
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen
+;;; Copyright © 2017,2018,2020 Jan (janneke) Nieuwenhuizen
;;;
;;; This file is part of GNU Mes.
;;;
@@ -22,6 +22,12 @@
;;; srfi-9.mes - GNU immutable records.
+;;; Code:
+
+(define-module (srfi srfi-9 gnu)
+ #:export (define-immutable-record-type
+ set-field))
+
(define-macro (define-immutable-record-type type constructor+params predicate . fields)
`(define-record-type ,type ,constructor+params ,predicate ,@(map (lambda (f) (list-head f 2)) fields)))
diff --git a/module/mes/optargs.scm b/module/mes/optargs.scm
deleted file mode 100644
index 148c986a..00000000
--- a/module/mes/optargs.scm
+++ /dev/null
@@ -1,499 +0,0 @@
-;;;; optargs.scm -- support for optional arguments
-;;;;
-;;;; Copyright (C) 1997, 1998, 1999, 2001, 2002, 2004, 2006 Free Software Foundation, Inc.
-;;;;
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; This library 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
-;;;; Lesser General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-;;;;
-;;;; Contributed by Maciej Stachowiak
-
-
-
-;;; Commentary:
-
-;;; {Optional Arguments}
-;;;
-;;; The C interface for creating Guile procedures has a very handy
-;;; "optional argument" feature. This module attempts to provide
-;;; similar functionality for procedures defined in Scheme with
-;;; a convenient and attractive syntax.
-;;;
-;;; exported macros are:
-;;; let-optional
-;;; let-optional*
-;;; let-keywords
-;;; let-keywords*
-;;; lambda*
-;;; define*
-;;; define*-public
-;;; defmacro*
-;;; defmacro*-public
-;;;
-;;;
-;;; Summary of the lambda* extended parameter list syntax (brackets
-;;; are used to indicate grouping only):
-;;;
-;;; ext-param-list ::= [identifier]* [#:optional [ext-var-decl]+]?
-;;; [#:key [ext-var-decl]+ [#:allow-other-keys]?]?
-;;; [[#:rest identifier]|[. identifier]]?
-;;;
-;;; ext-var-decl ::= identifier | ( identifier expression )
-;;;
-;;; The characters `*', `+' and `?' are not to be taken literally; they
-;;; mean respectively, zero or more occurences, one or more occurences,
-;;; and one or zero occurences.
-;;;
-
-;;; Code:
-
-(define-module (mes optargs)
- #:use-module (system base pmatch)
- #:replace (lambda*)
- #:export-syntax (let-optional
- let-optional*
- let-keywords
- let-keywords*
- define*
- define*-public
- defmacro*
- defmacro*-public))
-
-;; let-optional rest-arg (binding ...) . body
-;; let-optional* rest-arg (binding ...) . body
-;; macros used to bind optional arguments
-;;
-;; These two macros give you an optional argument interface that is
-;; very "Schemey" and introduces no fancy syntax. They are compatible
-;; with the scsh macros of the same name, but are slightly
-;; extended. Each of binding may be of one of the forms or
-;; ( ). rest-arg should be the rest-argument of
-;; the procedures these are used from. The items in rest-arg are
-;; sequentially bound to the variable namess are given. When rest-arg
-;; runs out, the remaining vars are bound either to the default values
-;; or to `#f' if no default value was specified. rest-arg remains
-;; bound to whatever may have been left of rest-arg.
-;;
-
-(defmacro let-optional (REST-ARG BINDINGS . BODY)
- (let-optional-template REST-ARG BINDINGS BODY 'let))
-
-(defmacro let-optional* (REST-ARG BINDINGS . BODY)
- (let-optional-template REST-ARG BINDINGS BODY 'let*))
-
-
-
-;; let-keywords rest-arg allow-other-keys? (binding ...) . body
-;; let-keywords* rest-arg allow-other-keys? (binding ...) . body
-;; macros used to bind keyword arguments
-;;
-;; These macros pick out keyword arguments from rest-arg, but do not
-;; modify it. This is consistent at least with Common Lisp, which
-;; duplicates keyword args in the rest arg. More explanation of what
-;; keyword arguments in a lambda list look like can be found below in
-;; the documentation for lambda*. Bindings can have the same form as
-;; for let-optional. If allow-other-keys? is false, an error will be
-;; thrown if anything that looks like a keyword argument but does not
-;; match a known keyword parameter will result in an error.
-;;
-
-
-(defmacro let-keywords (REST-ARG ALLOW-OTHER-KEYS? BINDINGS . BODY)
- (let-keywords-template REST-ARG ALLOW-OTHER-KEYS? BINDINGS BODY 'let))
-
-(defmacro let-keywords* (REST-ARG ALLOW-OTHER-KEYS? BINDINGS . BODY)
- (let-keywords-template REST-ARG ALLOW-OTHER-KEYS? BINDINGS BODY 'let*))
-
-
-;; some utility procedures for implementing the various let-forms.
-
-(define (let-o-k-template REST-ARG BINDINGS BODY let-type proc)
- (let ((bindings (map (lambda (x)
- (if (list? x)
- x
- (list x #f)))
- BINDINGS)))
- `(,let-type ,(map proc bindings) ,@BODY)))
-
-(define (let-optional-template REST-ARG BINDINGS BODY let-type)
- (if (null? BINDINGS)
- `(let () ,@BODY)
- (let-o-k-template REST-ARG BINDINGS BODY let-type
- (lambda (optional)
- `(,(car optional)
- (cond
- ((not (null? ,REST-ARG))
- (let ((result (car ,REST-ARG)))
- ,(list 'set! REST-ARG
- `(cdr ,REST-ARG))
- result))
- (else
- ,(cadr optional))))))))
-
-(define (let-keywords-template REST-ARG ALLOW-OTHER-KEYS? BINDINGS BODY let-type)
- (if (null? BINDINGS)
- `(let () ,@BODY)
- (let* ((kb-list-gensym (gensym "kb:G"))
- (bindfilter (lambda (key)
- `(,(car key)
- (cond
- ((assq ',(car key) ,kb-list-gensym)
- => cdr)
- (else
- ,(cadr key)))))))
- `(let ((,kb-list-gensym ((if (not mes?) (@@ (mes optargs) rest-arg->keyword-binding-list)
- rest-arg->keyword-binding-list)
- ,REST-ARG ',(map (lambda (x) (symbol->keyword (if (pair? x) (car x) x)))
- BINDINGS)
- ,ALLOW-OTHER-KEYS?)))
- ,(let-o-k-template REST-ARG BINDINGS BODY let-type bindfilter)))))
-
-(define (rest-arg->keyword-binding-list rest-arg keywords allow-other-keys?)
- (if (null? rest-arg)
- '()
- (let loop ((first (car rest-arg))
- (rest (cdr rest-arg))
- (accum '()))
- (let ((next (lambda (a)
- (if (null? (cdr rest))
- a
- (loop (cadr rest) (cddr rest) a)))))
- (if (keyword? first)
- (cond
- ((memq first keywords)
- (if (null? rest)
- (error "Keyword argument has no value:" first)
- (next (cons (cons (keyword->symbol first)
- (car rest)) accum))))
- ((not allow-other-keys?)
- (error "Unknown keyword in arguments:" first))
- (else (if (null? rest)
- accum
- (next accum))))
- (if (null? rest)
- accum
- (loop (car rest) (cdr rest) accum)))))))
-
-
-;; lambda* args . body
-;; lambda extended for optional and keyword arguments
-;;
-;; lambda* creates a procedure that takes optional arguments. These
-;; are specified by putting them inside brackets at the end of the
-;; paramater list, but before any dotted rest argument. For example,
-;; (lambda* (a b #:optional c d . e) '())
-;; creates a procedure with fixed arguments a and b, optional arguments c
-;; and d, and rest argument e. If the optional arguments are omitted
-;; in a call, the variables for them are bound to `#f'.
-;;
-;; lambda* can also take keyword arguments. For example, a procedure
-;; defined like this:
-;; (lambda* (#:key xyzzy larch) '())
-;; can be called with any of the argument lists (#:xyzzy 11)
-;; (#:larch 13) (#:larch 42 #:xyzzy 19) (). Whichever arguments
-;; are given as keywords are bound to values.
-;;
-;; Optional and keyword arguments can also be given default values
-;; which they take on when they are not present in a call, by giving a
-;; two-item list in place of an optional argument, for example in:
-;; (lambda* (foo #:optional (bar 42) #:key (baz 73)) (list foo bar baz))
-;; foo is a fixed argument, bar is an optional argument with default
-;; value 42, and baz is a keyword argument with default value 73.
-;; Default value expressions are not evaluated unless they are needed
-;; and until the procedure is called.
-;;
-;; lambda* now supports two more special parameter list keywords.
-;;
-;; lambda*-defined procedures now throw an error by default if a
-;; keyword other than one of those specified is found in the actual
-;; passed arguments. However, specifying #:allow-other-keys
-;; immediately after the keyword argument declarations restores the
-;; previous behavior of ignoring unknown keywords. lambda* also now
-;; guarantees that if the same keyword is passed more than once, the
-;; last one passed is the one that takes effect. For example,
-;; ((lambda* (#:key (heads 0) (tails 0)) (display (list heads tails)))
-;; #:heads 37 #:tails 42 #:heads 99)
-;; would result in (99 47) being displayed.
-;;
-;; #:rest is also now provided as a synonym for the dotted syntax rest
-;; argument. The argument lists (a . b) and (a #:rest b) are equivalent in
-;; all respects to lambda*. This is provided for more similarity to DSSSL,
-;; MIT-Scheme and Kawa among others, as well as for refugees from other
-;; Lisp dialects.
-
-
-(defmacro lambda* (ARGLIST . BODY)
- (parse-arglist
- ARGLIST
- (lambda (non-optional-args optionals keys aok? rest-arg)
- ;; Check for syntax errors.
- (if (not (every? symbol? non-optional-args))
- (error "Syntax error in fixed argument declaration."))
- (if (not (every? ext-decl? optionals))
- (error "Syntax error in optional argument declaration."))
- (if (not (every? ext-decl? keys))
- (error "Syntax error in keyword argument declaration."))
- (if (not (or (symbol? rest-arg) (eq? #f rest-arg)))
- (error "Syntax error in rest argument declaration."))
- ;; generate the code.
- (let ((rest-gensym (or rest-arg (gensym "lambda*:G")))
- (lambda-gensym (gensym "lambda*:L")))
- (if (not (and (null? optionals) (null? keys)))
- `(let ((,lambda-gensym
- (lambda (,@non-optional-args . ,rest-gensym)
- ;; Make sure that if the proc had a docstring, we put it
- ;; here where it will be visible.
- ,@(if (and (not (null? BODY))
- (string? (car BODY)))
- (list (car BODY))
- '())
- (let-optional*
- ,rest-gensym
- ,optionals
- (let-keywords* ,rest-gensym
- ,aok?
- ,keys
- ,@(if (and (not rest-arg) (null? keys))
- `((if (not (null? ,rest-gensym))
- (error "Too many arguments.")))
- '())
- (let ()
- ,@BODY))))))
- (set-procedure-property! ,lambda-gensym 'arglist
- '(,non-optional-args
- ,optionals
- ,keys
- ,aok?
- ,rest-arg))
- ,lambda-gensym)
- `(lambda (,@non-optional-args . ,(if rest-arg rest-arg '()))
- ,@BODY))))))
-
-
-(define (every? pred lst)
- (or (null? lst)
- (and (pred (car lst))
- (every? pred (cdr lst)))))
-
-(define (ext-decl? obj)
- (or (symbol? obj)
- (and (list? obj) (= 2 (length obj)) (symbol? (car obj)))))
-
-;; XXX - not tail recursive
-(define (improper-list-copy obj)
- (if (pair? obj)
- (cons (car obj) (improper-list-copy (cdr obj)))
- obj))
-
-(define (parse-arglist arglist cont)
- (define (split-list-at val lst cont)
- (cond
- ((memq val lst)
- => (lambda (pos)
- (if (memq val (cdr pos))
- (error (with-output-to-string
- (lambda ()
- (map display `(,val
- " specified more than once in argument list.")))))
- (cont (reverse (cdr (memq val (reverse lst)))) (cdr pos) #t))))
- (else (cont lst '() #f))))
- (define (parse-opt-and-fixed arglist keys aok? rest cont)
- (split-list-at
- #:optional arglist
- (lambda (before after split?)
- (if (and split? (null? after))
- (error "#:optional specified but no optional arguments declared.")
- (cont before after keys aok? rest)))))
- (define (parse-keys arglist rest cont)
- (split-list-at
- #:allow-other-keys arglist
- (lambda (aok-before aok-after aok-split?)
- (if (and aok-split? (not (null? aok-after)))
- (error "#:allow-other-keys not at end of keyword argument declarations.")
- (split-list-at
- #:key aok-before
- (lambda (key-before key-after key-split?)
- (cond
- ((and aok-split? (not key-split?))
- (error "#:allow-other-keys specified but no keyword arguments declared."))
- (key-split?
- (cond
- ((null? key-after) (error "#:key specified but no keyword arguments declared."))
- ((memq #:optional key-after) (error "#:optional arguments declared after #:key arguments."))
- (else (parse-opt-and-fixed key-before key-after aok-split? rest cont))))
- (else (parse-opt-and-fixed arglist '() #f rest cont)))))))))
- (define (parse-rest arglist cont)
- (cond
- ((null? arglist) (cont '() '() '() #f #f))
- ((not (pair? arglist)) (cont '() '() '() #f arglist))
- ((not (list? arglist))
- (let* ((copy (improper-list-copy arglist))
- (lp (last-pair copy))
- (ra (cdr lp)))
- (set-cdr! lp '())
- (if (memq #:rest copy)
- (error "Cannot specify both #:rest and dotted rest argument.")
- (parse-keys copy ra cont))))
- (else (split-list-at
- #:rest arglist
- (lambda (before after split?)
- (if split?
- (case (length after)
- ((0) (error "#:rest not followed by argument."))
- ((1) (parse-keys before (car after) cont))
- (else (error "#:rest argument must be declared last.")))
- (parse-keys before #f cont)))))))
-
- (parse-rest arglist cont))
-
-
-
-;; define* args . body
-;; define*-public args . body
-;; define and define-public extended for optional and keyword arguments
-;;
-;; define* and define*-public support optional arguments with
-;; a similar syntax to lambda*. They also support arbitrary-depth
-;; currying, just like Guile's define. Some examples:
-;; (define* (x y #:optional a (z 3) #:key w . u) (display (list y z u)))
-;; defines a procedure x with a fixed argument y, an optional agument
-;; a, another optional argument z with default value 3, a keyword argument w,
-;; and a rest argument u.
-;; (define-public* ((foo #:optional bar) #:optional baz) '())
-;; This illustrates currying. A procedure foo is defined, which,
-;; when called with an optional argument bar, returns a procedure that
-;; takes an optional argument baz.
-;;
-;; Of course, define*[-public] also supports #:rest and #:allow-other-keys
-;; in the same way as lambda*.
-
-(defmacro define* (ARGLIST . BODY)
- (define*-guts 'define ARGLIST BODY))
-
-(defmacro define*-public (ARGLIST . BODY)
- (define*-guts 'define-public ARGLIST BODY))
-
-;; The guts of define* and define*-public.
-(define (define*-guts DT ARGLIST BODY)
- (define (nest-lambda*s arglists)
- (if (null? arglists)
- BODY
- `((lambda* ,(car arglists) ,@(nest-lambda*s (cdr arglists))))))
- (define (define*-guts-helper ARGLIST arglists)
- (let ((first (car ARGLIST))
- (al (cons (cdr ARGLIST) arglists)))
- (if (symbol? first)
- `(,DT ,first ,@(nest-lambda*s al))
- (define*-guts-helper first al))))
- (if (symbol? ARGLIST)
- `(,DT ,ARGLIST ,@BODY)
- (define*-guts-helper ARGLIST '())))
-
-
-
-;; defmacro* name args . body
-;; defmacro*-public args . body
-;; defmacro and defmacro-public extended for optional and keyword arguments
-;;
-;; These are just like defmacro and defmacro-public except that they
-;; take lambda*-style extended paramter lists, where #:optional,
-;; #:key, #:allow-other-keys and #:rest are allowed with the usual
-;; semantics. Here is an example of a macro with an optional argument:
-;; (defmacro* transmorgify (a #:optional b)
-
-(defmacro defmacro* (NAME ARGLIST . BODY)
- `(define-macro ,NAME #f (lambda* ,ARGLIST ,@BODY)))
-
-(defmacro defmacro*-public (NAME ARGLIST . BODY)
- `(begin
- (defmacro* ,NAME ,ARGLIST ,@BODY)
- (export-syntax ,NAME)))
-
-;;; Support for optional & keyword args with the interpreter.
-(define *uninitialized* (list 'uninitialized))
-(define (parse-lambda-case spec inits predicate args)
- (pmatch spec
- ((,nreq ,nopt ,rest-idx ,nargs ,allow-other-keys? ,kw-indices)
- (define (req args prev tail n)
- (cond
- ((zero? n)
- (if prev (set-cdr! prev '()))
- (let ((slots-tail (make-list (- nargs nreq) *uninitialized*)))
- (opt (if prev (append! args slots-tail) slots-tail)
- slots-tail tail nopt inits)))
- ((null? tail)
- #f) ;; fail
- (else
- (req args tail (cdr tail) (1- n)))))
- (define (opt slots slots-tail args-tail n inits)
- (cond
- ((zero? n)
- (rest-or-key slots slots-tail args-tail inits rest-idx))
- ((null? args-tail)
- (set-car! slots-tail (apply (car inits) slots))
- (opt slots (cdr slots-tail) '() (1- n) (cdr inits)))
- (else
- (set-car! slots-tail (car args-tail))
- (opt slots (cdr slots-tail) (cdr args-tail) (1- n) (cdr inits)))))
- (define (rest-or-key slots slots-tail args-tail inits rest-idx)
- (cond
- (rest-idx
- ;; it has to be this way, vars are allocated in this order
- (set-car! slots-tail args-tail)
- (if (pair? kw-indices)
- (key slots (cdr slots-tail) args-tail inits)
- (rest-or-key slots (cdr slots-tail) '() inits #f)))
- ((pair? kw-indices)
- ;; fail early here, because once we're in keyword land we throw
- ;; errors instead of failing
- (and (or (null? args-tail) rest-idx (keyword? (car args-tail)))
- (key slots slots-tail args-tail inits)))
- ((pair? args-tail)
- #f) ;; fail
- (else
- (pred slots))))
- (define (key slots slots-tail args-tail inits)
- (cond
- ((null? args-tail)
- (if (null? inits)
- (pred slots)
- (begin
- (if (eq? (car slots-tail) *uninitialized*)
- (set-car! slots-tail (apply (car inits) slots)))
- (key slots (cdr slots-tail) '() (cdr inits)))))
- ((not (keyword? (car args-tail)))
- (if rest-idx
- ;; no error checking, everything goes to the rest..
- (key slots slots-tail '() inits)
- (error "bad keyword argument list" args-tail)))
- ((and (keyword? (car args-tail))
- (pair? (cdr args-tail))
- (assq-ref kw-indices (car args-tail)))
- => (lambda (i)
- (list-set! slots i (cadr args-tail))
- (key slots slots-tail (cddr args-tail) inits)))
- ((and (keyword? (car args-tail))
- (pair? (cdr args-tail))
- allow-other-keys?)
- (key slots slots-tail (cddr args-tail) inits))
- (else (error "unrecognized keyword" args-tail))))
- (define (pred slots)
- (cond
- (predicate
- (if (apply predicate slots)
- slots
- #f))
- (else slots)))
- (let ((args (list-copy args)))
- (req args #f args nreq)))
- (else (error "unexpected spec" spec))))
diff --git a/module/mes/test.scm b/module/mes/test.scm
index a066095b..9b6ded76 100644
--- a/module/mes/test.scm
+++ b/module/mes/test.scm
@@ -36,6 +36,7 @@
result
seq? ; deprecated
sequal? ; deprecated
+ sequal2? ;deprecated
))
(cond-expand
diff --git a/tests/base.test b/tests/base.test
index 37a459ec..0dedbf49 100755
--- a/tests/base.test
+++ b/tests/base.test
@@ -1,9 +1,9 @@
#! /bin/sh
-# -*-scheme-*-
+-*-scheme-*-
if [ "$MES" != guile ]; then
- MES_BOOT=boot-03.scm exec ${MES-mes} < $0
+ MES_BOOT=boot-03.scm exec ${MES-bin/mes} < $0
fi
-exec ${MES-mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests boot)' -s "$0" "$@"
+exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests boot)' -s "$0" "$@"
!#
;;; -*-scheme-*-
diff --git a/tests/boot.test b/tests/boot.test
index 97a0ee18..97f22066 100755
--- a/tests/boot.test
+++ b/tests/boot.test
@@ -1,7 +1,7 @@
#! /bin/sh
# -*-scheme-*-
if [ "$MES" != guile ]; then
- MES_BOOT=boot-02.scm exec ${MES-mes} < $0
+ MES_BOOT=boot-02.scm exec ${MES-bin/mes} < $0
fi
exec ${MES-mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests boot)' -s "$0" "$@"
!#
diff --git a/tests/catch.test b/tests/catch.test
index a4510369..6861086e 100755
--- a/tests/catch.test
+++ b/tests/catch.test
@@ -1,12 +1,14 @@
#! /bin/sh
# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests catch)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan (janneke) Nieuwenhuizen
+;;; Copyright © 2016,2020 Jan (janneke) Nieuwenhuizen
;;;
;;; This file is part of GNU Mes.
;;;
@@ -24,12 +26,8 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
;;; along with GNU Mes. If not, see .
(define-module (tests base)
- #:use-module (mes mes-0)
#:use-module (mes test))
-(mes-use-module (mes catch))
-(mes-use-module (mes test))
-
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
diff --git a/tests/closure.test b/tests/closure.test
index 36d001ab..3a36d436 100755
--- a/tests/closure.test
+++ b/tests/closure.test
@@ -1,12 +1,14 @@
#! /bin/sh
# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests closure)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen
+;;; Copyright © 2016,2018,2020 Jan (janneke) Nieuwenhuizen
;;;
;;; This file is part of GNU Mes.
;;;
@@ -24,11 +26,8 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
;;; along with GNU Mes. If not, see .
(define-module (tests closure)
- #:use-module (mes mes-0)
#:use-module (mes test))
-(mes-use-module (mes test))
-
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
diff --git a/tests/cwv.test b/tests/cwv.test
index b58c6e60..05c9f011 100755
--- a/tests/cwv.test
+++ b/tests/cwv.test
@@ -1,12 +1,14 @@
#! /bin/sh
# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests cwv)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan (janneke) Nieuwenhuizen
+;;; Copyright © 2016,2020 Jan (janneke) Nieuwenhuizen
;;;
;;; This file is part of GNU Mes.
;;;
@@ -27,9 +29,6 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
#:use-module (mes mes-0)
#:use-module (mes test))
-(mes-use-module (mes scm))
-(mes-use-module (mes test))
-
(if (not guile-1.8?)
(pass-if "values" (seq? (values 0 1) 0)))
(if (not guile-1.8?)
diff --git a/tests/display.test b/tests/display.test
index e17e8ab9..e932cd63 100755
--- a/tests/display.test
+++ b/tests/display.test
@@ -1,11 +1,14 @@
#! /bin/sh
+# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests display)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen
+;;; Copyright © 2016,2018,2020 Jan (janneke) Nieuwenhuizen
;;;
;;; This file is part of GNU Mes.
;;;
@@ -26,10 +29,6 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
#:use-module (mes mes-0)
#:use-module (mes test))
-(mes-use-module (mes display))
-(mes-use-module (mes guile))
-(mes-use-module (mes test))
-
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
diff --git a/tests/fluids.test b/tests/fluids.test
index 76e54e66..92a7c90c 100755
--- a/tests/fluids.test
+++ b/tests/fluids.test
@@ -1,5 +1,7 @@
#! /bin/sh
# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests fluids)' -s "$0" "$@"
!#
@@ -27,9 +29,6 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
#:use-module (mes mes-0)
#:use-module (mes test))
-(mes-use-module (mes fluids))
-(mes-use-module (mes test))
-
(define a (make-fluid))
(define b (make-fluid))
(define c #f)
diff --git a/tests/getopt-long.test b/tests/getopt-long.test
index 84d0d024..61e0f02f 100755
--- a/tests/getopt-long.test
+++ b/tests/getopt-long.test
@@ -1,4 +1,7 @@
#! /bin/sh
+# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests getopt-long)' -s "$0" "$@"
!#
@@ -23,15 +26,8 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
;;; along with GNU Mes. If not, see .
(define-module (tests getopt-long)
- #:use-module (mes mes-0)
- #:use-module (mes test)
- #:use-module (mes getopt-long))
-
-(cond-expand
- (mes
- (mes-use-module (mes getopt-long))
- (mes-use-module (mes test)))
- (else))
+ #:use-module (ice-9 getopt-long)
+ #:use-module (mes test))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
diff --git a/tests/guile.test b/tests/guile.test
index 5804ee2f..1ec3989c 100755
--- a/tests/guile.test
+++ b/tests/guile.test
@@ -1,5 +1,7 @@
#! /bin/sh
# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests guile)' -s "$0" "$@"
!#
@@ -26,15 +28,8 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
(define-module (tests guile)
#:use-module (ice-9 rdelim)
#:use-module (mes mes-0)
- #:use-module (mes misc)
#:use-module (mes test))
-(cond-expand
- (mes
- (mes-use-module (mes test))
- (mes-use-module (mes guile)))
- (else))
-
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
diff --git a/tests/let-syntax.test b/tests/let-syntax.test
index 52156b6d..bffcffe7 100755
--- a/tests/let-syntax.test
+++ b/tests/let-syntax.test
@@ -1,5 +1,7 @@
#! /bin/sh
# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests let-syntax)' -s "$0" "$@"
!#
@@ -24,12 +26,8 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
;;; along with GNU Mes. If not, see .
(define-module (tests let-syntax)
- #:use-module (mes mes-0)
#:use-module (mes test))
-(mes-use-module (mes syntax))
-(mes-use-module (mes test))
-
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
diff --git a/tests/let.test b/tests/let.test
index c7682c3a..0c936248 100755
--- a/tests/let.test
+++ b/tests/let.test
@@ -1,5 +1,7 @@
#! /bin/sh
# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests let)' -s "$0" "$@"
!#
@@ -24,12 +26,8 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
;;; along with GNU Mes. If not, see .
(define-module (tests let)
- #:use-module (mes mes-0)
#:use-module (mes test))
-(mes-use-module (mes let))
-(mes-use-module (mes test))
-
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
diff --git a/tests/match.test b/tests/match.test
index 83ee16a2..3d2d5f4f 100755
--- a/tests/match.test
+++ b/tests/match.test
@@ -1,5 +1,7 @@
#! /bin/sh
# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests match)' -s "$0" "$@"
!#
diff --git a/tests/math.test b/tests/math.test
index 157b55e5..ee23962a 100755
--- a/tests/math.test
+++ b/tests/math.test
@@ -1,5 +1,7 @@
#! /bin/sh
# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests math)' -s "$0" "$@"
!#
@@ -24,10 +26,8 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
;;; along with GNU Mes. If not, see .
(define-module (tests math)
- #:use-module (mes mes-0)
#:use-module (mes test))
-(mes-use-module (mes test))
(pass-if-equal "string->number" 42 (string->number "42"))
(pass-if-equal "string->number neg" -42 (string->number "-42"))
(pass-if-equal "string->number #hex" 170 (string->number "#xaa"))
diff --git a/tests/optargs.test b/tests/optargs.test
index 4709e1da..9eed2a1b 100755
--- a/tests/optargs.test
+++ b/tests/optargs.test
@@ -1,5 +1,7 @@
#! /bin/sh
# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests optargs)' -s "$0" "$@"
!#
@@ -24,16 +26,9 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
;;; along with GNU Mes. If not, see .
(define-module (tests optargs)
- #:use-module (mes optargs)
- #:use-module (mes mes-0)
+ #:use-module (ice-9 optargs)
#:use-module (mes test))
-(cond-expand
- (mes
- (mes-use-module (mes optargs))
- (mes-use-module (mes test)))
- (else))
-
(pass-if-equal "cond =>" 10
(cond
(5 => (lambda (p) (* p 2)))))
diff --git a/tests/posix.test b/tests/posix.test
index f231ed9f..07a43802 100755
--- a/tests/posix.test
+++ b/tests/posix.test
@@ -1,5 +1,7 @@
#! /bin/sh
# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests srfi-13)' -s "$0" "$@"
!#
@@ -27,9 +29,6 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
#:use-module (mes mes-0)
#:use-module (mes test))
-(mes-use-module (srfi srfi-13))
-(mes-use-module (mes test))
-
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
diff --git a/tests/srfi-1.test b/tests/srfi-1.test
index da90b71f..4a95a625 100755
--- a/tests/srfi-1.test
+++ b/tests/srfi-1.test
@@ -1,5 +1,7 @@
#! /bin/sh
# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests srfi-1)' -s "$0" "$@"
!#
@@ -28,9 +30,6 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
#:use-module (mes mes-0)
#:use-module (mes test))
-(mes-use-module (srfi srfi-1))
-(mes-use-module (mes test))
-
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
diff --git a/tests/srfi-13.test b/tests/srfi-13.test
index 14280b62..d6537ad2 100755
--- a/tests/srfi-13.test
+++ b/tests/srfi-13.test
@@ -1,5 +1,7 @@
#! /bin/sh
# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests srfi-13)' -s "$0" "$@"
!#
@@ -27,9 +29,6 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
#:use-module (mes mes-0)
#:use-module (mes test))
-(mes-use-module (srfi srfi-13))
-(mes-use-module (mes test))
-
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
diff --git a/tests/srfi-14.test b/tests/srfi-14.test
index 1cf24882..1009690e 100755
--- a/tests/srfi-14.test
+++ b/tests/srfi-14.test
@@ -1,5 +1,7 @@
#! /bin/sh
# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests srfi-14)' -s "$0" "$@"
!#
@@ -28,9 +30,6 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
#:use-module (mes mes-0)
#:use-module (mes test))
-(mes-use-module (srfi srfi-14))
-(mes-use-module (mes test))
-
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
diff --git a/tests/srfi-16.test b/tests/srfi-16.test
index 8da5ba15..93a49f9c 100755
--- a/tests/srfi-16.test
+++ b/tests/srfi-16.test
@@ -1,5 +1,7 @@
#! /bin/sh
# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests srfi-16)' -s "$0" "$@"
!#
@@ -24,12 +26,8 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
;;; along with GNU Mes. If not, see .
(define-module (tests srfi-16)
- #:use-module (mes mes-0)
#:use-module (mes test))
-(mes-use-module (srfi srfi-16))
-(mes-use-module (mes test))
-
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
diff --git a/tests/srfi-43.test b/tests/srfi-43.test
index 8d89ead8..4775aea3 100755
--- a/tests/srfi-43.test
+++ b/tests/srfi-43.test
@@ -1,12 +1,14 @@
#! /bin/sh
# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests srfi-43)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen
+;;; Copyright © 2018,2020 Jan (janneke) Nieuwenhuizen
;;;
;;; This file is part of GNU Mes.
;;;
@@ -25,12 +27,8 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
(define-module (tests srfi-43)
#:use-module (srfi srfi-43)
- #:use-module (mes mes-0)
#:use-module (mes test))
-(mes-use-module (srfi srfi-43))
-(mes-use-module (mes test))
-
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
diff --git a/tests/srfi-9.test b/tests/srfi-9.test
index 89d090bc..1a840c2e 100755
--- a/tests/srfi-9.test
+++ b/tests/srfi-9.test
@@ -38,15 +38,7 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
;; bootstrap test
(primitive-load "module/mes/test.scm")
(primitive-load "mes/module/srfi/srfi-9-struct.mes")
- (primitive-load "mes/module/srfi/srfi-9/gnu-struct.mes")
- (define-macro (mes-use-module . rest) #t)
-
- ;; (primitive-load "mes/module/srfi/srfi-9-vector.mes")
- ;; (primitive-load "mes/module/srfi/srfi-9/gnu-vector.mes")
-
- (mes-use-module (srfi srfi-9))
- (mes-use-module (srfi srfi-9 gnu))
- (mes-use-module (mes test)))
+ (primitive-load "mes/module/srfi/srfi-9/gnu-struct.mes"))
(else))
(pass-if "first dummy" #t)
diff --git a/tests/syntax.test b/tests/syntax.test
index 8e5c4005..b1c459fe 100755
--- a/tests/syntax.test
+++ b/tests/syntax.test
@@ -1,5 +1,7 @@
#! /bin/sh
# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests syntax)' -s "$0" "$@"
!#
@@ -27,9 +29,6 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
#:use-module (mes mes-0)
#:use-module (mes test))
-(mes-use-module (mes test))
-(mes-use-module (mes syntax))
-
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
diff --git a/tests/vector.test b/tests/vector.test
index 4f51489d..1c0d6fdb 100755
--- a/tests/vector.test
+++ b/tests/vector.test
@@ -1,5 +1,7 @@
#! /bin/sh
# -*-scheme-*-
+MES_BOOT=boot-5.mes
+export MES_BOOT
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests vector)' -s "$0" "$@"
!#
@@ -27,9 +29,6 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
#:use-module (mes mes-0)
#:use-module (mes test))
-(mes-use-module (mes scm))
-(mes-use-module (mes test))
-
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)