mes: Add incremental test suite.
authorJan Nieuwenhuizen <janneke@gnu.org>
Thu, 25 Jan 2018 05:58:44 +0000 (06:58 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Thu, 25 Jan 2018 05:58:44 +0000 (06:58 +0100)
* check-boot.sh: New file.
* check.sh: Invoke it.
* module/srfi/srfi-16.mes: New file.
* scaffold/boot/00-zero.scm: New file.
* scaffold/boot/01-true.scm: New file.
* scaffold/boot/02-symbol.scm: New file.
* scaffold/boot/03-string.scm: New file.
* scaffold/boot/04-cons.scm: New file.
* scaffold/boot/04-quote.scm: New file.
* scaffold/boot/05-list.scm: New file.
* scaffold/boot/06-tick.scm: New file.
* scaffold/boot/07-if.scm: New file.
* scaffold/boot/08-if-if.scm: New file.
* scaffold/boot/10-cons.scm: New file.
* scaffold/boot/11-list.scm: New file.
* scaffold/boot/12-car.scm: New file.
* scaffold/boot/13-cdr.scm: New file.
* scaffold/boot/14-exit.scm: New file.
* scaffold/boot/15-display.scm: New file.
* scaffold/boot/16-if-eq-quote.scm: New file.
* scaffold/boot/20-define-quote.scm: New file.
* scaffold/boot/20-define-quoted.scm: New file.
* scaffold/boot/20-define.scm: New file.
* scaffold/boot/21-define-procedure.scm: New file.
* scaffold/boot/22-define-procedure-2.scm: New file.
* scaffold/boot/23-begin.scm: New file.
* scaffold/boot/24-begin-define.scm: New file.
* scaffold/boot/25-begin-define-2.scm: New file.
* scaffold/boot/26-begin-define-later.scm: New file.
* scaffold/boot/26-define-define.scm: New file.
* scaffold/boot/27-lambda-define.scm: New file.
* scaffold/boot/28-define-define.scm: New file.
* scaffold/boot/29-lambda-define.scm: New file.
* scaffold/boot/2a-lambda-lambda.scm: New file.
* scaffold/boot/2b-define-lambda.scm: New file.
* scaffold/boot/2c-define-lambda-recurse.scm: New file.
* scaffold/boot/2d-define-lambda-set.scm: New file.
* scaffold/boot/2e-define-second.scm: New file.
* scaffold/boot/30-capture.scm: New file.
* scaffold/boot/31-capture-define.scm: New file.
* scaffold/boot/32-capture-modify-close.scm: New file.
* scaffold/boot/33-procedure-override-close.scm: New file.
* scaffold/boot/34-cdr-override-close.scm: New file.
* scaffold/boot/35-closure-modify.scm: New file.
* scaffold/boot/36-closure-override.scm: New file.
* scaffold/boot/37-closure-lambda.scm: New file.
* scaffold/boot/38-simple-format.scm: New file.
* scaffold/boot/40-define-macro.scm: New file.
* scaffold/boot/41-when.scm: New file.
* scaffold/boot/42-if-when.scm: New file.
* scaffold/boot/43-or.scm: New file.
* scaffold/boot/44-or-if.scm: New file.
* scaffold/boot/45-pass-if.scm: New file.
* scaffold/boot/46-report.scm: New file.
* scaffold/boot/47-pass-if-eq.scm: New file.
* scaffold/boot/48-let.scm: New file.
* scaffold/boot/49-macro-override.scm: New file.
* scaffold/boot/4a-define-macro-define-macro.scm: New file.
* scaffold/boot/4b-define-macro-define.scm: New file.
* scaffold/boot/4c-quasiquote.scm: New file.
* scaffold/boot/50-primitive-load.scm: New file.
* scaffold/boot/51-module.scm: New file.
* scaffold/boot/52-define-module.scm: New file.
* scaffold/boot/53-closure-display.scm: New file.
* scaffold/boot/60-let-syntax.scm: New file.
* scaffold/boot/closure.scm: New file.
* scaffold/boot/compose.scm: New file.
* scaffold/boot/data/bar.mes: New file.
* scaffold/boot/data/i.scm: New file.
* scaffold/boot/data/module.mes: New file.
* scaffold/boot/foo.scm: New file.
* scaffold/boot/lambda-star.scm: New file.
* scaffold/boot/vector.scm: New file.
* tests/boot.test: New file.
* tests/boot.test-guile: New file.
* tests/srfi-16.test: New file.
* tests/srfi-16.test-guile: New file.

104 files changed:
check-boot.sh [new file with mode: 0755]
check-mescc.sh
check.sh
guile/mes-0.scm
make.scm
module/mes/base-0.mes
module/mes/guile.scm
module/mes/match.scm
module/mes/module.mes
module/mes/test.mes
module/srfi/srfi-16.mes
scaffold/boot/00-zero.scm [new file with mode: 0644]
scaffold/boot/01-true.scm [new file with mode: 0644]
scaffold/boot/02-symbol.scm [new file with mode: 0644]
scaffold/boot/03-string.scm [new file with mode: 0644]
scaffold/boot/04-cons.scm [new file with mode: 0644]
scaffold/boot/04-quote.scm [new file with mode: 0644]
scaffold/boot/05-list.scm [new file with mode: 0644]
scaffold/boot/06-tick.scm [new file with mode: 0644]
scaffold/boot/07-if.scm [new file with mode: 0644]
scaffold/boot/08-if-if.scm [new file with mode: 0644]
scaffold/boot/10-cons.scm [new file with mode: 0644]
scaffold/boot/11-list.scm [new file with mode: 0644]
scaffold/boot/12-car.scm [new file with mode: 0644]
scaffold/boot/13-cdr.scm [new file with mode: 0644]
scaffold/boot/14-exit.scm [new file with mode: 0644]
scaffold/boot/15-display.scm [new file with mode: 0644]
scaffold/boot/16-if-eq-quote.scm [new file with mode: 0644]
scaffold/boot/20-define-quote.scm [new file with mode: 0644]
scaffold/boot/20-define-quoted.scm [new file with mode: 0644]
scaffold/boot/20-define.scm [new file with mode: 0644]
scaffold/boot/21-define-procedure.scm [new file with mode: 0644]
scaffold/boot/22-define-procedure-2.scm [new file with mode: 0644]
scaffold/boot/23-begin.scm [new file with mode: 0644]
scaffold/boot/24-begin-define.scm [new file with mode: 0644]
scaffold/boot/25-begin-define-2.scm [new file with mode: 0644]
scaffold/boot/26-begin-define-later.scm [new file with mode: 0644]
scaffold/boot/26-define-define.scm [new file with mode: 0644]
scaffold/boot/27-lambda-define.scm [new file with mode: 0644]
scaffold/boot/28-define-define.scm [new file with mode: 0644]
scaffold/boot/29-lambda-define.scm [new file with mode: 0644]
scaffold/boot/2a-lambda-lambda.scm [new file with mode: 0644]
scaffold/boot/2b-define-lambda.scm [new file with mode: 0644]
scaffold/boot/2c-define-lambda-recurse.scm [new file with mode: 0644]
scaffold/boot/2d-compose.scm [new file with mode: 0644]
scaffold/boot/2d-define-lambda-set.scm [new file with mode: 0644]
scaffold/boot/2e-define-first.scm [new file with mode: 0644]
scaffold/boot/2f-define-second-lambda.scm [new file with mode: 0644]
scaffold/boot/2f-define-second.scm [new file with mode: 0644]
scaffold/boot/2g-vector.scm [new file with mode: 0644]
scaffold/boot/30-capture.scm [new file with mode: 0644]
scaffold/boot/31-capture-define.scm [new file with mode: 0644]
scaffold/boot/32-capture-modify-close.scm [new file with mode: 0644]
scaffold/boot/33-procedure-override-close.scm [new file with mode: 0644]
scaffold/boot/34-cdr-override-close.scm [new file with mode: 0644]
scaffold/boot/35-closure-modify.scm [new file with mode: 0644]
scaffold/boot/36-closure-override.scm [new file with mode: 0644]
scaffold/boot/37-closure-lambda.scm [new file with mode: 0644]
scaffold/boot/38-simple-format.scm [new file with mode: 0644]
scaffold/boot/39-global-define-override.scm [new file with mode: 0644]
scaffold/boot/3a-global-define-lambda-override.scm [new file with mode: 0644]
scaffold/boot/40-define-macro.scm [new file with mode: 0644]
scaffold/boot/41-when.scm [new file with mode: 0644]
scaffold/boot/42-if-when.scm [new file with mode: 0644]
scaffold/boot/43-or.scm [new file with mode: 0644]
scaffold/boot/44-or-if.scm [new file with mode: 0644]
scaffold/boot/45-pass-if.scm [new file with mode: 0644]
scaffold/boot/46-report.scm [new file with mode: 0644]
scaffold/boot/47-pass-if-eq.scm [new file with mode: 0644]
scaffold/boot/48-let.scm [new file with mode: 0644]
scaffold/boot/49-macro-override.scm [new file with mode: 0644]
scaffold/boot/4a-define-macro-define-macro.scm [new file with mode: 0644]
scaffold/boot/4b-define-macro-define.scm [new file with mode: 0644]
scaffold/boot/4c-quasiquote.scm [new file with mode: 0644]
scaffold/boot/4d-let-map.scm [new file with mode: 0644]
scaffold/boot/4e-let-global.scm [new file with mode: 0644]
scaffold/boot/4e-string-split.scm [new file with mode: 0644]
scaffold/boot/50-primitive-load.scm [new file with mode: 0644]
scaffold/boot/51-module.scm [new file with mode: 0644]
scaffold/boot/52-define-module.scm [new file with mode: 0644]
scaffold/boot/53-closure-display.scm [new file with mode: 0644]
scaffold/boot/60-let-syntax.scm [new file with mode: 0644]
scaffold/boot/data/bar.mes [new file with mode: 0644]
scaffold/boot/data/i.scm [new file with mode: 0644]
scaffold/boot/data/module.mes [new file with mode: 0644]
scaffold/cons-mes.c [new file with mode: 0644]
scaffold/mini-mes.c [new file with mode: 0644]
scaffold/t-0.mes [deleted file]
scaffold/tiny-mes.c [new file with mode: 0644]
tests/base.test
tests/boot.test [new file with mode: 0755]
tests/boot.test-guile [new symlink]
tests/closure.test
tests/let-syntax.test
tests/let.test
tests/match.test
tests/optargs.test
tests/quasiquote.test
tests/record.test
tests/scm.test
tests/srfi-16.test [new file with mode: 0755]
tests/srfi-16.test-guile [new symlink]
tests/syntax.test
tests/vector.test

diff --git a/check-boot.sh b/check-boot.sh
new file mode 100755 (executable)
index 0000000..b8719ef
--- /dev/null
@@ -0,0 +1,125 @@
+#! /bin/bash
+
+# Mes --- Maxwell Equations of Software
+# Copyright © 2018 Jan 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/>.
+
+set -e
+
+export GUILE=${GUILE-guile}
+export MES=${MES-./mes}
+
+tests="
+
+00-zero.scm
+01-true.scm
+02-symbol.scm
+03-string.scm
+04-quote.scm
+05-list.scm
+06-tick.scm
+07-if.scm
+08-if-if.scm
+
+10-cons.scm
+11-list.scm
+12-car.scm
+13-cdr.scm
+14-exit.scm
+15-display.scm
+
+16-if-eq-quote.scm
+
+20-define.scm
+20-define-quoted.scm
+20-define-quote.scm
+
+21-define-procedure.scm
+22-define-procedure-2.scm
+23-begin.scm
+24-begin-define.scm
+25-begin-define-2.scm
+26-begin-define-later.scm
+27-lambda-define.scm
+28-define-define.scm
+29-lambda-define.scm
+2a-lambda-lambda.scm
+2b-define-lambda.scm
+2c-define-lambda-recurse.scm
+2d-define-lambda-set.scm
+2d-compose.scm
+2e-define-first.scm
+2f-define-second.scm
+2f-define-second-lambda.scm
+2g-vector.scm
+
+30-capture.scm
+31-capture-define.scm
+32-capture-modify-close.scm
+32-capture-modify-close.scm
+33-procedure-override-close.scm
+34-cdr-override-close.scm
+35-closure-modify.scm
+36-closure-override.scm
+37-closure-lambda.scm
+38-simple-format.scm
+39-global-define-override.scm
+3a-global-define-lambda-override.scm
+
+40-define-macro.scm
+41-when.scm
+42-if-when.scm
+43-or.scm
+44-or-if.scm
+45-pass-if.scm
+46-report.scm
+47-pass-if-eq.scm
+48-let.scm
+49-macro-override.scm
+4a-define-macro-define-macro.scm
+4b-define-macro-define.scm
+4c-quasiquote.scm
+4d-let-map.scm
+4e-let-global.scm
+
+50-primitive-load.scm
+51-module.scm
+52-define-module.scm
+53-closure-display.scm
+
+60-let-syntax.scm
+"
+
+for i in $tests; do
+    echo -n $i
+    if [ ! -f scaffold/boot/$i ]; then
+        echo ' [SKIP]'
+        continue;
+    fi
+    guile -L guile -L . <(echo '(use-modules (mes guile))'; cat scaffold/boot/$i) >& /dev/null
+    x=$(
+        if [ -z "${i/5[0-9]-*/}" ]; then
+            cat scaffold/boot/$i | MES_BOOT=boot-00.scm $MES 2>&1;
+        elif [ -z "${i/6[0-9]-*/}" ]; then
+            cat scaffold/boot/$i | MES_BOOT=boot-01.scm $MES 2>&1;
+        else
+            MES_BOOT=scaffold/boot/$i $MES 2>&1;
+        fi
+     ) \
+        && echo ' [PASS]' \
+        || (r=$?; echo ' [FAIL]'; echo -e "$x"; echo scaffold/boot/$i; exit $r)
+done
index d71f27e9fdaa82541efe22aa6915bf94d3e90c45..382a7b286c2c65e837a61dc785737be1c655770c 100755 (executable)
@@ -20,7 +20,7 @@
 
 export MES=${MES-src/mes.gcc}
 export MESCC=${MESCC-scripts/mescc.mes}
-#export MES_ARENA=${MES_ARENA-200000000} > 12GB mem
+#export MES_ARENA=${MES_ARENA-200000000} #9GiB
 
 GUILE=${GUILE-guile}
 MES=${MES-./mes}
index b37c5cb512fb5d4eb4dcc274dffcb0782f788ae8..1cab61e6ace166fd8b6a222fd437db9596663241 100755 (executable)
--- a/check.sh
+++ b/check.sh
 
 export GUILE=${GUILE-guile}
 export MES=${MES-./mes}
+#export MES_ARENA=${MES_ARENA-200000000} #9GiB
+
+set -e
+bash check-boot.sh
 
 tests="
+tests/boot.test
 tests/read.test
 tests/base.test
-tests/closure.test
 tests/quasiquote.test
 tests/let.test
+tests/closure.test
 tests/scm.test
 tests/display.test
 tests/cwv.test
@@ -39,13 +44,13 @@ tests/optargs.test
 tests/fluids.test
 tests/catch.test
 tests/record.test
+tests/getopt-long.test
+tests/guile.test
 tests/syntax.test
-tests/pmatch.test
 tests/let-syntax.test
-tests/guile.test
-tests/getopt-long.test
-tests/psyntax.test
+tests/pmatch.test
 tests/match.test
+tests/psyntax.test
 "
 
 slow_or_broken="
@@ -58,6 +63,10 @@ set +e
 fail=0
 total=0
 for t in $tests; do
+    if [ ! -f $t ]; then
+        echo $t: [SKIP];
+        continue
+    fi
     sh "$t" &> $t.log
     r=$?
     total=$((total+1))
index 9b9076be6036e44582973b362f61beff6aecc5ed..c0f4e9dbcdc72714fbf1b501873248211adfbec6 100644 (file)
@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; mes-0.scm: This file is part of Mes.
 ;;;
@@ -33,3 +33,4 @@
 (define guile-2? (and (not mes?) (not guile-1.8?)))
 (if guile-1.8? (use-modules (ice-9 syncase)))
 (define EOF (if #f #f))
+(define append2 append)
index b2d8a800e30efd4fb675b708ade8f5cb3ca5afe8..6b6702d875d5cf1f4aab2d8ad6bd211e0ff6dff9 100755 (executable)
--- a/make.scm
+++ b/make.scm
@@ -460,11 +460,12 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
                        #:includes '("src")))
 
 (define mes-tests
-  '("tests/read.test"
+  '("tests/boot.test"
+    "tests/read.test"
     "tests/base.test"
-    "tests/closure.test"
     "tests/quasiquote.test"
     "tests/let.test"
+    "tests/closure.test"
     "tests/scm.test"
     "tests/display.test"
     "tests/cwv.test"
@@ -473,17 +474,18 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
     "tests/srfi-1.test"
     "tests/srfi-13.test"
     "tests/srfi-14.test"
+    "tests/srfi-16.test"
     "tests/optargs.test"
     "tests/fluids.test"
     "tests/catch.test"
     "tests/record.test"
+    "tests/getopt-long.test"
+    "tests/guile.test"
     "tests/syntax.test"
-    "tests/pmatch.test"
     "tests/let-syntax.test"
-    "tests/guile.test"
-    "tests/getopt-long.test"
-    "tests/psyntax.test"
+    "tests/pmatch.test"
     "tests/match.test"
+    "tests/psyntax.test"
     ;;sloooowwww/broken?
     ;;"tests/peg.test"
     ))
@@ -557,6 +559,7 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
    "module/mes/getopt-long.mes"
    "module/mes/getopt-long.scm"
    "module/mes/guile.mes"
+   "module/mes/guile.scm"
    "module/mes/lalr.mes"
    "module/mes/lalr.scm"
    "module/mes/let.mes"
index 3222a84e3d831bda0e4a73e0ba5aff27545b02d7..a8568e03b29a089cdf29503618a5bf65de822e37 100644 (file)
 
 (define else #t)
 
-(define (cadr x) (car (cdr x)))
-
-(define-macro (let bindings . rest)
-  (cons (cons 'lambda (cons (map1 car bindings) rest))
-        (map1 cadr bindings)))
-
-(define *input-ports* '())
-(define-macro (push! stack o)
-  (cons
-   'begin
-   (list
-    (list 'set! stack (list cons o stack))
-    stack)))
-(define-macro (pop! stack)
-  (list 'let (list (list 'o (list car stack)))
-        (list 'set! stack (list cdr stack))
-        'o))
 (define-macro (load file)
   (list 'begin
         (list 'if (list getenv "MES_DEBUG")
                     (list core:display-error ";;; read ")
                     (list core:display-error file)
                     (list core:display-error "\n")))
-     (list 'push! '*input-ports* (list current-input-port))
-     (list 'set-current-input-port (list open-input-file file))
-     (list 'primitive-load)
-     (list 'set-current-input-port (list 'pop! '*input-ports*))))
+     (list 'primitive-load file)))
 
-(define include load)
+(define-macro (include file) (list 'load file))
 
 (define (append . rest)
   (if (null? rest) '()
index 8e81a7e3ad5f0bcdaa7be0bbe57758f40bccdd9b..ca61412c46c2c36ff2915cefbde215447f25f0ab 100644 (file)
 ;;; Code:
 
 (define-module (mes guile)
-  #:export (core:display core:display-error)
+  #:export (
+            append2
+            core:apply
+            core:display
+            core:display-error
+            core:display-port
+            core:exit
+            core:macro-expand
+            core:write
+            core:write-error
+            core:write-port
+            core:type
+            )
   ;;#:re-export (open-input-file open-input-string with-input-from-string)
   )
 
 (cond-expand
  (guile
+  (define core:exit exit)
   (define core:display display)
+  (define core:display-port display)
   (define (core:display-error o) (display o (current-error-port)))
+  (define core:write write)
+  (define (core:write-error o) (write o (current-error-port)))
+  (define core:write-port write)
+  (define core:macro-expand identity)
+  (define (core:apply f a . m) (apply f a))
+  (define append2 append)
+
+  (define guile:keyword? keyword?)
+  (define guile:number? number?)
+  (define guile:pair? pair?)
+  (define guile:string? string?)
+  (define guile:symbol? symbol?)
+  (define (core:type x)
+    (define <cell:keyword> 4)
+    (define <cell:number> 6)
+    (define <cell:pair> 7)
+    (define <cell:string> 10)
+    (define <cell:symbol> 11)
+    (cond ((guile:keyword? x) <cell:keyword>)
+          ((guile:number? x) <cell:number>)
+          ((guile:pair? x) <cell:pair>)
+          ((guile:string? x) <cell:string>)
+          ((guile:symbol? x) <cell:symbol>)))
 
 ;;   (define core:open-input-file open-input-file)
 ;;   (define (open-input-file file)
index 1cdc3ebca7197dbedb2e0fd87f1cff009ffbeab5..a89cb9a449327fca473b2f9fa607c2827175d9b9 100644 (file)
     ((_ loop ((var init) ...) . body)
      (match-named-let loop ((var init) ...) . body))))
 
-;;> Similar to @scheme{match-let}, but analogously to @scheme{letrec}
-;;> matches and binds the variables with all match variables in scope.
-
-(define-syntax match-letrec
-  (syntax-rules ()
-    ((_ ((var value) ...) . body)
-     (match-let/helper letrec () () ((var value) ...) . body))))
-
-(define-syntax match-let/helper
-  (syntax-rules ()
-    ((_ let ((var expr) ...) () () . body)
-     (let ((var expr) ...) . body))
-    ((_ let ((var expr) ...) ((pat tmp) ...) () . body)
-     (let ((var expr) ...)
-       (match-let* ((pat tmp) ...)
-         . body)))
-    ((_ let (v ...) (p ...) (((a . b) expr) . rest) . body)
-     (match-let/helper
-      let (v ... (tmp expr)) (p ... ((a . b) tmp)) rest . body))
-    ((_ let (v ...) (p ...) ((#(a ...) expr) . rest) . body)
-     (match-let/helper
-      let (v ... (tmp expr)) (p ... (#(a ...) tmp)) rest . body))
-    ((_ let (v ...) (p ...) ((a expr) . rest) . body)
-     (match-let/helper let (v ... (a expr)) (p ...) rest . body))))
+;; ;;> Similar to @scheme{match-let}, but analogously to @scheme{letrec}
+;; ;;> matches and binds the variables with all match variables in scope.
+
+;; (define-syntax match-letrec
+;;   (syntax-rules ()
+;;     ((_ ((var value) ...) . body)
+;;      (match-let/helper letrec () () ((var value) ...) . body))))
+
+;; (define-syntax match-let/helper
+;;   (syntax-rules ()
+;;     ((_ let ((var expr) ...) () () . body)
+;;      (let ((var expr) ...) . body))
+;;     ((_ let ((var expr) ...) ((pat tmp) ...) () . body)
+;;      (let ((var expr) ...)
+;;        (match-let* ((pat tmp) ...)
+;;          . body)))
+;;     ((_ let (v ...) (p ...) (((a . b) expr) . rest) . body)
+;;      (match-let/helper
+;;       let (v ... (tmp expr)) (p ... ((a . b) tmp)) rest . body))
+;;     ((_ let (v ...) (p ...) ((#(a ...) expr) . rest) . body)
+;;      (match-let/helper
+;;       let (v ... (tmp expr)) (p ... (#(a ...) tmp)) rest . body))
+;;     ((_ let (v ...) (p ...) ((a expr) . rest) . body)
+;;      (match-let/helper let (v ... (a expr)) (p ...) rest . body))))
 
 (define-syntax match-named-let
   (syntax-rules ()
index b57bd32a3a5ba33ef4b315341226d44785d2744a..8e6fba854a14a3ece01ee667de8238c934922a92 100644 (file)
@@ -23,7 +23,7 @@
 ;;; Code:
 
 (define (module->file o)
-  (string-append (string-join (map1 symbol->string o) "/") ".mes"))
+  (string-append (string-join (map symbol->string o) "/") ".mes"))
 
 (define *modules* '(mes/base-0.mes))
 (define (mes-load-module-env module a)
index 8c46fb6a497add20746115f50aef30b749397567..98dc3286a74e6d1fb3727ef486be4905c39ecb87 100644 (file)
@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
 (define guile? (not (pair? (current-module))))
 
 (define result
-  (let ((pass 0)
-        (fail 0))
-    (lambda (. t)
-      (cond ((or (null? t) (eq? (car t) result)) (list pass fail))
-            ((eq? (car t) 'report)
-             (let ((expect (if (null? (cdr t)) 0 (cadr t))))
-               (newline)
-               (display "passed: ") (display pass) (newline)
-               (display "failed: ") (display fail) (newline)
-               (if (not (eq? expect 0)) (begin (display "expect: ") (display expect) (newline)))
-               (display "total: ") (display (+ pass fail)) (newline)
-               (exit (if (eq? expect fail) 0 fail))))
-            ((car t) (display ": pass") (newline) (set! pass (+ pass 1)))
-            (#t (display ": fail") (newline) (set! fail (+ fail 1)))))))
+  ((lambda (pass fail)
+     (lambda (. t)
+       (if (or (null? t) (eq? (car t) 'result)) (list pass fail)
+           (if (eq? (car t) 'report)
+               (begin
+                 ((lambda (expect)
+                    (begin (display "expect: ") (write expect) (newline))
+                    (newline)
+                    (display "passed: ") (display pass) (newline)
+                    (display "failed: ") (display fail) (newline)
+                    (if (not (eq? expect 0)) (begin (display "expect: ") (write expect) (newline)))
+                    (display "total: ") (display (+ pass fail)) (newline)
+                    (exit (if (eq? expect fail) 0 fail)))
+                  (if (null? (cdr t)) 0 (cadr t))))
+               (if (car t) (begin (display ": pass") (newline) (set! pass (+ pass 1)))
+                   (begin (display ": fail") (newline) (set! fail (+ fail 1))))))))
+   0 0))
 
-(define (seq? a b)
-  (or (eq? a b)
+(define (seq? expect a) ;;REMOVE ME
+  (or (eq? a expect)
       (begin
         (display ": fail")
         (newline)
         (display "expected: ")
-        (display b) (newline)
+        (display expect) (newline)
         (display "actual: ")
         (display a)
         (newline)
         #f)))
 
-(define (sequal? a b)
-  (or (equal? a b)
+(define (sequal? expect a) ;;REMOVE ME
+  (or (equal? a expect)
       (begin
         (display ": fail")
         (newline)
         (display "expected: ")
-        (display b) (newline)
+        (display expect) (newline)
         (display "actual: ")
         (display a)
         (newline)
         #f)))
 
-(define (sequal2? expect actual)
-  (or (equal? expect actual)
+(define (seq2? a expect)
+  (or (eq? a expect)
+      (begin
+        (display ": fail") (newline)
+        (display "expected: ") (display expect) (newline)
+        (display "actual: ") (display a) (newline)
+        #f)))
+
+(define (sequal2? actual expect)
+  (or (equal? actual expect)
       (begin
         (display ": fail") (newline)
         (display "expected: ") (display expect) (newline)
   (list
    'begin
    (list display "test: ") (list display name)
-   (list result t)))
+   (list 'result t))) ;; FIXME
+
+(define-macro (pass-if-eq name expect . body)
+  (list 'pass-if name (list seq2? (cons 'begin body) expect)))
 
 (define-macro (pass-if-equal name expect . body)
-  `(pass-if ,name (sequal2? ,expect (begin ,@body))))
+  (list 'pass-if name (list sequal2? (cons 'begin body) expect)))
 
 (define-macro (expect-fail name expect . body)
-  `(pass-if ,name (not (sequal2? ,expect (begin ,@body)))))
+  (list 'pass-if name (list not (list sequal2? (cons 'begin body) expect))))
 
 (define-macro (pass-if-not name f)
   (list
    'begin
    (list display "test: ") (list display name)
-   (list result (list not f))))
+   (list 'result (list not f)))) ;; FIXME
index 47bc2d22f99ce75cd53ed95c35a3682ec02ec7e4..879308167c2f572a9ece975173750b1fdb347aea 100644 (file)
@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -22,4 +22,6 @@
 
 ;;; Code:
 
+(define-macro (define-module module . rest) #t)
+(define (cond-expand-provide . rest) #t)
 (include-from-path "srfi/srfi-16.scm")
diff --git a/scaffold/boot/00-zero.scm b/scaffold/boot/00-zero.scm
new file mode 100644 (file)
index 0000000..b508a74
--- /dev/null
@@ -0,0 +1,19 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+0
diff --git a/scaffold/boot/01-true.scm b/scaffold/boot/01-true.scm
new file mode 100644 (file)
index 0000000..b3fbd59
--- /dev/null
@@ -0,0 +1,19 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+#t
diff --git a/scaffold/boot/02-symbol.scm b/scaffold/boot/02-symbol.scm
new file mode 100644 (file)
index 0000000..c393e80
--- /dev/null
@@ -0,0 +1,19 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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
diff --git a/scaffold/boot/03-string.scm b/scaffold/boot/03-string.scm
new file mode 100644 (file)
index 0000000..5e2eaa5
--- /dev/null
@@ -0,0 +1,19 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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"
diff --git a/scaffold/boot/04-cons.scm b/scaffold/boot/04-cons.scm
new file mode 100644 (file)
index 0000000..bf5c61f
--- /dev/null
@@ -0,0 +1,19 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(cons 0 1)
diff --git a/scaffold/boot/04-quote.scm b/scaffold/boot/04-quote.scm
new file mode 100644 (file)
index 0000000..8e1c095
--- /dev/null
@@ -0,0 +1,19 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(quote (0 1))
diff --git a/scaffold/boot/05-list.scm b/scaffold/boot/05-list.scm
new file mode 100644 (file)
index 0000000..9280529
--- /dev/null
@@ -0,0 +1,19 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(list 0 1)
diff --git a/scaffold/boot/06-tick.scm b/scaffold/boot/06-tick.scm
new file mode 100644 (file)
index 0000000..9bd5641
--- /dev/null
@@ -0,0 +1,19 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+'(0 1)
diff --git a/scaffold/boot/07-if.scm b/scaffold/boot/07-if.scm
new file mode 100644 (file)
index 0000000..1b09daf
--- /dev/null
@@ -0,0 +1,19 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(if #t 0 1)
diff --git a/scaffold/boot/08-if-if.scm b/scaffold/boot/08-if-if.scm
new file mode 100644 (file)
index 0000000..0bc959a
--- /dev/null
@@ -0,0 +1,19 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(if #t (if #t 'foo))
diff --git a/scaffold/boot/10-cons.scm b/scaffold/boot/10-cons.scm
new file mode 100644 (file)
index 0000000..bf5c61f
--- /dev/null
@@ -0,0 +1,19 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(cons 0 1)
diff --git a/scaffold/boot/11-list.scm b/scaffold/boot/11-list.scm
new file mode 100644 (file)
index 0000000..9280529
--- /dev/null
@@ -0,0 +1,19 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(list 0 1)
diff --git a/scaffold/boot/12-car.scm b/scaffold/boot/12-car.scm
new file mode 100644 (file)
index 0000000..32264a2
--- /dev/null
@@ -0,0 +1,19 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(car '(0 1))
diff --git a/scaffold/boot/13-cdr.scm b/scaffold/boot/13-cdr.scm
new file mode 100644 (file)
index 0000000..8028512
--- /dev/null
@@ -0,0 +1,19 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(cdr '(0 . 1))
diff --git a/scaffold/boot/14-exit.scm b/scaffold/boot/14-exit.scm
new file mode 100644 (file)
index 0000000..43ffd0e
--- /dev/null
@@ -0,0 +1,19 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(exit 0)
diff --git a/scaffold/boot/15-display.scm b/scaffold/boot/15-display.scm
new file mode 100644 (file)
index 0000000..bfb1eea
--- /dev/null
@@ -0,0 +1,20 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(core:display "t00\n")
+
diff --git a/scaffold/boot/16-if-eq-quote.scm b/scaffold/boot/16-if-eq-quote.scm
new file mode 100644 (file)
index 0000000..a7d116b
--- /dev/null
@@ -0,0 +1,20 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(if (if #t (eq? 0 '0)) (exit 0))
+(exit 1)
diff --git a/scaffold/boot/20-define-quote.scm b/scaffold/boot/20-define-quote.scm
new file mode 100644 (file)
index 0000000..3d7b66b
--- /dev/null
@@ -0,0 +1,22 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define <cell:char> 0)
+(define cell:type-alist
+  (list (cons <cell:char> (quote <cell:char>))))
+cell:type-alist
diff --git a/scaffold/boot/20-define-quoted.scm b/scaffold/boot/20-define-quoted.scm
new file mode 100644 (file)
index 0000000..4ac1a37
--- /dev/null
@@ -0,0 +1,20 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define mes '(0 1))
+mes
diff --git a/scaffold/boot/20-define.scm b/scaffold/boot/20-define.scm
new file mode 100644 (file)
index 0000000..d2a761d
--- /dev/null
@@ -0,0 +1,19 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define t #t)
diff --git a/scaffold/boot/21-define-procedure.scm b/scaffold/boot/21-define-procedure.scm
new file mode 100644 (file)
index 0000000..3da58da
--- /dev/null
@@ -0,0 +1,20 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define (not x) (if x #f #t))
+(if (not #f) (exit 0) (exit 1))
diff --git a/scaffold/boot/22-define-procedure-2.scm b/scaffold/boot/22-define-procedure-2.scm
new file mode 100644 (file)
index 0000000..d0095a9
--- /dev/null
@@ -0,0 +1,22 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define (not x) (if x #f #t))
+(define (not2 x) (if x #f #t))
+(if (not #f) (exit 0) (exit 1))
+(if (not2 #f) (exit 0) (exit 1))
diff --git a/scaffold/boot/23-begin.scm b/scaffold/boot/23-begin.scm
new file mode 100644 (file)
index 0000000..5199c45
--- /dev/null
@@ -0,0 +1,20 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(begin
+  #t)
diff --git a/scaffold/boot/24-begin-define.scm b/scaffold/boot/24-begin-define.scm
new file mode 100644 (file)
index 0000000..95f1c8a
--- /dev/null
@@ -0,0 +1,21 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(begin
+  (define (not x) (if x #f #t)))
+(if (not #f) (exit 0) (exit 1))
diff --git a/scaffold/boot/25-begin-define-2.scm b/scaffold/boot/25-begin-define-2.scm
new file mode 100644 (file)
index 0000000..5bdf6e6
--- /dev/null
@@ -0,0 +1,23 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(begin
+  (define (not x) (if x #f #t))
+  (define (not2 x) (if x #f #t)))
+(not #t)
+(not2 #t)
diff --git a/scaffold/boot/26-begin-define-later.scm b/scaffold/boot/26-begin-define-later.scm
new file mode 100644 (file)
index 0000000..420c3ab
--- /dev/null
@@ -0,0 +1,22 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(begin
+  (define (foo) (bar))
+  (define (bar) 0)
+  (exit (bar)))
diff --git a/scaffold/boot/26-define-define.scm b/scaffold/boot/26-define-define.scm
new file mode 100644 (file)
index 0000000..04c0508
--- /dev/null
@@ -0,0 +1,33 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define (x x1 x2)
+  (define b 1)
+  (define b1 1)
+  (define b2 1)
+  (define (y) b)
+  (define (y1) b)
+  (define (y2) b)
+  (set! b 0)
+  (list b (y)))
+
+(core:display "x:")
+(core:display x)
+(core:display "\n")
+(core:display (x 1 2))
+(core:display "\n")
diff --git a/scaffold/boot/27-lambda-define.scm b/scaffold/boot/27-lambda-define.scm
new file mode 100644 (file)
index 0000000..bc16126
--- /dev/null
@@ -0,0 +1,25 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+((lambda (foo bar lst)
+   (define (next)
+     foo
+     bar
+     lst)
+   (next))
+ 'foo 'bar '(0 1 2))
diff --git a/scaffold/boot/28-define-define.scm b/scaffold/boot/28-define-define.scm
new file mode 100644 (file)
index 0000000..55467ed
--- /dev/null
@@ -0,0 +1,25 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define (f foo lst)
+  (define (next)
+    lst)
+  (next))
+
+(if (eq? (f 'foo '24) 24) (exit 0))
+(exit 1)
diff --git a/scaffold/boot/29-lambda-define.scm b/scaffold/boot/29-lambda-define.scm
new file mode 100644 (file)
index 0000000..1c2c23a
--- /dev/null
@@ -0,0 +1,27 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(if (eq?
+     ((lambda (foo lst)
+        (define (next)
+          foo)
+        (next))
+      '12 '(0 1 2))
+     12)
+    (exit 0))
+(exit 1)
diff --git a/scaffold/boot/2a-lambda-lambda.scm b/scaffold/boot/2a-lambda-lambda.scm
new file mode 100644 (file)
index 0000000..8a46af6
--- /dev/null
@@ -0,0 +1,27 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(if (eq?
+     ((lambda (foo lst)
+        ((lambda (bar)
+           lst)
+         42))
+      '12 '24)
+     24)
+    (exit 0))
+(exit 1)
diff --git a/scaffold/boot/2b-define-lambda.scm b/scaffold/boot/2b-define-lambda.scm
new file mode 100644 (file)
index 0000000..16d83af
--- /dev/null
@@ -0,0 +1,24 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define f (lambda (t) t))
+
+(f 0)
+;;f
+
+
diff --git a/scaffold/boot/2c-define-lambda-recurse.scm b/scaffold/boot/2c-define-lambda-recurse.scm
new file mode 100644 (file)
index 0000000..2559bcc
--- /dev/null
@@ -0,0 +1,33 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define (foo x pair?)
+  (core:display "foo x=") (core:display x) (core:display "\n")
+  (core:display "    pair?=") (core:display pair?) (core:display "\n")
+  (if pair? ((lambda (a d)
+               (cons a d))
+             (begin
+               (core:display "BEFORE x=") (core:display x) (core:display "\n")
+               (foo (car x) #f))
+             (begin
+               (core:display "EFTER x=") (core:display x) (core:display "\n")
+               (foo (cdr x) #f)))
+      x))
+
+(if (null? (cdr (foo '(42) #t))) (exit 0))
+(exit 1)
diff --git a/scaffold/boot/2d-compose.scm b/scaffold/boot/2d-compose.scm
new file mode 100644 (file)
index 0000000..3428235
--- /dev/null
@@ -0,0 +1,23 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define (compose proc . rest)
+  (if (null? rest) proc
+      (lambda args
+        (proc (core:apply (core:apply compose rest) args)))))
+(exit ((compose car cdr car) '((1 0 2))))
diff --git a/scaffold/boot/2d-define-lambda-set.scm b/scaffold/boot/2d-define-lambda-set.scm
new file mode 100644 (file)
index 0000000..765ef82
--- /dev/null
@@ -0,0 +1,23 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define foo #f)
+ ((lambda (bar)
+    (set! foo (lambda () bar)))
+  0)
+(exit (foo))
diff --git a/scaffold/boot/2e-define-first.scm b/scaffold/boot/2e-define-first.scm
new file mode 100644 (file)
index 0000000..6c2e159
--- /dev/null
@@ -0,0 +1,34 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define display core:display)
+(define write core:write)
+
+(define (foo doit bar)
+  (display "foo doit=")
+  (write doit)
+  (display "\n")
+  (display " bar=")
+  (write bar)
+  (display "\n")
+  (doit bar))
+
+(foo display 1)
+(foo exit 0)
+
+(exit 1)
diff --git a/scaffold/boot/2f-define-second-lambda.scm b/scaffold/boot/2f-define-second-lambda.scm
new file mode 100644 (file)
index 0000000..814609e
--- /dev/null
@@ -0,0 +1,30 @@
+(define display core:display)
+(define write core:write)
+
+;; unmemoize removes formal caching...but only one level
+(define (foo doit bar)
+  (define baz
+    (lambda (doit)
+      (display "   baz:doit=")
+      (write doit)
+      (display "   baz:bar=")
+      (write bar)
+      (display "\n")
+      (doit bar)))
+  (display "foo doit=")
+  (write doit)
+  (display "\n")
+  (display " bar=")
+  (write bar)
+  (display "\n")
+  (display "  baz=")
+  (write baz)
+  (display "\n")
+  (baz doit))
+
+(foo display 1)
+(display "foo=")
+(write foo)
+(display "\n")
+(foo exit 0)
+(exit 1)
diff --git a/scaffold/boot/2f-define-second.scm b/scaffold/boot/2f-define-second.scm
new file mode 100644 (file)
index 0000000..35296d7
--- /dev/null
@@ -0,0 +1,47 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define display core:display)
+(define write core:write)
+
+;; unmemoize removes formal caching...but only one level
+(define (foo doit bar)
+  (define (baz doit)
+    (display "   baz:doit=")
+    (write doit)
+    (display "   baz:bar=")
+    (write bar)
+    (display "\n")
+    (doit bar))
+  (display "foo doit=")
+  (write doit)
+  (display "\n")
+  (display " bar=")
+  (write bar)
+  (display "\n")
+  (display "  baz=")
+  (write baz)
+  (display "\n")
+  (baz doit))
+
+(foo display 1)
+(display "foo=")
+(write foo)
+(display "\n")
+(foo exit 0)
+(exit 1)
diff --git a/scaffold/boot/2g-vector.scm b/scaffold/boot/2g-vector.scm
new file mode 100644 (file)
index 0000000..0752d16
--- /dev/null
@@ -0,0 +1,23 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define (remainder x y)
+  (- x (* (/ x y) y)))
+(define (even? x)
+  (= 0 (remainder x 2)))
+#(10 5 ,(even? 4) ,@(map even? '(2 3 5 7)) 8)
diff --git a/scaffold/boot/30-capture.scm b/scaffold/boot/30-capture.scm
new file mode 100644 (file)
index 0000000..438f56e
--- /dev/null
@@ -0,0 +1,20 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define (x) 0)
+(exit (x))
diff --git a/scaffold/boot/31-capture-define.scm b/scaffold/boot/31-capture-define.scm
new file mode 100644 (file)
index 0000000..7520329
--- /dev/null
@@ -0,0 +1,21 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define (x) 0)
+(define y (x))
+(exit y)
diff --git a/scaffold/boot/32-capture-modify-close.scm b/scaffold/boot/32-capture-modify-close.scm
new file mode 100644 (file)
index 0000000..733576f
--- /dev/null
@@ -0,0 +1,21 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define (x) 0)
+(exit (x))
+(set! x (lambda () 1))
diff --git a/scaffold/boot/33-procedure-override-close.scm b/scaffold/boot/33-procedure-override-close.scm
new file mode 100644 (file)
index 0000000..b1a3b9d
--- /dev/null
@@ -0,0 +1,23 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define core:exit exit)
+(define (x) 0)
+(core:display "x=") (core:display (x)) (core:display "\n")
+(exit (x))
+(define (exit x) (core:exit 1))
diff --git a/scaffold/boot/34-cdr-override-close.scm b/scaffold/boot/34-cdr-override-close.scm
new file mode 100644 (file)
index 0000000..f0ba56c
--- /dev/null
@@ -0,0 +1,21 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define (x) 0)
+(exit (x))
+(define (x) 1)
diff --git a/scaffold/boot/35-closure-modify.scm b/scaffold/boot/35-closure-modify.scm
new file mode 100644 (file)
index 0000000..68fd920
--- /dev/null
@@ -0,0 +1,23 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define x 1)
+(define (f) x)
+(set! x 0)
+(exit (f))
+
diff --git a/scaffold/boot/36-closure-override.scm b/scaffold/boot/36-closure-override.scm
new file mode 100644 (file)
index 0000000..b4ed75a
--- /dev/null
@@ -0,0 +1,22 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define (x) 1)
+(define (f) (x))
+(define (x) 0)
+(exit (f))
diff --git a/scaffold/boot/37-closure-lambda.scm b/scaffold/boot/37-closure-lambda.scm
new file mode 100644 (file)
index 0000000..c25386e
--- /dev/null
@@ -0,0 +1,67 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define <cell:pair> 7)
+
+(define (pair? x)
+  (eq? (core:type x) <cell:pair>))
+
+(define (atom? x)
+  (if (pair? x) #f
+      (if (null? x) #f
+      #t)))
+
+(define (memq x lst)
+  (if (null? lst) #f
+      (if (eq? x (car lst)) lst
+          (memq x (cdr lst)))))
+
+(define (caar x) (car (car x)))
+(define (cadr x) (car (cdr x)))
+(define (cdar x) (cdr (car x)))
+(define (cddr x) (cdr (cdr x)))
+
+(define (loop first rest accum)
+  (core:display-error "\nloop\n  first=")
+  (core:write-error first)
+  (core:display-error "\n")
+  (core:display-error "  rest=")
+  (core:write-error rest)
+  (core:display-error "\n")
+  (core:display-error "  accum=")
+  (core:write-error accum)
+  (core:display-error "\n")
+  ((lambda (next)
+     (if (atom? first)
+         (next (cons (cons first
+                           (car rest)) accum))
+         (if (null? rest)
+             accum
+             (next accum))))
+   (lambda (a)
+     (core:display-error "\nnext a=")
+     (core:write-error a)
+     (core:display-error "\n")
+     (core:display-error "     rest=")
+     (core:write-error rest)
+     (core:display-error "\n")
+     (if (null? (cdr rest))
+         a
+         (loop (cadr rest) (cddr rest) a)))))
+
+(loop 'functions '(() 'globals ()) '())
diff --git a/scaffold/boot/38-simple-format.scm b/scaffold/boot/38-simple-format.scm
new file mode 100644 (file)
index 0000000..37a70e7
--- /dev/null
@@ -0,0 +1,73 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define <cell:pair> 7)
+(define (pair? x) (eq? (core:type x) <cell:pair>))
+
+(define (not x) (if x #f #t))
+
+(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 (boolean? x)
+  (or (eq? x #f) (eq? x #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 (cadr x) (car (cdr x)))
+(define (cddr x) (cdr (cdr x)))
+
+;;(define (current-output-port) 1)
+
+(define (simple-format destination format . rest)
+  ((lambda (port lst)
+     (define (simple-format lst args)
+       (if (pair? lst)
+           ((lambda (c)
+              (if (not (eq? c #\~)) (begin (write-char (car lst) port)
+                                           (simple-format (cdr lst) args))
+                  ((lambda (c)
+                     (if (or (eq? c #\A)
+                             (eq? c #\a))
+                         (display (car args) port)
+                         (if (or (eq? c #\S)
+                                 (eq? c #\s))
+                             (write (car args) port)
+                             (write (car args) port)))
+                     (simple-format (cddr lst) (cdr args)))
+                   (cadr lst))))
+            (car lst))))
+     (if destination (simple-format lst rest)
+         (with-output-to-string
+           (lambda () (simple-format lst rest)))))
+   (if (boolean? destination) (current-output-port) destination)
+   ;;(string->list format)
+   format))
+;;(simple-format 2 "~A:~A: parse failed at state ~A, on input ~S\n" "<stdin>" 1 59 "(")
+(simple-format #t '(#\~ #\A #\: #\~ #\A #\: #\space #\p #\a #\r #\s #\e #\space #\f #\a #\i #\l #\e #\d #\space #\a #\t #\space #\s #\t #\a #\t #\e #\space #\~ #\A #\, #\space #\o #\n #\space #\i #\n #\p #\u #\t #\space #\~ #\S #\newline) "<stdin>" 1 59 "(")
diff --git a/scaffold/boot/39-global-define-override.scm b/scaffold/boot/39-global-define-override.scm
new file mode 100644 (file)
index 0000000..c904c4c
--- /dev/null
@@ -0,0 +1,3 @@
+(define (read) 1)
+(define read (lambda () 0))
+(exit (read))
diff --git a/scaffold/boot/3a-global-define-lambda-override.scm b/scaffold/boot/3a-global-define-lambda-override.scm
new file mode 100644 (file)
index 0000000..11cbd54
--- /dev/null
@@ -0,0 +1,5 @@
+(define (read) 1)
+(exit
+ ((lambda ()
+    (define read (lambda () 0))
+    (read))))
diff --git a/scaffold/boot/40-define-macro.scm b/scaffold/boot/40-define-macro.scm
new file mode 100644 (file)
index 0000000..966d168
--- /dev/null
@@ -0,0 +1,20 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define-macro (when exp . body)
+  (list 'if exp (cons 'begin body)))
diff --git a/scaffold/boot/41-when.scm b/scaffold/boot/41-when.scm
new file mode 100644 (file)
index 0000000..196988d
--- /dev/null
@@ -0,0 +1,24 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define-macro (when exp . body)
+  (list 'if exp (cons 'begin body)))
+
+(when #t
+  (exit 0))
+(exit 1)
diff --git a/scaffold/boot/42-if-when.scm b/scaffold/boot/42-if-when.scm
new file mode 100644 (file)
index 0000000..3cd43bb
--- /dev/null
@@ -0,0 +1,22 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define-macro (foo bar)
+  (list 'begin bar))
+
+(if #t (foo 3))
diff --git a/scaffold/boot/43-or.scm b/scaffold/boot/43-or.scm
new file mode 100644 (file)
index 0000000..05ed301
--- /dev/null
@@ -0,0 +1,35 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(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 (f a)
+  (or #t a))
+
+(define-macro (foo bar)
+  (list f bar))
+
+(foo 3)
+
+(if #t (foo 3))
diff --git a/scaffold/boot/44-or-if.scm b/scaffold/boot/44-or-if.scm
new file mode 100644 (file)
index 0000000..b6f127e
--- /dev/null
@@ -0,0 +1,27 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(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)))))
+
+(or #t (if #t 'false))
diff --git a/scaffold/boot/45-pass-if.scm b/scaffold/boot/45-pass-if.scm
new file mode 100644 (file)
index 0000000..b58cecc
--- /dev/null
@@ -0,0 +1,31 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define result
+  (lambda (. t)
+    (core:display "result: t=")
+    (core:display t)
+    (core:display "\n")))
+
+(define-macro (pass-if name t)
+  (list
+   'begin
+   (list core:display "test: ") (list core:display name)
+   (list result t)))
+
+(pass-if "first dummy" #t)
diff --git a/scaffold/boot/46-report.scm b/scaffold/boot/46-report.scm
new file mode 100644 (file)
index 0000000..1b7793b
--- /dev/null
@@ -0,0 +1,61 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define display core:display)
+(define write core:write)
+(define (newline) (display "\n"))
+
+(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 (cadr x) (car (cdr x)))
+(define (not x) (if x #f #t))
+
+(define result
+  ((lambda (pass fail)
+     (lambda (. t)
+       (if (or (null? t) (eq? (car t) 'result)) (list pass fail)
+           (if (eq? (car t) 'report)
+               (begin
+                 ((lambda (expect)
+                    (newline)
+                    (display "passed: ") (display pass) (newline)
+                    (display "failed: ") (display fail) (newline)
+                    (if (not (eq? expect 0)) (begin (display "expect: ") (write expect) (newline)))
+                    (display "total: ") (display (+ pass fail)) (newline)
+                    (exit (if (eq? expect fail) 0 fail)))
+                  (begin
+                    (if (null? (cdr t)) 0 (cadr t)))))
+               (if (car t) (begin (display ": pass") (newline) (set! pass (+ pass 1)))
+                   (begin (display ": fail") (newline) (set! fail (+ fail 1))))))))
+   0 0))
+
+(define-macro (pass-if name t)
+  (list
+   'begin
+   (list display "test: ") (list display name)
+   (list result t)))
+
+(pass-if "first dummy" #t)
+
+(result 'report 1)
diff --git a/scaffold/boot/47-pass-if-eq.scm b/scaffold/boot/47-pass-if-eq.scm
new file mode 100644 (file)
index 0000000..662c0f2
--- /dev/null
@@ -0,0 +1,36 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define result
+  (lambda (. t)
+    (core:display "result: t=")
+    (core:display t)
+    (core:display "\n")))
+
+(define-macro (pass-if name t)
+  (list
+   'begin
+   (list core:display "test: ") (list core:display name)
+   (list result t)))
+
+(define-macro (pass-if-eq name expect . body)
+  (list 'pass-if name (list eq? expect (cons 'begin body))))
+
+(pass-if-eq "if" 'true (if #t 'foo))
+
+(result 'report)
diff --git a/scaffold/boot/48-let.scm b/scaffold/boot/48-let.scm
new file mode 100644 (file)
index 0000000..71a57f2
--- /dev/null
@@ -0,0 +1,32 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define (map1 f lst)
+  (if (null? lst) (list)
+      (cons (f (car lst)) (map1 f (cdr lst)))))
+
+(define (cadr x) (car (cdr x)))
+
+(define-macro (let bindings . rest)
+  (cons (cons 'lambda (cons (map1 car bindings) rest))
+        (map1 cadr bindings)))
+
+(let ((x 0)) x)
+(let ((y 0)) y)
+(exit (let ((xx 0)) xx))
+(exit 1)
diff --git a/scaffold/boot/49-macro-override.scm b/scaffold/boot/49-macro-override.scm
new file mode 100644 (file)
index 0000000..1fa8c98
--- /dev/null
@@ -0,0 +1,22 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define-macro (when exp . body)
+  #t)
+(define-macro (when test . rest)
+  (list 'if test (cons 'begin rest)))
diff --git a/scaffold/boot/4a-define-macro-define-macro.scm b/scaffold/boot/4a-define-macro-define-macro.scm
new file mode 100644 (file)
index 0000000..8aaf7e0
--- /dev/null
@@ -0,0 +1,27 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define-macro (foo)
+  (list 'define-macro (list 'bar)
+        (list 'define-macro (list 'append)
+              42)
+        #t))
+
+(foo)
+(bar)
+(append)
diff --git a/scaffold/boot/4b-define-macro-define.scm b/scaffold/boot/4b-define-macro-define.scm
new file mode 100644 (file)
index 0000000..9d6327a
--- /dev/null
@@ -0,0 +1,25 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define-macro (foo)
+  (list 'lambda (list 'exp 'r)
+     (list 'define '%input (list 'r ''*input*))
+     'exp))
+
+((foo) 'bla (lambda (x0) x0))
+
diff --git a/scaffold/boot/4c-quasiquote.scm b/scaffold/boot/4c-quasiquote.scm
new file mode 100644 (file)
index 0000000..ea01c55
--- /dev/null
@@ -0,0 +1,164 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define <cell:pair> 7)
+(define (pair? x) (eq? (core:type x) <cell:pair>))
+(define <cell:vector> 14)
+(define (vector? x)
+  (eq? (core:type x) <cell:vector>))
+
+(define-macro (cond . clauses)
+  (list 'if (pair? clauses)
+        (list (cons
+               'lambda
+               (cons
+                '(test)
+                (list (list 'if 'test
+                            (if (pair? (cdr (car clauses)))
+                                (if (eq? (car (cdr (car clauses))) '=>)
+                                    (append2 (cdr (cdr (car clauses))) '(test))
+                                    (list (cons 'lambda (cons '() (cons 'test (cdr (car clauses)))))))
+                                (list (cons 'lambda (cons '() (cons 'test (cdr (car clauses)))))))
+                            (if (pair? (cdr clauses))
+                                (cons 'cond (cdr clauses)))))))
+              (car (car clauses)))))
+
+(define else #t)
+(define append append2)
+(define (not x) (if x #f #t))
+
+(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 (cons* . rest)
+  (if (null? (cdr rest)) (car rest)
+      (cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
+
+(define (memq x lst)
+  (if (null? lst) #f
+      (if (eq? x (car lst)) lst
+          (memq x (cdr lst)))))
+
+;; (define (quasiquote-expand x)
+;;   (core:display "quasiquote-expand x=") (core:display x) (core:display "\n")
+;;   (cond ((null? x)
+;;          (core:display "NULL\n")
+;;          '())
+;;         ((vector? x)
+;;          (core:display "vector\n")
+;;          (list 'list->vector (quasiquote-expand (vector->list x))))
+;;         ((not (pair? x))
+;;          (core:display "NOT a pair\n")
+;;          (cons 'quote (cons x '())))
+;;         ((eq? (car x) 'quasiquote) (quasiquote-expand (quasiquote-expand
+;;                                                        (if (null? (cddr x)) (cadr x)
+;;                                                            (cons 'list (cdr x))))))
+;;         ((eq? (car x) 'unquote) (if (null? (cddr x)) (cadr x)
+;;                                     (cons 'list (cdr x))))
+;;         ((and (pair? (car x)) (eq? (caar x) 'unquote-splicing))
+;;          ((lambda (d)
+;;             (if (null? (cddar x)) (list 'append (cadar x) d)
+;;                 (list 'quote (append (cdar x) d))))
+;;           (quasiquote-expand (cdr x))))
+;;         (else
+;;          (core:display "ELSje\n")
+;;          (core:display "CAR x=") (core:display (car x))
+;;          (core:display "\n")
+;;          (core:display "CDR x=") (core:display (cdr x))
+;;          (core:display "\n")
+;;          ((lambda (a d)
+;;             (core:display "  a=") (core:display a) (core:display "\n")
+;;             (core:display "  d=") (core:display d)
+            
+;;             (if (pair? d)
+;;                 (if (eq? (car d) 'quote)
+;;                     (if (and (pair? a) (eq? (car a) 'quote))
+;;                         (list 'quote (cons (cadr a) (cadr d)))
+;;                         (if (null? (cadr d))
+;;                             (list 'list a)
+;;                             (list 'cons* a d)))
+;;                     (if (memq (car d) '(list cons*))
+;;                         (cons (car d) (cons a (cdr d)))
+;;                         (list 'cons* a d)))
+;;                 (list 'cons* a d)))
+;;           (quasiquote-expand (car x))
+;;           (list 'quasiquote-expand (list 'cdr x))))))
+
+(define (caar x) (car (car x)))
+(define (cadr x) (car (cdr x)))
+(define (cdar x) (cdr (car x)))
+(define (cddr x) (cdr (cdr x)))
+
+(define (cadar x) (car (cdr (car x))))
+(define (cddar x) (cdr (cdr (car x))))
+
+(define (quasiquote-expand x)
+  (core:display "quasiquote-expand x=") (core:display x) (core:display "\n")
+  (cond ((vector? x) (list 'list->vector (quasiquote-expand (vector->list x))))
+        ((not (pair? x)) (cons 'quote (cons x '())))
+        ((eq? (car x) 'quasiquote) (quasiquote-expand (quasiquote-expand
+                                             (if (null? (cddr x)) (cadr x)
+                                                 (cons 'list (cdr x))))))
+        ((eq? (car x) 'unquote) (if (null? (cddr x)) (cadr x)
+                                    (cons 'list (cdr x))))
+        ((and (pair? (car x)) (eq? (caar x) 'unquote-splicing))
+         ((lambda (d)
+            (if (null? (cddar x)) (list 'append (cadar x) d)
+                (list 'quote (append (cdar x) d))))
+          (quasiquote-expand (cdr x))))
+        (else
+         (core:display "ELSje\n")
+         (core:display "CAR x=") (core:display (car x))
+         (core:display "\n")
+         (core:display "CDR x=") (core:display (cdr x))
+         (core:display "\n")
+         ((lambda (a d)
+            (core:display "CAR a=") (core:display a)
+            (core:display "\n")
+            (core:display "CDR d=") (core:display d)
+            (core:display "\n")
+            
+                 (if (pair? d)
+                     (if (eq? (car d) 'quote)
+                         (if (and (pair? a) (eq? (car a) 'quote))
+                             (list 'quote (cons (cadr a) (cadr d)))
+                             (if (null? (cadr d))
+                                 (list 'list a)
+                                 (list 'cons* a d)))
+                         (if (memq (car d) '(list cons*))
+                             (cons (car d) (cons a (cdr d)))
+                             (list 'cons* a d)))
+                     (list 'cons* a d)))
+               (quasiquote-expand (car x))
+               (quasiquote-expand (cdr x))
+))))
+
+(define-macro (quasiquote x)
+  (quasiquote-expand x))
+
+;; (define (remainder x y)
+;;   (- x (* (/ x y) y)))
+;; (define (even? x)
+;;   (eq? 0 (remainder x v2)))
+;; (pass-if-equal "qq 4" '#(10 5 #t #t #f #f #f 8)
+;;                `#(10 5 ,(even? 4) ,@(map even? '(2 3 5 7)) 8))
+;;(core:display (quasiquote #(42)))
+(core:display (quasiquote-expand #(42)))
diff --git a/scaffold/boot/4d-let-map.scm b/scaffold/boot/4d-let-map.scm
new file mode 100644 (file)
index 0000000..fcd56e8
--- /dev/null
@@ -0,0 +1,39 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define map 'boo)
+(define (map f lst)
+  (if (null? lst) (list)
+      (cons (f (car lst)) (map f (cdr lst)))))
+
+(define (cadr x) (car (cdr x)))
+
+(define-macro (let bindings . rest)
+  (cons (cons 'lambda (cons (map car bindings) rest))
+        (map cadr bindings)))
+
+(let ((a 0)
+      (b 1)
+      (c 2)
+      (d 3)
+      (e 4)
+      (f 5)
+      (g 6)
+      (h 7)
+      (i 8))
+  (+ a b))
diff --git a/scaffold/boot/4e-let-global.scm b/scaffold/boot/4e-let-global.scm
new file mode 100644 (file)
index 0000000..d52664b
--- /dev/null
@@ -0,0 +1,33 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define (cadr x) (car (cdr x)))
+
+(define (map f lst)
+  (if (null? lst) (list)
+      (cons (f (car lst)) (map f (cdr lst)))))
+
+(define-macro (let bindings . rest)
+  (cons (cons 'lambda (cons (map car bindings) rest))
+        (map cadr bindings)))
+
+(define (list-length list)
+  (let ((length (length list)))
+    (- length 2)))
+
+ (exit (list-length '(bar baz)))
diff --git a/scaffold/boot/4e-string-split.scm b/scaffold/boot/4e-string-split.scm
new file mode 100644 (file)
index 0000000..d3d41a3
--- /dev/null
@@ -0,0 +1,98 @@
+
+(define (cons* . rest)
+  (if (null? (cdr rest)) (car rest)
+      (cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
+
+(define (caar x) (car (car x)))
+(define (cadr x) (car (cdr x)))
+(define (cdar x) (cdr (car x)))
+(define (cddr x) (cdr (cdr x)))
+
+(define <cell:symbol> 11)
+(define (symbol? x)
+  (eq? (core:type x) <cell:symbol>))
+
+(define (map f lst)
+  (if (null? lst) (list)
+      (cons (f (car lst)) (map f (cdr lst)))))
+
+(define-macro (simple-let bindings . rest)
+  (cons (cons 'lambda (cons (map car bindings) rest))
+        (map cadr bindings)))
+
+;; (define-macro (xsimple-let bindings rest)
+;;   `(,`(lambda ,(map car bindings) ,@rest)
+;;     ,@(map cadr bindings)))
+
+(define-macro (xsimple-let bindings rest)
+  (cons* (cons* (quote lambda)
+                (map car bindings) (append2 rest (quote ())))
+         (append2 (map cadr bindings) (quote ()))))
+
+;; (define-macro (xnamed-let name bindings rest)
+;;   `(simple-let ((,name *unspecified*))
+;;      (set! ,name (lambda ,(map car bindings) ,@rest))
+;;      (,name ,@(map cadr bindings))))
+
+(define-macro  (xnamed-let name bindings rest)
+  (list (quote simple-let)
+        (list (cons* name (quote (*unspecified*))))
+        (list (quote set!)
+              name
+              (cons* (quote lambda)
+                     (map car bindings)
+                     (append2 rest (quote ()))))
+        (cons* name (append2 (map cadr bindings) (quote ())))))
+
+;; (define-macro (let bindings-or-name . rest)
+;;   (if (symbol? bindings-or-name)
+;;       `(xnamed-let ,bindings-or-name ,(car rest) ,(cdr rest))
+;;       `(xsimple-let ,bindings-or-name ,rest)))
+
+(define-macro (let bindings-or-name . rest)
+  (if (symbol? bindings-or-name) (list (quote xnamed-let) bindings-or-name (car rest) (cdr rest))
+      (list (quote xsimple-let) bindings-or-name rest)))
+
+(define ss-memq-inner #f)
+(define (ss-memq x lst)
+  (if (null? lst) #f ;; IF
+      (if (eq? x (car lst)) lst
+          (ss-memq-inner x (cdr lst)))))
+
+(define (ss-memq-inner x lst)
+  (if (null? lst) #f ;; IF
+      (if (eq? x (car lst)) lst
+          (ss-memq-inner x (cdr lst)))))
+
+(define (ss-list-head x n)
+  (if (= 0 n) '()
+      (cons (car x) (ss-list-head (cdr x) (- n 1)))))
+
+;; (define (foo x y)
+;;   (cons x y))
+
+;; (define (ss-list-head x n)
+;;   (if (= 0 n) '()
+;;       (foo (car x) (ss-list-head (cdr x) (- n 1)))))
+
+(define (string->list s)
+  (core:car s))
+
+(define <cell:string> 10)
+
+(define (list->string lst)
+  (core:make-cell <cell:string> lst 0))
+
+(define (not x) (if x #f #t))
+
+(define (string-split s c)
+  (let loop ((lst (string->list s)) (result '()))
+    (let ((rest (ss-memq c lst)))
+      (if (not rest) (append2 result (list (list->string lst)))
+          (loop (cdr rest)
+                (append2 result
+                         (list (list->string (ss-list-head lst (- (length lst) (length rest)))))))))))
+
+(core:display-error "*START*\n")
+(string-split "foo bar" #\space)
+(string-split "baz bla" #\space)
diff --git a/scaffold/boot/50-primitive-load.scm b/scaffold/boot/50-primitive-load.scm
new file mode 100644 (file)
index 0000000..891c61e
--- /dev/null
@@ -0,0 +1,35 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(cond-expand
+ (guile)
+ (mes
+  (define-macro (include-from-path file)
+    (list
+     'begin
+     (list 'primitive-load file)))))
+
+(include-from-path "scaffold/boot/data/i.scm")
+
+(core:display "from-i:")
+(core:display from-i)
+(core:display "\n")
+
+(core:display "from-i-macro")
+(core:display (from-i-macro))
+(core:display "\n")
diff --git a/scaffold/boot/51-module.scm b/scaffold/boot/51-module.scm
new file mode 100644 (file)
index 0000000..34ce664
--- /dev/null
@@ -0,0 +1,114 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(cond-expand
+ (guile)
+ (mes
+  (define (cons* . rest)
+    (if (null? (cdr rest)) (car rest)
+        (cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
+
+  (define (apply f h . t)
+    (if (null? t) (core:apply f h (current-module))
+        (apply f (apply cons* (cons h t)))))
+
+  (define (append . rest)
+    (core:display-error "append rest=")
+    (core:write-error rest)
+    (core:display-error "\n")
+    (if (null? rest) '()
+        (if (null? (cdr rest)) (car rest)
+            (append2 (car rest) (apply append (cdr rest))))))
+
+  (define (string->list s)
+    (core:car s))
+
+  (define <cell:string> 10)
+
+  (define (string . lst)
+    (core:make-cell <cell:string> lst 0))
+
+  (define (string-append . rest)
+    (apply string (apply append (map string->list rest))))
+
+  (define %prefix (getenv "MES_PREFIX"))
+
+  (define (not x) (if x #f #t))
+  (define (map1 f lst)
+    (if (null? lst) (list)
+        (cons (f (car lst)) (map1 f (cdr lst)))))
+
+  (define map map1)
+
+  (define (list->string lst)
+    (core:make-cell <cell:string> lst 0))
+
+  (define %moduledir
+    (if (not %prefix ) "module/"
+        (list->string
+         (append (string->list %prefix)
+                 (string->list "/module") ; `module/' gets replaced upon install
+                 (string->list "/")))))
+
+  (define-macro (load file)
+    (list 'begin
+          (list 'if (list getenv "MES_DEBUG")
+                (list 'begin
+                      (list core:display-error ";;; read ")
+                      (list core:display-error file)
+                      (list core:display-error "\n")))
+          (list 'primitive-load file)))
+
+  (define-macro (include-from-path file)
+    (list 'load (list string-append %moduledir file)))
+
+  (define (string->symbol s)
+    (core:lookup-symbol (core:car s)))
+
+  (define (symbol->list s)
+    (core:car s))
+
+  (define <cell:string> 10)
+
+  (define (string . lst)
+    (core:make-cell <cell:string> lst 0))
+
+  (define (symbol->string s)
+    (apply string (symbol->list s)))
+
+  (define (getcwd) ".")
+
+  (define (display x . rest)
+    (if (null? rest) (core:display x)
+        (core:display-port x (car rest))))
+  ))
+
+(define (memq x lst)
+  (if (null? lst) #f
+      (if (eq? x (car lst)) lst
+          (memq x (cdr lst)))))
+
+(define (string-join lst infix)
+  (if (null? (cdr lst)) (car lst)
+      (string-append (car lst) infix (string-join (cdr lst) infix))))
+
+(include-from-path "mes/module.mes")
+(core:display-error module->file) (core:display-error "\n")
+(define %moduledir (string-append (getcwd) "/"))
+(mes-use-module (scaffold boot data module))
+(mes-use-module (scaffold boot data module))
diff --git a/scaffold/boot/52-define-module.scm b/scaffold/boot/52-define-module.scm
new file mode 100644 (file)
index 0000000..f2d18a3
--- /dev/null
@@ -0,0 +1,83 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(cond-expand
+ (guile
+  )
+ (mes
+;;;;;;;;;;;;;;;
+  (define (cons* . rest)
+    (if (null? (cdr rest)) (car rest)
+        (cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
+
+  (define (apply f h . t)
+    (if (null? t) (core:apply f h (current-module))
+        (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))))))
+
+  (define (string->list s)
+    (core:car s))
+
+  (define <cell:string> 10)
+
+  (define (string . lst)
+    (core:make-cell <cell:string> lst 0))
+
+  (define (map1 f lst)
+    (if (null? lst) (list)
+        (cons (f (car lst)) (map1 f (cdr lst)))))
+
+  (define map map1)
+
+  (define (string-append . rest)
+    (apply string (apply append (map string->list rest))))
+;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;
+  (define (symbol->list s)
+    (core:car s))
+
+  (define (symbol->string s)
+    (apply string (symbol->list s)))
+
+  (define (string-join lst infix)
+    (if (null? (cdr lst)) (car lst)
+        (string-append (car lst) infix (string-join (cdr lst) infix))))
+;;;;;;;;;;;;;;;;;;
+
+  (define (string->symbol s)
+    (core:lookup-symbol (core:car s)))
+
+  (define-macro (load file)
+    (list 'primitive-load file))
+
+  (define (not x) (if x #f #t))
+
+  (define (memq x lst)
+    (if (null? lst) #f
+        (if (eq? x (car lst)) lst
+            (memq x (cdr lst)))))
+  ))
+
+(define %moduledir "./")
+(primitive-load "module/mes/module.mes")
+(mes-use-module (scaffold boot data bar))
diff --git a/scaffold/boot/53-closure-display.scm b/scaffold/boot/53-closure-display.scm
new file mode 100644 (file)
index 0000000..3a4a550
--- /dev/null
@@ -0,0 +1,58 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(cond-expand
+ (guile
+  (define closure identity))
+ (mes
+  (define display core:display)
+  (define write core:write)
+  (define (newline) (display "\n"))
+  (define (cadr x) (car (cdr x)))
+  (define (map f lst)
+    (if (null? lst) (list)
+        (cons (f (car lst)) (map f (cdr lst)))))
+  (define (closure x)
+    (map car (cdr (core:cdr (core:car (core:cdr (cdr (assq 'x (current-module)))))))))))
+
+(define (x t) #t)
+(define (xx x1 x2)
+  (define blabla 4)
+  (define (blubblub) 5)
+  #t)
+
+(newline)
+(display "x:")
+(display x)
+(newline)
+
+(newline)
+(display "xx:")
+(display xx)
+(newline)
+
+(display "closure:")
+(display closure)
+(newline)
+(display "closure xx:")
+(write (closure xx))
+(display "\n")
+(xx 0 1)
+(display " => closure xx:")
+(write (closure xx))
+(display "\n")
diff --git a/scaffold/boot/60-let-syntax.scm b/scaffold/boot/60-let-syntax.scm
new file mode 100644 (file)
index 0000000..3088159
--- /dev/null
@@ -0,0 +1,476 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(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 else #t)
+(define-macro (cond . clauses)
+  (list 'if (pair? clauses)
+        (list (cons
+               'lambda
+               (cons
+                '(test)
+                (list (list 'if 'test
+                            (if (pair? (cdr (car clauses)))
+                                (if (eq? (car (cdr (car clauses))) '=>)
+                                    (append2 (cdr (cdr (car clauses))) '(test))
+                                    (list (cons 'lambda (cons '() (cons 'test (cdr (car clauses)))))))
+                                (list (cons 'lambda (cons '() (cons 'test (cdr (car clauses)))))))
+                            (if (pair? (cdr clauses))
+                                (cons 'cond (cdr clauses)))))))
+              (car (car clauses)))))
+
+(define (memq x lst)
+  (if (null? lst) #f
+      (if (eq? x (car lst)) lst
+          (memq x (cdr lst)))))
+
+;; (cond-expand
+;;  (guile
+;;   (define closure identity)
+;;   (define body identity)
+;;   (define append2 append)
+;;   (define (core:apply f a m) (f a))
+;;   )
+;;  (mes
+  (define <cell:symbol> 11)
+  (define (symbol? x)
+    (eq? (core:type x) <cell:symbol>))
+
+  (define (string->symbol s)
+    (if (not (pair? (core:car s))) '()
+        (core:lookup-symbol (core:car s))))
+
+  (define <cell:string> 10)
+  (define (string? x)
+    (eq? (core:type x) <cell:string>))
+  
+  (define <cell:vector> 14)
+  (define (vector? x)
+    (eq? (core:type x) <cell:vector>))
+  ;; (define (body x)
+  ;; (core:cdr (core:cdr (core:cdr (cdr (assq 'x (current-module)))))))
+  ;; (define (closure x)
+  ;;   (map car (cdr (core:cdr (core:car (core:cdr (cdr (assq 'x (current-module)))))))))
+  ;; ))
+
+(define (cons* . rest)
+  (if (null? (cdr rest)) (car rest)
+      (cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
+
+(define (apply f h . t)
+  (if (null? t) (core:apply f h (current-module))
+      (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))))))
+
+(define-macro (quasiquote x)
+  ;;(core:display-error "quasiquote:") (core:write-error x) (core:display-error "\n")
+  (define (loop x)
+    ;;(core:display-error "loop:") (core:write-error x) (core:display-error "\n")
+    (if (vector? x) (list 'list->vector (loop (vector->list x)))
+        (if (not (pair? x)) (cons 'quote (cons x '()))
+            (if (eq? (car x) 'quasiquote) (loop (loop (cadr x)))
+                (if (eq? (car x) 'unquote) (cadr x)
+                    (if (and (pair? (car x)) (eq? (caar x) 'unquote-splicing))
+                        ((lambda (d)
+                           (list 'append (car (cdr (car x))) d))
+                         (loop (cdr x)))
+                        ((lambda (a d)
+                           (if (pair? d)
+                               (if (eq? (car d) 'quote)
+                                   (if (and (pair? a) (eq? (car a) 'quote))
+                                       (list 'quote (cons (cadr a) (cadr d)))
+                                       (if (null? (cadr d))
+                                           (list 'list a)
+                                           (list 'cons* a d)))
+                                   (if (memq (car d) '(list cons*))
+                                       (cons (car d) (cons a (cdr d)))
+                                       (list 'cons* a d)))
+                               (list 'cons* a d)))
+                         (loop (car x))
+                         (loop (cdr x)))))))))
+  (loop x))
+
+(define (caar x) (car (car x)))
+(define (cadr x) (car (cdr x)))
+(define (cdar x) (cdr (car x)))
+(define (cddr x) (cdr (cdr x)))
+
+(define-macro (simple-let bindings . rest)
+  (cons (cons 'lambda (cons (map car bindings) rest))
+        (map cadr bindings)))
+
+(define-macro (xsimple-let bindings rest)
+  `(,`(lambda ,(map car bindings) ,@rest)
+    ,@(map cadr bindings)))
+
+(define-macro (xnamed-let name bindings rest)
+  `(simple-let ((,name *unspecified*))
+     (set! ,name (lambda ,(map car bindings) ,@rest))
+     (,name ,@(map cadr bindings))))
+
+(define-macro (let bindings-or-name . rest)
+  (if (symbol? bindings-or-name) ;; IF
+      `(xnamed-let ,bindings-or-name ,(car rest) ,(cdr rest))
+      `(xsimple-let ,bindings-or-name ,rest)))
+
+(define (expand-let* bindings body)
+  (if (null? bindings)
+      `((lambda () ,@body))
+      `((lambda (,(caar bindings))
+          ,(expand-let* (cdr bindings) body))
+        ,@(cdar bindings))))
+
+(define-macro (let* bindings . body)
+  (expand-let* bindings body))
+
+(define (equal2? a b)
+  (if (and (null? a) (null? b)) #t
+      (if (and (pair? a) (pair? b))
+          (and (equal2? (car a) (car b))
+               (equal2? (cdr a) (cdr b)))
+          (if (and (string? a) (string? b))
+              (eq? (string->symbol a) (string->symbol b))
+              (if (and (vector? a) (vector? b))
+                  (equal2? (vector->list a) (vector->list b))
+                  (eq? a b))))))
+
+(define equal? equal2?)
+(define (member x lst)
+  (if (null? lst) #f
+      (if (equal2? x (car lst)) lst
+          (member x (cdr lst)))))
+
+(define (<= . rest)
+  (or (apply < rest)
+      (apply = rest)))
+
+(define (>= . rest)
+  (or (apply > rest)
+      (apply = rest)))
+
+(define (list? x)
+  (or (null? x)
+      (and (pair? x) (list? (cdr x)))))
+
+;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright (c) 1993-2004 by Richard Kelsey and Jonathan Rees.
+;;; Copyright © 2016 Jan 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/>.
+
+;;; Commentary:
+
+;;; syntax.mes is loaded after scm.mes.  It provides the R5RS hygienic
+;;; macros define-syntax, syntax-rules and define-syntax-rule.
+;;; syntax-rules is adapted from scheme48-1.1/scheme/alt/syntax.scm
+
+;;; Code:
+
+;;; Copyright (c) 1993-2004 by Richard Kelsey and Jonathan Rees. See file COPYING.
+
+;;; scheme48-1.1/COPYING
+
+;; Copyright (c) 1993-2004 Richard Kelsey and Jonathan Rees
+;; All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;; 1. Redistributions of source code must retain the above copyright
+;;    notice, this list of conditions and the following disclaimer.
+;; 2. Redistributions in binary form must reproduce the above copyright
+;;    notice, this list of conditions and the following disclaimer in the
+;;    documentation and/or other materials provided with the distribution.
+;; 3. The name of the authors may not be used to endorse or promote products
+;;    derived from this software without specific prior written permission.
+
+;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+;; IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+(cond-expand
+ (guile)
+ (mes
+  (define-macro (define-syntax macro-name transformer . stuff)
+    `(define-macro (,macro-name . args)
+       (,transformer (cons ',macro-name args)
+                     (lambda (x0) x0)
+                     eq?)))))
+
+;; Rewrite-rule compiler (a.k.a. "extend-syntax")
+
+;; Example:
+;;
+;; (define-syntax or
+;;   (syntax-rules ()
+;;     ((or) #f)
+;;     ((or e) e)
+;;     ((or e1 e ...) (let ((temp e1))
+;;                    (if temp temp (or e ...))))))
+
+(cond-expand
+ (guile)
+ (mes
+  (define-syntax syntax-rules
+    (let ()
+      (define name? symbol?)
+
+      (define (segment-pattern? pattern)
+        (and (segment-template? pattern)
+             (or (null? (cddr pattern))
+                 (syntax-error "segment matching not implemented" pattern))))
+    
+      (define (segment-template? pattern)
+        (and (pair? pattern)
+             (pair? (cdr pattern))
+             (memq (cadr pattern) indicators-for-zero-or-more)))
+    
+      (define indicators-for-zero-or-more (list (string->symbol "...") '---))
+    
+      (lambda (exp r c)
+
+        (define %input (r '%input))     ;Gensym these, if you like.
+        (define %compare (r '%compare))
+        (define %rename (r '%rename))
+        (define %tail (r '%tail))
+        (define %temp (r '%temp))
+
+        (define rules (cddr exp))
+        (define subkeywords (cadr exp))
+
+        (define (make-transformer rules)
+          ;;(core:display-error "make-transformer:") (core:write-error rules) (core:display-error "\n")
+          `(lambda (,%input ,%rename ,%compare)
+             (let ((,%tail (cdr ,%input)))
+               (cond ,@(map process-rule rules)
+                     (else
+                      (syntax-error
+                       "use of macro doesn't match definition"
+                       ,%input))))))
+
+        (define (process-rule rule)
+          ;;(core:display-error "process-rule:") (core:write-error rule) (core:display-error "\n")
+          (if (and (pair? rule)
+                   (pair? (cdr rule))
+                   (null? (cddr rule)))
+              (let ((pattern (cdar rule))
+                    (template (cadr rule)))
+                `((and ,@(process-match %tail pattern))
+                  (let* ,(process-pattern pattern
+                                          %tail
+                                          (lambda (x) x))
+                    ,(process-template template
+                                       0
+                                       (meta-variables pattern 0 '())))))
+              (syntax-error "ill-formed syntax rule" rule)))
+      
+        ;; Generate code to test whether input expression matches pattern
+
+        (define (process-match input pattern)
+          ;;(core:display-error "process-match:") (core:write-error input) (core:display-error "\n")
+          ;;(core:display-error "      pattern:") (core:write-error pattern) (core:display-error "\n")
+          (cond ((name? pattern)
+                 (if (member pattern subkeywords)
+                     `((,%compare ,input (,%rename ',pattern)))
+                     `()))
+                ((segment-pattern? pattern)
+                 (process-segment-match input (car pattern)))
+                ((pair? pattern)
+                 `((let ((,%temp ,input))
+                     (and (pair? ,%temp)
+                          ,@(process-match `(car ,%temp) (car pattern))
+                          ,@(process-match `(cdr ,%temp) (cdr pattern))))))
+                ((or (null? pattern) (boolean? pattern) (char? pattern))
+                 `((eq? ,input ',pattern)))
+                (else
+                 `((equal? ,input ',pattern)))))
+      
+        (define (process-segment-match input pattern)
+          ;;(core:display-error "process-segment-match:") (core:write-error input) (core:display-error "\n")
+          ;;(core:display-error "              pattern:") (core:write-error pattern) (core:display-error "\n")
+          (let ((conjuncts (process-match '(car l) pattern)))
+            (if (null? conjuncts)
+                `((list? ,input))       ;+++
+                `((let loop ((l ,input))
+                    (or (null? l)
+                        (and (pair? l)
+                             ,@conjuncts
+                             (loop (cdr l)))))))))
+      
+        ;; Generate code to take apart the input expression
+        ;; This is pretty bad, but it seems to work (can't say why).
+
+        (define (process-pattern pattern path mapit)
+          ;;(core:display-error "process-pattern:") (core:write-error pattern) (core:display-error "\n")
+          ;;(core:display-error "           path:") (core:write-error path) (core:display-error "\n")
+          (cond ((name? pattern)
+                 (if (memq pattern subkeywords)
+                     '()
+                     (list (list pattern (mapit path)))))
+                ((segment-pattern? pattern)
+                 (process-pattern (car pattern)
+                                  %temp
+                                  (lambda (x) ;temp is free in x
+                                    (mapit (if (eq? %temp x)
+                                               path ;+++
+                                               `(map (lambda (,%temp) ,x)
+                                                     ,path))))))
+                ((pair? pattern)
+                 (append (process-pattern (car pattern) `(car ,path) mapit)
+                         (process-pattern (cdr pattern) `(cdr ,path) mapit)))
+                (else '())))
+
+        ;; Generate code to compose the output expression according to template
+
+        (define (process-template template rank env)
+          ;;(core:display-error "process-template:") (core:write-error template) (core:display-error "\n")
+          (cond ((name? template)
+                 (let ((probe (assq template env)))
+                   (if probe
+                       (if (<= (cdr probe) rank)
+                           template
+                           (syntax-error "template rank error (too few ...'s?)"
+                                         template))
+                       `(,%rename ',template))))
+                ((segment-template? template)
+                 (let ((vars
+                        (free-meta-variables (car template) (+ rank 1) env '())))
+                   (if (null? vars)
+                       (silent-syntax-error "too many ...'s" template)
+                       (let* ((x (process-template (car template)
+                                                   (+ rank 1)
+                                                   env))
+                              (gen (if (equal? (list x) vars)
+                                       x ;+++
+                                       `(map (lambda ,vars ,x)
+                                             ,@vars))))
+                         (if (null? (cddr template))
+                             gen        ;+++
+                             `(append ,gen ,(process-template (cddr template)
+                                                              rank env)))))))
+                ((pair? template)
+                 `(cons ,(process-template (car template) rank env)
+                        ,(process-template (cdr template) rank env)))
+                (else `(quote ,template))))
+
+        ;; Return an association list of (var . rank)
+
+        (define (meta-variables pattern rank vars)
+          ;;(core:display-error "meta-variables:") (core:write-error pattern) (core:display-error "\n")
+          (cond ((name? pattern)
+                 (if (memq pattern subkeywords)
+                     vars
+                     (cons (cons pattern rank) vars)))
+                ((segment-pattern? pattern)
+                 (meta-variables (car pattern) (+ rank 1) vars))
+                ((pair? pattern)
+                 (meta-variables (car pattern) rank
+                                 (meta-variables (cdr pattern) rank vars)))
+                (else vars)))
+
+        ;; Return a list of meta-variables of given higher rank
+
+        (define (free-meta-variables template rank env free)
+          ;;(core:display-error "meta-variables:") (core:write-error template) (core:display-error "\n")
+          (cond ((name? template)
+                 (if (and (not (memq template free))
+                          (let ((probe (assq template env)))
+                            (and probe (>= (cdr probe) rank))))
+                     (cons template free)
+                     free))
+                ((segment-template? template)
+                 (free-meta-variables (car template)
+                                      rank env
+                                      (free-meta-variables (cddr template)
+                                                           rank env free)))
+                ((pair? template)
+                 (free-meta-variables (car template)
+                                      rank env
+                                      (free-meta-variables (cdr template)
+                                                           rank env free)))
+                (else free)))
+
+        c                               ;ignored
+
+        ;; Kludge for Scheme48 linker.
+        ;; `(cons ,(make-transformer rules)
+        ;;          ',(find-free-names-in-syntax-rules subkeywords rules))
+
+        (make-transformer rules))))))
+
+(cond-expand
+ (guile)
+ (mes
+  (define-macro (let-syntax bindings . rest)
+    `((lambda ()
+        ,@(map (lambda (binding)
+                 `(define-macro (,(car binding) . args)
+                    (,(cadr binding) (cons ',(car binding) args)
+                     (lambda (x0) x0)
+                     eq?)))
+               bindings)
+        ,@rest)))))
+
+(core:display
+ (let-syntax ((xwhen (syntax-rules ()
+                       ((xwhen condition exp ...)
+                        (if (not condition)
+                            (begin exp ...))))))
+   (xwhen #f 42)))
+
diff --git a/scaffold/boot/data/bar.mes b/scaffold/boot/data/bar.mes
new file mode 100644 (file)
index 0000000..79d1153
--- /dev/null
@@ -0,0 +1,24 @@
+;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(define-macro (define-module module . rest) #t)
+(define-module (ice-9 optargs)
+  #t)
+(core:display-error "bar!\n")
diff --git a/scaffold/boot/data/i.scm b/scaffold/boot/data/i.scm
new file mode 100644 (file)
index 0000000..6b9acd4
--- /dev/null
@@ -0,0 +1,21 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(core:display "hello i.scm\n")
+(define (from-i) "*from-i*")
+(define-macro (from-i-macro) "*from-i-macro*")
diff --git a/scaffold/boot/data/module.mes b/scaffold/boot/data/module.mes
new file mode 100644 (file)
index 0000000..bafc766
--- /dev/null
@@ -0,0 +1,21 @@
+;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(display "hallo\n")
\ No newline at end of file
diff --git a/scaffold/cons-mes.c b/scaffold/cons-mes.c
new file mode 100644 (file)
index 0000000..8f21d4c
--- /dev/null
@@ -0,0 +1,872 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2018 Jan 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/>.
+ */
+
+#if POSIX
+#error "POSIX not supported"
+#endif
+
+#include <stdio.h>
+#include <assert.h>
+#include <stdlib.h>
+#include <string.h>
+#include <mlibc.h>
+
+char arena[2000];
+
+typedef int SCM;
+
+int g_debug = 0;
+int g_free = 0;
+
+SCM g_continuations = 0;
+SCM g_symbols = 0;
+SCM g_stack = 0;
+SCM r0 = 0; // a/env
+SCM r1 = 0; // param 1
+SCM r2 = 0; // save 2+load/dump
+SCM r3 = 0; // continuation
+
+enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVECTOR, TBROKEN_HEART};
+
+struct scm {
+  enum type_t type;
+  SCM car;
+  SCM cdr;
+};
+
+struct function {
+  int (*function) (void);
+  int arity;
+  char *name;
+};
+
+#if __MESC__
+struct scm *g_cells = arena;
+#else
+struct scm *g_cells = (struct scm*)arena;
+#endif
+
+#define cell_nil 1
+#define cell_f 2
+#define cell_t 3
+#define cell_dot 4
+// #define cell_arrow 5
+#define cell_undefined 6
+#define cell_unspecified 7
+#define cell_closure 8
+#define cell_circular 9
+#define cell_begin 10
+#define cell_symbol_dot 11
+#define cell_symbol_lambda 12
+#define cell_symbol_begin 13
+#define cell_symbol_if 14
+#define cell_symbol_quote 15
+#define cell_symbol_set_x 16
+
+#define cell_vm_apply 45
+#define cell_vm_apply2 46
+
+#define cell_vm_eval 47
+
+#define cell_vm_begin 56
+//#define cell_vm_begin_read_input_file 57
+#define cell_vm_begin2 58
+
+#define cell_vm_return 63
+
+SCM tmp;
+SCM tmp_num;
+SCM tmp_num2;
+
+int ARENA_SIZE = 200;
+struct function g_functions[5];
+int g_function = 0;
+
+
+SCM make_cell_ (SCM type, SCM car, SCM cdr);
+struct function fun_make_cell_ = {&make_cell_,3,"core:make-cell"};
+struct scm scm_make_cell_ = {TFUNCTION,0,0};
+   //, "core:make-cell", 0};
+SCM cell_make_cell_;
+
+SCM cons (SCM x, SCM y);
+struct function fun_cons = {&cons,2,"cons"};
+struct scm scm_cons = {TFUNCTION,0,0};
+  // "cons", 0};
+SCM cell_cons;
+
+SCM car (SCM x);
+struct function fun_car = {&car,1,"car"};
+struct scm scm_car = {TFUNCTION,0,0};
+  // "car", 0};
+SCM cell_car;
+
+SCM cdr (SCM x);
+struct function fun_cdr = {&cdr,1,"cdr"};
+struct scm scm_cdr = {TFUNCTION,0,0};
+// "cdr", 0};
+SCM cell_cdr;
+
+// SCM eq_p (SCM x, SCM y);
+// struct function fun_eq_p = {&eq_p,2,"eq?"};
+// scm scm_eq_p = {TFUNCTION,0,0};
+// SCM cell_eq_p;
+
+#define TYPE(x) (g_cells[x].type)
+
+#define CAR(x) g_cells[x].car
+#define LENGTH(x) g_cells[x].car
+#define STRING(x) g_cells[x].car
+
+#define CDR(x) g_cells[x].cdr
+#define CONTINUATION(x) g_cells[x].cdr
+
+#define FUNCTION(x) g_functions[g_cells[x].cdr]
+#define VALUE(x) g_cells[x].cdr
+#define VECTOR(x) g_cells[x].cdr
+
+#define MAKE_CHAR(n) make_cell_ (tmp_num_ (TCHAR), 0, tmp_num2_ (n))
+#define MAKE_NUMBER(n) make_cell_ (tmp_num_ (TNUMBER), 0, tmp_num2_ (n))
+
+#define CAAR(x) CAR (CAR (x))
+#define CADAR(x) CAR (CDR (CAR (x)))
+#define CDADAR(x) CAR (CDR (CAR (CDR (x))))
+#define CADR(x) CAR (CDR (x))
+
+#define MAKE_STRING(x) make_cell_ (tmp_num_ (TSTRING), x, 0)
+
+SCM
+alloc (int n)
+{
+  assert (g_free + n < ARENA_SIZE);
+  SCM x = g_free;
+  g_free += n;
+  return x;
+}
+
+SCM
+make_cell_ (SCM type, SCM car, SCM cdr)
+{
+  SCM x = alloc (1);
+  assert (TYPE (type) == TNUMBER);
+  TYPE (x) = VALUE (type);
+  if (VALUE (type) == TCHAR || VALUE (type) == TNUMBER) {
+    if (car) CAR (x) = CAR (car);
+    if (cdr) CDR(x) = CDR(cdr);
+  }
+  else if (VALUE (type) == TFUNCTION) {
+    if (car) CAR (x) = car;
+    if (cdr) CDR(x) = CDR(cdr);
+  }
+  else {
+    CAR (x) = car;
+    CDR(x) = cdr;
+  }
+  return x;
+}
+
+SCM
+tmp_num_ (int x)
+{
+  VALUE (tmp_num) = x;
+  return tmp_num;
+}
+
+SCM
+tmp_num2_ (int x)
+{
+  VALUE (tmp_num2) = x;
+  return tmp_num2;
+}
+
+SCM
+cons (SCM x, SCM y)
+{
+  VALUE (tmp_num) = TPAIR;
+  return make_cell_ (tmp_num, x, y);
+}
+
+SCM
+car (SCM x)
+{
+  return CAR (x);
+}
+
+SCM
+cdr (SCM x)
+{
+  return CDR(x);
+}
+
+SCM
+gc_push_frame ()
+{
+  SCM frame = cons (r1, cons (r2, cons (r3, cons (r0, cell_nil))));
+  g_stack = cons (frame, g_stack);
+  return g_stack;
+}
+
+SCM
+append2 (SCM x, SCM y)
+{
+  if (x == cell_nil) return y;
+  assert (TYPE (x) == TPAIR);
+  return cons (car (x), append2 (cdr (x), y));
+}
+
+SCM
+pairlis (SCM x, SCM y, SCM a)
+{
+  if (x == cell_nil)
+    return a;
+  if (TYPE (x) != TPAIR)
+    return cons (cons (x, y), a);
+  return cons (cons (car (x), car (y)),
+               pairlis (cdr (x), cdr (y), a));
+}
+
+SCM
+assq (SCM x, SCM a)
+{
+  while (a != cell_nil && x == CAAR (a)) a = CDR (a);
+  return a != cell_nil ? car (a) : cell_f;
+}
+
+SCM
+push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
+{
+  puts ("push cc\n");
+  SCM x = r3;
+  r3 = c;
+  r2 = p2;
+  gc_push_frame ();
+  r1 = p1;
+  r0 = a;
+  r3 = x;
+  return cell_unspecified;
+}
+
+SCM caar (SCM x) {return car (car (x));}
+SCM cadr (SCM x) {return car (cdr (x));}
+SCM cdar (SCM x) {return cdr (car (x));}
+SCM cddr (SCM x) {return cdr (cdr (x));}
+
+#if __GNUC__
+//FIXME
+SCM call (SCM,SCM);
+SCM gc_pop_frame ();
+#endif
+
+SCM
+eval_apply ()
+{
+ eval_apply:
+  switch (r3)
+    {
+    case cell_vm_apply: {goto apply;}
+    case cell_unspecified: {return r1;}
+    }
+
+  SCM x = cell_nil;
+  SCM y = cell_nil;
+
+ apply:
+  switch (TYPE (car (r1)))
+    {
+    case TFUNCTION: {
+      puts ("apply.function\n");
+      r1 = call (car (r1), cdr (r1));
+      goto vm_return;
+    }
+    }
+ vm_return:
+  x = r1;
+  gc_pop_frame ();
+  r1 = x;
+  goto eval_apply;
+}
+
+SCM
+call (SCM fn, SCM x)
+{
+  puts ("call\n");
+  if ((FUNCTION (fn).arity > 0 || FUNCTION (fn).arity == -1)
+      && x != cell_nil && TYPE (CAR (x)) == TVALUES)
+    x = cons (CADAR (x), CDR (x));
+  if ((FUNCTION (fn).arity > 1 || FUNCTION (fn).arity == -1)
+      && x != cell_nil && TYPE (CDR (x)) == TPAIR && TYPE (CADR (x)) == TVALUES)
+    x = cons (CAR (x), cons (CDADAR (x), CDR (x)));
+  switch (FUNCTION (fn).arity)
+    {
+    case 0: {return (FUNCTION (fn).function) ();}
+    case 1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (car (x));}
+    case 2: {return ((SCM(*)(SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x));}
+    case 3: {return ((SCM(*)(SCM,SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x), car (cddr (x)));}
+    case -1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);}
+    }
+  return cell_unspecified;
+}
+
+SCM
+gc_peek_frame ()
+{
+  SCM frame = car (g_stack);
+  r1 = car (frame);
+  r2 = cadr (frame);
+  r3 = car (cddr (frame));
+  r0 = cadr (cddr (frame));
+  return frame;
+}
+
+SCM
+gc_pop_frame ()
+{
+  SCM frame = gc_peek_frame (g_stack);
+  g_stack = cdr (g_stack);
+  return frame;
+}
+
+SCM
+mes_g_stack (SCM a) ///((internal))
+{
+  r0 = a;
+  r1 = MAKE_CHAR (0);
+  r2 = MAKE_CHAR (0);
+  r3 = MAKE_CHAR (0);
+  g_stack = cons (cell_nil, cell_nil);
+  return r0;
+}
+
+//\f Environment setup
+SCM
+make_tmps (struct scm* cells)
+{
+  tmp = g_free++;
+  cells[tmp].type = TCHAR;
+  tmp_num = g_free++;
+  cells[tmp_num].type = TNUMBER;
+  tmp_num2 = g_free++;
+  cells[tmp_num2].type = TNUMBER;
+  return 0;
+}
+
+SCM
+make_symbol_ (SCM s)
+{
+  VALUE (tmp_num) = TSYMBOL;
+  SCM x = make_cell_ (tmp_num, s, 0);
+  g_symbols = cons (x, g_symbols);
+  return x;
+}
+
+SCM
+make_symbol (SCM s)
+{
+  SCM x = 0;
+  return x ? x : make_symbol_ (s);
+}
+
+SCM
+acons (SCM key, SCM value, SCM alist)
+{
+  return cons (cons (key, value), alist);
+}
+
+//\f Jam Collector
+SCM g_symbol_max;
+
+SCM
+gc_init_cells ()
+{
+  return 0;
+}
+
+// INIT NEWS
+
+SCM
+mes_symbols () ///((internal))
+{
+  gc_init_cells ();
+  //  gc_init_news ();
+
+#if __GNUC__ && 0
+  //#include "mes.symbols.i"
+#else
+g_free++;
+// g_cells[cell_nil] = scm_nil;
+
+g_free++;
+// g_cells[cell_f] = scm_f;
+
+g_free++;
+// g_cells[cell_t] = scm_t;
+
+g_free++;
+// g_cells[cell_dot] = scm_dot;
+
+g_free++;
+// g_cells[cell_arrow] = scm_arrow;
+
+g_free++;
+// g_cells[cell_undefined] = scm_undefined;
+
+g_free++;
+// g_cells[cell_unspecified] = scm_unspecified;
+
+g_free++;
+// g_cells[cell_closure] = scm_closure;
+
+g_free++;
+// g_cells[cell_circular] = scm_circular;
+
+g_free++;
+// g_cells[cell_begin] = scm_begin;
+
+///
+g_free = 44;
+g_free++;
+// g_cells[cell_vm_apply] = scm_vm_apply;
+
+g_free++;
+// g_cells[cell_vm_apply2] = scm_vm_apply2;
+
+g_free++;
+// g_cells[cell_vm_eval] = scm_vm_eval;
+
+///
+g_free = 55;
+g_free++;
+// g_cells[cell_vm_begin] = scm_vm_begin;
+
+g_free++;
+// g_cells[cell_vm_begin_read_input_file] = scm_vm_begin_read_input_file;
+
+g_free++;
+// g_cells[cell_vm_begin2] = scm_vm_begin2;
+
+///
+g_free = 62;
+g_free++;
+// g_cells[cell_vm_return] = scm_vm_return;
+
+#endif
+
+  g_symbol_max = g_free;
+  make_tmps (g_cells);
+
+  g_symbols = 0;
+  for (int i=1; i<g_symbol_max; i++)
+    g_symbols = cons (i, g_symbols);
+
+  SCM a = cell_nil;
+
+  a = acons (cell_symbol_dot, cell_dot, a);
+  a = acons (cell_symbol_begin, cell_begin, a);
+  a = acons (cell_closure, a, a);
+
+  return a;
+}
+
+SCM
+make_closure (SCM args, SCM body, SCM a)
+{
+  return make_cell_ (tmp_num_ (TCLOSURE), cell_f, cons (cons (cell_circular, a), cons (args, body)));
+}
+
+SCM
+mes_environment () ///((internal))
+{
+  SCM a = 0;
+  a = mes_symbols ();
+  a = mes_g_stack (a);
+  return a;
+}
+
+SCM
+mes_builtins (SCM a)
+{
+#if 0
+  //__GNUC__
+//#include "mes.i"
+
+// #include "lib.i"
+// #include "math.i"
+// #include "posix.i"
+// #include "reader.i"
+
+// #include "lib.environment.i"
+// #include "math.environment.i"
+// #include "mes.environment.i"
+// #include "posix.environment.i"
+// #include "reader.environment.i"
+#else
+scm_make_cell_.cdr = g_function;
+g_functions[g_function++] = fun_make_cell_;
+cell_make_cell_ = g_free++;
+ g_cells[cell_make_cell_] = scm_make_cell_;
+scm_cons.cdr = g_function;
+g_functions[g_function++] = fun_cons;
+cell_cons = g_free++;
+g_cells[cell_cons] = scm_cons;
+scm_car.cdr = g_function;
+g_functions[g_function++] = fun_car;
+cell_car = g_free++;
+g_cells[cell_car] = scm_car;
+scm_cdr.cdr = g_function;
+g_functions[g_function++] = fun_cdr;
+cell_cdr = g_free++;
+g_cells[cell_cdr] = scm_cdr;
+#endif
+  return a;
+}
+
+SCM
+bload_env (SCM a) ///((internal))
+{
+  g_stdin = open ("module/mes/read-0.mo", 0);
+  char *p = (char*)g_cells;
+  assert (getchar () == 'M');
+  assert (getchar () == 'E');
+  assert (getchar () == 'S');
+  g_stack = getchar () << 8;
+  g_stack += getchar ();
+  int c = getchar ();
+  while (c != EOF)
+    {
+      *p++ = c;
+      c = getchar ();
+    }
+  g_free = (p-(char*)g_cells) / sizeof (struct scm);
+  gc_peek_frame ();
+  g_symbols = r1;
+  g_stdin = STDIN;
+  r0 = mes_builtins (r0);
+  return r2;
+}
+
+SCM
+fill ()
+{
+  TYPE (0) = 0x6c6c6168;
+  CAR (0) = 0x6a746f6f;
+  CDR (0) = 0x00002165;
+
+  TYPE (1) = TSYMBOL;
+  CAR (1) = 0x2d2d2d2d;
+  CDR (1) = 0x3e3e3e3e;
+
+  TYPE (9) = 0x2d2d2d2d;
+  CAR (9) = 0x2d2d2d2d;
+  CDR (9) = 0x3e3e3e3e;
+
+  // (cons 0 1)
+  TYPE (10) = TPAIR;
+  CAR (10) = 11;
+  CDR (10) = 12;
+
+  TYPE (11) = TFUNCTION;
+  CAR (11) = 0x58585858;
+  // 0 = make_cell_
+  // 1 = cons
+  // 2 = car
+  CDR (11) = 1;
+
+  TYPE (12) = TPAIR;
+  CAR (12) = 13;
+  //CDR (12) = 1;
+  CDR (12) = 14;
+
+  TYPE (13) = TNUMBER;
+  CAR (13) = 0x58585858;
+  CDR (13) = 0;
+
+  TYPE (14) = TPAIR;
+  CAR (14) = 15;
+  CDR (14) = 1;
+
+  TYPE (15) = TNUMBER;
+  CAR (15) = 0x58585858;
+  CDR (15) = 1;
+
+  return 0;
+}
+
+SCM
+display_ (SCM x)
+{
+  //puts ("<display>\n");
+  switch (TYPE (x))
+    {
+    case TCHAR:
+      {
+        //puts ("<char>\n");
+        puts ("#\\");
+        putchar (VALUE (x));
+        break;
+      }
+    case TFUNCTION:
+      {
+        //puts ("<function>\n");
+        if (VALUE (x) == 0)
+          puts ("core:make-cell");
+        if (VALUE (x) == 1)
+          puts ("cons");
+        if (VALUE (x) == 2)
+          puts ("car");
+        if (VALUE (x) == 3)
+          puts ("cdr");
+        break;
+      }
+    case TNUMBER:
+      {
+        //puts ("<number>\n");
+#if __GNUC__
+        puts (itoa (VALUE (x)));
+#else
+        int i;
+        i = VALUE (x);
+        i = i + 48;
+        putchar (i);
+#endif
+        break;
+      }
+    case TPAIR:
+      {
+        //puts ("<pair>\n");
+        //if (cont != cell_f) puts "(");
+        puts ("(");
+        if (x && x != cell_nil) display_ (CAR (x));
+        if (CDR (x) && CDR (x) != cell_nil)
+          {
+#if __GNUC__
+            if (TYPE (CDR (x)) != TPAIR)
+              puts (" . ");
+#else
+            int c;
+            c = CDR (x);
+            c = TYPE (c);
+            if (c != TPAIR)
+              puts (" . ");
+#endif
+            display_ (CDR (x));
+          }
+        //if (cont != cell_f) puts (")");
+        puts (")");
+        break;
+      }
+    case TSPECIAL:
+      {
+        switch (x)
+          {
+          case 1: {puts ("()"); break;}
+          case 2: {puts ("#f"); break;}
+          case 3: {puts ("#t"); break;}
+          default:
+            {
+#if __GNUC__
+        puts ("<x:");
+        puts (itoa (x));
+        puts (">");
+#else
+        puts ("<x>");
+#endif
+            }
+          }
+        break;
+      }
+    case TSYMBOL:
+      {
+        switch (x)
+          {
+          case 11: {puts (" . "); break;}
+          case 12: {puts ("lambda"); break;}
+          case 13: {puts ("begin"); break;}
+          case 14: {puts ("if"); break;}
+          case 15: {puts ("quote"); break;}
+          case 37: {puts ("car"); break;}
+          case 38: {puts ("cdr"); break;}
+          case 39: {puts ("null?"); break;}
+          case 40: {puts ("eq?"); break;}
+          case 41: {puts ("cons"); break;}
+          default:
+            {
+#if __GNUC__
+        puts ("<s:");
+        puts (itoa (x));
+        puts (">");
+#else
+        puts ("<s>");
+#endif
+            }
+          }
+        break;
+      }
+    default:
+      {
+        //puts ("<default>\n");
+#if __GNUC__
+        puts ("<");
+        puts (itoa (TYPE (x)));
+        puts (":");
+        puts (itoa (x));
+        puts (">");
+#else
+        puts ("_");
+#endif
+        break;
+      }
+    }
+  return 0;
+}
+
+SCM
+simple_bload_env (SCM a) ///((internal))
+{
+  puts ("reading: ");
+  char *mo = "module/mes/tiny-0-32.mo";
+  puts (mo);
+  puts ("\n");
+  g_stdin = open (mo, 0);
+  if (g_stdin < 0) {eputs ("no such file: module/mes/tiny-0-32.mo\n");return 1;}
+
+  char *p = (char*)g_cells;
+  int c;
+
+  assert (getchar () == 'M');
+  assert (getchar () == 'E');
+  assert (getchar () == 'S');
+  puts (" *GOT MES*\n");
+
+  g_stack = getchar () << 8;
+  g_stack += getchar ();
+
+  puts ("stack: ");
+  puts (itoa (g_stack));
+  puts ("\n");
+
+  c = getchar ();
+  while (c != -1)
+    {
+      *p++ = c;
+      c = getchar ();
+    }
+
+  puts ("read done\n");
+
+  g_free = (p-(char*)g_cells) / sizeof (struct scm);
+  
+  if (g_free != 15) exit (33);
+  
+  g_symbols = 1;
+
+  g_stdin = STDIN;
+  r0 = mes_builtins (r0);
+  
+  if (g_free != 19) exit (34);
+  
+  puts ("cells read: ");
+  puts (itoa (g_free));
+  puts ("\n");
+
+  puts ("symbols: ");
+  puts (itoa (g_symbols));
+  puts ("\n");
+  // display_ (g_symbols);
+  // puts ("\n");
+
+  display_ (10);
+  puts ("\n");
+
+  fill ();
+  r2 = 10;
+
+  if (TYPE (12) != TPAIR)
+    exit (33);
+
+  puts ("program[");
+  puts (itoa (r2));
+  puts ("]: ");
+
+  display_ (r2);
+  //display_ (14);
+  puts ("\n");
+
+  r0 = 1;
+  //r2 = 10;
+  return r2;
+}
+
+int
+main (int argc, char *argv[])
+{
+  puts ("Hello cons-mes!\n");
+  if (argc > 1 && !strcmp (argv[1], "--help")) return eputs ("Usage: mes [--dump|--load] < FILE");
+#if __GNUC__
+  if (argc > 1 && !strcmp (argv[1], "--version")) {eputs ("Mes ");return eputs (VERSION);};
+#else
+  if (argc > 1 && !strcmp (argv[1], "--version")) {eputs ("Mes ");return eputs ("0.4");};
+#endif
+  g_stdin = STDIN;
+
+  r0 = mes_environment ();
+  
+  SCM program = simple_bload_env (r0);
+
+  puts ("g_free=");
+  puts (itoa(g_free));
+  puts ("\n");
+
+  push_cc (r2, cell_unspecified, r0, cell_unspecified);
+
+  puts ("g_free=");
+  puts (itoa(g_free));
+  puts ("\n");
+
+  puts ("g_stack=");
+  puts (itoa(g_stack));
+  puts ("\n");
+
+  puts ("r0=");
+  puts (itoa(r0));
+  puts ("\n");
+
+  puts ("r1=");
+  puts (itoa(r1));
+  puts ("\n");
+
+  puts ("r2=");
+  puts (itoa(r2));
+  puts ("\n");
+
+  puts ("r3=");
+  puts (itoa(r3));
+  puts ("\n");
+
+  r3 = cell_vm_apply;
+  r1 = eval_apply ();
+  display_ (r1);
+
+  eputs ("\n");
+  return 0;
+}
+
diff --git a/scaffold/mini-mes.c b/scaffold/mini-mes.c
new file mode 100644 (file)
index 0000000..d4294f2
--- /dev/null
@@ -0,0 +1,1261 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2018 Jan 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/>.
+ */
+
+#if POSIX
+#error "POSIX not supported"
+#endif
+
+#include <stdio.h>
+#include <assert.h>
+#include <stdlib.h>
+#include <string.h>
+#include <mlibc.h>
+
+int ARENA_SIZE = 100000;
+int MAX_ARENA_SIZE = 40000000;
+int GC_SAFETY = 10000;
+
+char *g_arena = 0;
+typedef int SCM;
+
+int g_debug = 0;
+int g_free = 0;
+
+SCM g_continuations = 0;
+SCM g_symbols = 0;
+SCM g_stack = 0;
+// a/env
+SCM r0 = 0;
+// param 1
+SCM r1 = 0;
+// save 2+load/dump
+SCM r2 = 0;
+// continuation
+SCM r3 = 0;
+
+enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVARIABLE, TVECTOR, TBROKEN_HEART};
+
+struct scm {
+  enum type_t type;
+  SCM car;
+  SCM cdr;
+};
+struct function {
+  int (*function) (void);
+  int arity;
+  char *name;
+};
+
+#if __MESC__
+//FIXME
+char *foobar = 0;
+struct scm *g_cells = foobar;
+struct scm *g_news = foobar;
+#else
+struct scm *g_cells = 0;
+struct scm *g_news = 0;
+#endif
+
+struct scm scm_nil = {TSPECIAL, "()",0};
+struct scm scm_f = {TSPECIAL, "#f",0};
+struct scm scm_t = {TSPECIAL, "#t",0};
+struct scm scm_dot = {TSPECIAL, ".",0};
+struct scm scm_arrow = {TSPECIAL, "=>",0};
+struct scm scm_undefined = {TSPECIAL, "*undefined*",0};
+struct scm scm_unspecified = {TSPECIAL, "*unspecified*",0};
+struct scm scm_closure = {TSPECIAL, "*closure*",0};
+struct scm scm_circular = {TSPECIAL, "*circular*",0};
+struct scm scm_begin = {TSPECIAL, "*begin*",0};
+
+struct scm scm_symbol_dot = {TSYMBOL, "*dot*",0};
+struct scm scm_symbol_lambda = {TSYMBOL, "lambda",0};
+struct scm scm_symbol_begin = {TSYMBOL, "begin",0};
+struct scm scm_symbol_if = {TSYMBOL, "if",0};
+struct scm scm_symbol_quote = {TSYMBOL, "quote",0};
+struct scm scm_symbol_define = {TSYMBOL, "define",0};
+struct scm scm_symbol_define_macro = {TSYMBOL, "define-macro",0};
+
+struct scm scm_symbol_quasiquote = {TSYMBOL, "quasiquote", 0};
+struct scm scm_symbol_unquote = {TSYMBOL, "unquote", 0};
+struct scm scm_symbol_unquote_splicing = {TSYMBOL, "unquote-splicing", 0};
+struct scm scm_symbol_syntax = {TSYMBOL, "syntax",0};
+struct scm scm_symbol_quasisyntax = {TSYMBOL, "quasisyntax", 0};
+struct scm scm_symbol_unsyntax = {TSYMBOL, "unsyntax", 0};
+struct scm scm_symbol_unsyntax_splicing = {TSYMBOL, "unsyntax-splicing", 0};
+
+struct scm scm_symbol_set_x = {TSYMBOL, "set!",0};
+
+struct scm scm_symbol_sc_expand = {TSYMBOL, "sc-expand",0};
+struct scm scm_symbol_macro_expand = {TSYMBOL, "macro-expand",0};
+struct scm scm_symbol_sc_expander_alist = {TSYMBOL, "*sc-expander-alist*",0};
+
+struct scm scm_symbol_call_with_values = {TSYMBOL, "call-with-values",0};
+struct scm scm_call_with_current_continuation = {TSPECIAL, "*call/cc*",0};
+struct scm scm_symbol_call_with_current_continuation = {TSYMBOL, "call-with-current-continuation",0};
+struct scm scm_symbol_current_module = {TSYMBOL, "current-module",0};
+struct scm scm_symbol_primitive_load = {TSYMBOL, "primitive-load",0};
+struct scm scm_symbol_read_input_file = {TSYMBOL, "read-input-file",0};
+struct scm scm_symbol_write = {TSYMBOL, "write",0};
+struct scm scm_symbol_display = {TSYMBOL, "display",0};
+
+struct scm scm_symbol_throw = {TSYMBOL, "throw",0};
+struct scm scm_symbol_not_a_number = {TSYMBOL, "not-a-number",0};
+struct scm scm_symbol_not_a_pair = {TSYMBOL, "not-a-pair",0};
+struct scm scm_symbol_system_error = {TSYMBOL, "system-error",0};
+struct scm scm_symbol_wrong_number_of_args = {TSYMBOL, "wrong-number-of-args",0};
+struct scm scm_symbol_wrong_type_arg = {TSYMBOL, "wrong-type-arg",0};
+struct scm scm_symbol_unbound_variable = {TSYMBOL, "unbound-variable",0};
+
+struct scm scm_symbol_argv = {TSYMBOL, "%argv",0};
+struct scm scm_symbol_mes_prefix = {TSYMBOL, "%prefix",0};
+struct scm scm_symbol_mes_version = {TSYMBOL, "%version",0};
+
+struct scm scm_symbol_car = {TSYMBOL, "car",0};
+struct scm scm_symbol_cdr = {TSYMBOL, "cdr",0};
+struct scm scm_symbol_null_p = {TSYMBOL, "null?",0};
+struct scm scm_symbol_eq_p = {TSYMBOL, "eq?",0};
+struct scm scm_symbol_cons = {TSYMBOL, "cons",0};
+
+struct scm scm_vm_evlis = {TSPECIAL, "*vm-evlis*",0};
+struct scm scm_vm_evlis2 = {TSPECIAL, "*vm-evlis2*",0};
+struct scm scm_vm_evlis3 = {TSPECIAL, "*vm-evlis3*",0};
+struct scm scm_vm_apply = {TSPECIAL, "core:apply",0};
+struct scm scm_vm_apply2 = {TSPECIAL, "*vm-apply2*",0};
+struct scm scm_vm_eval = {TSPECIAL, "core:eval",0};
+struct scm scm_vm_eval_define = {TSPECIAL, "*vm-eval-define*",0};
+
+//MES_FIXED_PRIMITIVES
+struct scm scm_vm_eval_car = {TSPECIAL, "*vm-eval-car*",0};
+struct scm scm_vm_eval_cdr = {TSPECIAL, "*vm-eval-cdr*",0};
+struct scm scm_vm_eval_cons = {TSPECIAL, "*vm-eval-cons*",0};
+struct scm scm_vm_eval_null_p = {TSPECIAL, "*vm-eval-null-p*",0};
+
+struct scm scm_vm_eval_set_x = {TSPECIAL, "*vm-eval-set!*",0};
+struct scm scm_vm_eval_macro_expand_eval = {TSPECIAL, "*vm:eval-macro-expand-eval*",0};
+struct scm scm_vm_eval_macro_expand_expand = {TSPECIAL, "*vm:eval-macro-expand-expand*",0};
+struct scm scm_vm_eval_check_func = {TSPECIAL, "*vm-eval-check-func*",0};
+struct scm scm_vm_eval2 = {TSPECIAL, "*vm-eval2*",0};
+struct scm scm_vm_macro_expand = {TSPECIAL, "core:macro-expand",0};
+struct scm scm_vm_macro_expand_define = {TSPECIAL, "*vm:core:macro-expand-define*",0};
+struct scm scm_vm_macro_expand_define_macro = {TSPECIAL, "*vm:core:macro-expand-define-macro*",0};
+struct scm scm_vm_macro_expand_lambda = {TSPECIAL, "*vm:core:macro-expand-lambda*",0};
+struct scm scm_vm_macro_expand_set_x = {TSPECIAL, "*vm:core:macro-expand-set!*",0};
+struct scm scm_vm_begin_expand_primitive_load = {TSPECIAL, "*vm:core:begin-expand-primitive-load*",0};
+struct scm scm_vm_begin_primitive_load = {TSPECIAL, "*vm:core:begin-primitive-load*",0};
+struct scm scm_vm_macro_expand_car = {TSPECIAL, "*vm:core:macro-expand-car*",0};
+struct scm scm_vm_macro_expand_cdr = {TSPECIAL, "*vm:macro-expand-cdr*",0};
+struct scm scm_vm_begin_expand = {TSPECIAL, "*vm:begin-expand*",0};
+struct scm scm_vm_begin_expand_eval = {TSPECIAL, "*vm:begin-expand-eval*",0};
+struct scm scm_vm_begin_expand_macro = {TSPECIAL, "*vm:begin-expand-macro*",0};
+struct scm scm_vm_begin = {TSPECIAL, "*vm-begin*",0};
+struct scm scm_vm_begin_read_input_file = {TSPECIAL, "*vm-begin-read-input-file*",0};
+struct scm scm_vm_begin_eval = {TSPECIAL, "*vm:begin-eval*",0};
+struct scm scm_vm_if = {TSPECIAL, "*vm-if*",0};
+struct scm scm_vm_if_expr = {TSPECIAL, "*vm-if-expr*",0};
+struct scm scm_vm_call_with_values2 = {TSPECIAL, "*vm-call-with-values2*",0};
+struct scm scm_vm_call_with_current_continuation2 = {TSPECIAL, "*vm-call-with-current-continuation2*",0};
+struct scm scm_vm_return = {TSPECIAL, "*vm-return*",0};
+
+struct scm scm_symbol_gnuc = {TSYMBOL, "%gnuc",0};
+struct scm scm_symbol_mesc = {TSYMBOL, "%mesc",0};
+
+struct scm scm_test = {TSYMBOL, "test",0};
+
+#include "mes.mes.symbols.h"
+
+SCM tmp;
+SCM tmp_num;
+SCM tmp_num2;
+
+struct function g_functions[200];
+int g_function = 0;
+
+#include "gc.mes.h"
+#include "lib.mes.h"
+#include "math.mes.h"
+#include "mes.mes.h"
+#include "posix.mes.h"
+// #include "reader.mes.h"
+#include "vector.mes.h"
+
+#define TYPE(x) g_cells[x].type
+#define CAR(x) g_cells[x].car
+#define CDR(x) g_cells[x].cdr
+
+#define NTYPE(x) g_news[x].type
+#define NCAR(x) g_news[x].car
+#define NCDR(x) g_news[x].cdr
+
+#define LENGTH(x) g_cells[x].car
+#define REF(x) g_cells[x].car
+#define STRING(x) g_cells[x].car
+#define VARIABLE(x) g_cells[x].car
+
+#define CLOSURE(x) g_cells[x].cdr
+#define CONTINUATION(x) g_cells[x].cdr
+
+#define FUNCTION(x) g_functions[g_cells[x].cdr]
+#define MACRO(x) g_cells[x].cdr
+#define VALUE(x) g_cells[x].cdr
+#define VECTOR(x) g_cells[x].cdr
+
+#define NLENGTH(x) g_news[x].car
+
+#define NVALUE(x) g_news[x].cdr
+#define NVECTOR(x) g_news[x].cdr
+
+#define MAKE_CHAR(n) make_cell_ (tmp_num_ (TCHAR), 0, tmp_num2_ (n))
+#define MAKE_CONTINUATION(n) make_cell_ (tmp_num_ (TCONTINUATION), n, g_stack)
+#define MAKE_NUMBER(n) make_cell_ (tmp_num_ (TNUMBER), 0, tmp_num2_ (n))
+#define MAKE_REF(n) make_cell_ (tmp_num_ (TREF), n, 0)
+#define MAKE_STRING(x) make_cell_ (tmp_num_ (TSTRING), x, 0)
+
+#define CAAR(x) CAR (CAR (x))
+#define CADR(x) CAR (CDR (x))
+#define CDAR(x) CDR (CAR (x))
+#define CDDR(x) CDR (CDR (x))
+#define CADAR(x) CAR (CDR (CAR (x)))
+#define CADDR(x) CAR (CDR (CDR (x)))
+#define CDADAR(x) CAR (CDR (CAR (CDR (x))))
+
+SCM
+alloc (int n)
+{
+  assert (g_free + n < ARENA_SIZE);
+  SCM x = g_free;
+  g_free += n;
+  return x;
+}
+
+SCM
+tmp_num_ (int x)
+{
+  VALUE (tmp_num) = x;
+  return tmp_num;
+}
+
+SCM
+tmp_num2_ (int x)
+{
+  VALUE (tmp_num2) = x;
+  return tmp_num2;
+}
+
+SCM
+make_cell_ (SCM type, SCM car, SCM cdr)
+{
+  SCM x = alloc (1);
+  assert (TYPE (type) == TNUMBER);
+  TYPE (x) = VALUE (type);
+  if (VALUE (type) == TCHAR || VALUE (type) == TNUMBER) {
+    if (car) CAR (x) = CAR (car);
+    if (cdr) CDR(x) = CDR(cdr);
+  }
+  else if (VALUE (type) == TFUNCTION) {
+    if (car) CAR (x) = car;
+    if (cdr) CDR(x) = CDR(cdr);
+  }
+  else {
+    CAR (x) = car;
+    CDR(x) = cdr;
+  }
+  return x;
+}
+
+SCM
+make_symbol_ (SCM s) ///((internal))
+{
+  VALUE (tmp_num) = TSYMBOL;
+  SCM x = make_cell_ (tmp_num, s, 0);
+  g_symbols = cons (x, g_symbols);
+  return x;
+}
+
+SCM
+list_of_char_equal_p (SCM a, SCM b) ///((internal))
+{
+  while (a != cell_nil && b != cell_nil && VALUE (CAR (a)) == VALUE (CAR (b))) {
+    assert (TYPE (CAR (a)) == TCHAR);
+    assert (TYPE (CAR (b)) == TCHAR);
+    a = CDR (a);
+    b = CDR (b);
+  }
+  return (a == cell_nil && b == cell_nil) ? cell_t : cell_f;
+}
+
+SCM
+lookup_symbol_ (SCM s)
+{
+  SCM x = g_symbols;
+  while (x) {
+    if (list_of_char_equal_p (STRING (CAR (x)), s) == cell_t) break;
+    x = CDR (x);
+  }
+  if (x) x = CAR (x);
+  if (!x) x = make_symbol_ (s);
+  return x;
+}
+
+SCM
+type_ (SCM x)
+{
+  return MAKE_NUMBER (TYPE (x));
+}
+
+SCM
+car_ (SCM x)
+{
+  return (TYPE (x) != TCONTINUATION
+          && (TYPE (CAR (x)) == TPAIR // FIXME: this is weird
+              || TYPE (CAR (x)) == TREF
+              || TYPE (CAR (x)) == TSPECIAL
+              || TYPE (CAR (x)) == TSYMBOL
+              || TYPE (CAR (x)) == TSTRING)) ? CAR (x) : MAKE_NUMBER (CAR (x));
+}
+
+SCM
+cdr_ (SCM x)
+{
+  return (TYPE (CDR (x)) == TPAIR
+          || TYPE (CDR (x)) == TREF
+          || TYPE (CAR (x)) == TSPECIAL
+          || TYPE (CDR (x)) == TSYMBOL
+          || TYPE (CDR (x)) == TSTRING) ? CDR (x) : MAKE_NUMBER (CDR (x));
+}
+
+SCM
+arity_ (SCM x)
+{
+  assert (TYPE (x) == TFUNCTION);
+  return MAKE_NUMBER (FUNCTION (x).arity);
+}
+
+SCM
+cons (SCM x, SCM y)
+{
+  VALUE (tmp_num) = TPAIR;
+  return make_cell_ (tmp_num, x, y);
+}
+
+SCM
+car (SCM x)
+{
+  if (TYPE (x) != TPAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_car));
+  return CAR (x);
+}
+
+SCM
+cdr (SCM x)
+{
+  if (TYPE (x) != TPAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_cdr));
+  return CDR (x);
+}
+
+SCM
+list (SCM x) ///((arity . n))
+{
+  return x;
+}
+
+SCM
+null_p (SCM x)
+{
+  return x == cell_nil ? cell_t : cell_f;
+}
+
+SCM
+eq_p (SCM x, SCM y)
+{
+  return (x == y
+          || ((TYPE (x) == TKEYWORD && TYPE (y) == TKEYWORD
+               && STRING (x) == STRING (y)))
+          || (TYPE (x) == TCHAR && TYPE (y) == TCHAR
+              && VALUE (x) == VALUE (y))
+          || (TYPE (x) == TNUMBER && TYPE (y) == TNUMBER
+              && VALUE (x) == VALUE (y)))
+    ? cell_t : cell_f;
+}
+
+SCM
+values (SCM x) ///((arity . n))
+{
+  SCM v = cons (0, x);
+  TYPE (v) = TVALUES;
+  return v;
+}
+
+SCM
+acons (SCM key, SCM value, SCM alist)
+{
+  return cons (cons (key, value), alist);
+}
+
+SCM
+length (SCM x)
+{
+  int n = 0;
+  while (x != cell_nil)
+    {
+      n++;
+      if (TYPE (x) != TPAIR) return MAKE_NUMBER (-1);
+      x = CDR (x);
+    }
+  return MAKE_NUMBER (n);
+}
+
+SCM apply (SCM, SCM, SCM);
+
+SCM
+error (SCM key, SCM x)
+{
+  SCM throw;
+  if ((throw = assq_ref_env (cell_symbol_throw, r0)) != cell_undefined)
+    return apply (throw, cons (key, cons (x, cell_nil)), r0);
+  display_error_ (key);
+  eputs (": ");
+  display_error_ (x);
+  eputs ("\n");
+  exit (1);
+}
+
+SCM
+cstring_to_list (char const* s)
+{
+  SCM p = cell_nil;
+  int i = strlen (s);
+  while (i--)
+    p = cons (MAKE_CHAR (s[i]), p);
+  return p;
+}
+
+// \f extra lib
+SCM
+assert_defined (SCM x, SCM e) ///((internal))
+{
+  if (e == cell_undefined) return error (cell_symbol_unbound_variable, x);
+  return e;
+}
+
+SCM
+check_formals (SCM f, SCM formals, SCM args) ///((internal))
+{
+  int flen = (TYPE (formals) == TNUMBER) ? VALUE (formals) : VALUE (length (formals));
+  int alen = VALUE (length (args));
+  if (alen != flen && alen != -1 && flen != -1)
+    {
+      char *s = "apply: wrong number of arguments; expected: ";
+      eputs (s);
+      eputs (itoa (flen));
+      eputs (", got: ");
+      eputs (itoa (alen));
+      eputs ("\n");
+      display_error_ (f);
+      SCM e = MAKE_STRING (cstring_to_list (s));
+      return error (cell_symbol_wrong_number_of_args, cons (e, f));
+    }
+  return cell_unspecified;
+}
+
+SCM
+check_apply (SCM f, SCM e) ///((internal))
+{
+  char* type = 0;
+  if (f == cell_f || f == cell_t) type = "bool";
+  if (f == cell_nil) type = "nil";
+  if (f == cell_unspecified) type = "*unspecified*";
+  if (f == cell_undefined) type = "*undefined*";
+  if (TYPE (f) == TCHAR) type = "char";
+  if (TYPE (f) == TNUMBER) type = "number";
+  if (TYPE (f) == TSTRING) type = "string";
+
+  if (type)
+    {
+      char *s = "cannot apply: ";
+      eputs (s);
+      eputs (type);
+      eputs ("[");
+      display_error_ (e);
+      eputs ("]\n");
+      SCM e = MAKE_STRING (cstring_to_list (s));
+      return error (cell_symbol_wrong_type_arg, cons (e, f));
+    }
+  return cell_unspecified;
+}
+
+SCM
+gc_push_frame () ///((internal))
+{
+  SCM frame = cons (r1, cons (r2, cons (r3, cons (r0, cell_nil))));
+  g_stack = cons (frame, g_stack);
+  return g_stack;
+}
+
+SCM
+append2 (SCM x, SCM y)
+{
+  if (x == cell_nil) return y;
+  assert (TYPE (x) == TPAIR);
+  return cons (car (x), append2 (cdr (x), y));
+}
+
+SCM
+pairlis (SCM x, SCM y, SCM a)
+{
+  if (x == cell_nil)
+    return a;
+  if (TYPE (x) != TPAIR)
+    return cons (cons (x, y), a);
+  return cons (cons (car (x), car (y)),
+               pairlis (cdr (x), cdr (y), a));
+}
+
+SCM
+call (SCM fn, SCM x)
+{
+  if ((FUNCTION (fn).arity > 0 || FUNCTION (fn).arity == -1)
+      && x != cell_nil && TYPE (CAR (x)) == TVALUES)
+    x = cons (CADAR (x), CDR (x));
+  if ((FUNCTION (fn).arity > 1 || FUNCTION (fn).arity == -1)
+      && x != cell_nil && TYPE (CDR (x)) == TPAIR && TYPE (CADR (x)) == TVALUES)
+    x = cons (CAR (x), cons (CDADAR (x), CDR (x)));
+  switch (FUNCTION (fn).arity)
+    {
+#if __MESC__ || !_POSIX_SOURCE
+    case 0: return (FUNCTION (fn).function) ();
+    case 1: return ((SCM(*)(SCM))(FUNCTION (fn).function)) (CAR (x));
+    case 2: return ((SCM(*)(SCM,SCM))(FUNCTION (fn).function)) (CAR (x), CADR (x));
+    case 3: return ((SCM(*)(SCM,SCM,SCM))(FUNCTION (fn).function)) (CAR (x), CADR (x), CAR (CDDR (x)));
+    case -1: return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);
+    default: return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);
+#else
+    case 0: return FUNCTION (fn).function0 ();
+    case 1: return FUNCTION (fn).function1 (CAR (x));
+    case 2: return FUNCTION (fn).function2 (CAR (x), CADR (x));
+    case 3: return FUNCTION (fn).function3 (CAR (x), CADR (x), CAR (CDDR (x)));
+    case -1: return FUNCTION (fn).functionn (x);
+#endif
+    }
+
+  return cell_unspecified;
+}
+
+SCM
+assq (SCM x, SCM a)
+{
+  //FIXME: move into fast-non eq_p-ing assq core:assq?
+  //while (a != cell_nil && x != CAAR (a)) a = CDR (a);
+  while (a != cell_nil && eq_p (x, CAAR (a)) == cell_f) a = CDR (a);
+  return a != cell_nil ? CAR (a) : cell_f;
+}
+
+SCM
+assq_ref_env (SCM x, SCM a)
+{
+  x = assq (x, a);
+  if (x == cell_f) return cell_undefined;
+  return CDR (x);
+}
+
+SCM
+set_car_x (SCM x, SCM e)
+{
+  assert (TYPE (x) == TPAIR);
+  CAR (x) = e;
+  return cell_unspecified;
+}
+
+SCM
+set_cdr_x (SCM x, SCM e)
+{
+  if (TYPE (x) != TPAIR) error (cell_symbol_not_a_pair, cons (x, cell_set_cdr_x));
+  CDR (x) = e;
+  return cell_unspecified;
+}
+
+SCM
+set_env_x (SCM x, SCM e, SCM a)
+{
+  SCM p = assert_defined (x, assq (x, a));
+  if (TYPE (p) != TPAIR) error (cell_symbol_not_a_pair, cons (p, x));
+  return set_cdr_x (p, e);
+}
+
+SCM
+call_lambda (SCM e, SCM x, SCM aa, SCM a) ///((internal))
+{
+  SCM cl = cons (cons (cell_closure, x), x);
+  r1 = e;
+  r0 = cl;
+  return cell_unspecified;
+}
+
+SCM
+make_closure_ (SCM args, SCM body, SCM a) ///((internal))
+{
+  return make_cell_ (tmp_num_ (TCLOSURE), cell_f, cons (cons (cell_circular, a), cons (args, body)));
+}
+
+SCM
+lookup_macro_ (SCM x, SCM a) ///((internal))
+{
+  if (TYPE (x) != TSYMBOL) return cell_f;
+  SCM m = assq_ref_env (x, a);
+  if (TYPE (m) == TMACRO) return MACRO (m);
+  return cell_f;
+}
+
+SCM
+push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
+{
+  SCM x = r3;
+  r3 = c;
+  r2 = p2;
+  gc_push_frame ();
+  r1 = p1;
+  r0 = a;
+  r3 = x;
+  return cell_unspecified;
+}
+
+SCM
+gc_peek_frame () ///((internal))
+{
+  SCM frame = CAR (g_stack);
+  r1 = CAR (frame);
+  r2 = CADR (frame);
+  r3 = CAR (CDDR (frame));
+  r0 = CADR (CDDR (frame));
+  return frame;
+}
+
+SCM
+gc_pop_frame () ///((internal))
+{
+  SCM frame = gc_peek_frame (g_stack);
+  g_stack = CDR (g_stack);
+  return frame;
+}
+
+SCM
+eval_apply ()
+{
+#if 0
+ eval_apply:
+  gc_check ();
+  switch (r3)
+    {
+    case cell_vm_evlis: goto evlis;
+    case cell_vm_evlis2: goto evlis2;
+    case cell_vm_evlis3: goto evlis3;
+    case cell_vm_apply: goto apply;
+    case cell_vm_apply2: goto apply2;
+    case cell_vm_eval: goto eval;
+#if MES_FIXED_PRIMITIVES
+    case cell_vm_eval_car: goto eval_car;
+    case cell_vm_eval_cdr: goto eval_cdr;
+    case cell_vm_eval_cons: goto eval_cons;
+    case cell_vm_eval_null_p: goto eval_null_p;
+#endif
+    case cell_vm_eval_set_x: goto eval_set_x;
+    case cell_vm_eval_macro: goto eval_macro;
+    case cell_vm_eval_check_func: goto eval_check_func;
+    case cell_vm_eval2: goto eval2;
+    case cell_vm_macro_expand: goto macro_expand;
+    case cell_vm_begin: goto begin;
+    case cell_vm_begin_read_input_file: goto begin_read_input_file;
+    case cell_vm_begin2: goto begin2;
+    case cell_vm_if: goto vm_if;
+    case cell_vm_if_expr: goto if_expr;
+    case cell_vm_call_with_current_continuation2: goto call_with_current_continuation2;
+    case cell_vm_call_with_values2: goto call_with_values2;
+    case cell_vm_return: goto vm_return;
+    case cell_unspecified: return r1;
+    default:
+      assert (0);
+    }
+
+  SCM x = cell_nil;
+ evlis:
+  gc_check ();
+  if (r1 == cell_nil) goto vm_return;
+  if (TYPE (r1) != TPAIR) goto eval;
+  push_cc (CAR (r1), r1, r0, cell_vm_evlis2);
+  goto eval;
+ evlis2:
+  push_cc (CDR (r2), r1, r0, cell_vm_evlis3);
+  goto evlis;
+ evlis3:
+  r1 = cons (r2, r1);
+  goto vm_return;
+
+ apply:
+  gc_check ();
+  switch (TYPE (CAR (r1)))
+    {
+    case TFUNCTION: {
+      check_formals (CAR (r1), MAKE_NUMBER (FUNCTION (CAR (r1)).arity), CDR (r1));
+      r1 = call (CAR (r1), CDR (r1)); /// FIXME: move into eval_apply
+      goto vm_return;
+    }
+    case TCLOSURE:
+      {
+        SCM cl = CLOSURE (CAR (r1));
+        SCM formals = CADR (cl);
+        SCM body = CDDR (cl);
+        SCM aa = CDAR (cl);
+        aa = CDR (aa);
+        check_formals (CAR (r1), formals, CDR (r1));
+        SCM p = pairlis (formals, CDR (r1), aa);
+        call_lambda (body, p, aa, r0);
+        goto begin;
+      }
+      case TCONTINUATION:
+        {
+          x = r1;
+          g_stack = CONTINUATION (CAR (r1));
+          gc_pop_frame ();
+          r1 = CADR (x);
+          goto eval_apply;
+        }
+    case TSPECIAL:
+      {
+        switch (CAR (r1))
+          {
+          case cell_vm_apply:
+            {
+              push_cc (cons (CADR (r1), CADDR (r1)), r1, r0, cell_vm_return);
+              goto apply;
+            }
+          case cell_vm_eval:
+            {
+              push_cc (CADR (r1), r1, CADDR (r1), cell_vm_return);
+              goto eval;
+            }
+          case cell_call_with_current_continuation:
+            {
+              r1 = CDR (r1);
+              goto call_with_current_continuation;
+            }
+          default: check_apply (cell_f, CAR (r1));
+          }
+      }
+    case TSYMBOL:
+      {
+        if (CAR (r1) == cell_symbol_call_with_values)
+          {
+            r1 = CDR (r1);
+            goto call_with_values;
+          }
+        if (CAR (r1) == cell_symbol_current_module)
+          {
+            r1 = r0;
+            goto vm_return;
+          }
+        break;
+      }
+    case TPAIR:
+      {
+        switch (CAAR (r1))
+          {
+          case cell_symbol_lambda:
+            {
+              SCM formals = CADR (CAR (r1));
+              SCM body = CDDR (CAR (r1));
+              SCM p = pairlis (formals, CDR (r1), r0);
+              check_formals (r1, formals, CDR (r1));
+              call_lambda (body, p, p, r0);
+              goto begin;
+            }
+          }
+      }
+    }
+  push_cc (CAR (r1), r1, r0, cell_vm_apply2);
+  goto eval;
+ apply2:
+  check_apply (r1, CAR (r2));
+  r1 = cons (r1, CDR (r2));
+  goto apply;
+
+ eval:
+  gc_check ();
+  switch (TYPE (r1))
+    {
+    case TPAIR:
+      {
+        switch (CAR (r1))
+          {
+#if MES_FIXED_PRIMITIVES
+          case cell_symbol_car:
+            {
+              push_cc (CADR (r1), r1, r0, cell_vm_eval_car); goto eval;
+            eval_car:
+              x = r1; gc_pop_frame (); r1 = CAR (x); goto eval_apply;
+            }
+          case cell_symbol_cdr:
+            {
+              push_cc (CADR (r1), r1, r0, cell_vm_eval_cdr); goto eval;
+            eval_cdr:
+              x = r1; gc_pop_frame (); r1 = CDR (x); goto eval_apply;
+            }
+          case cell_symbol_cons: {
+            push_cc (CDR (r1), r1, r0, cell_vm_eval_cons); goto evlis;
+            eval_cons:
+            x = r1;
+            gc_pop_frame ();
+            r1 = cons (CAR (x), CADR (x));
+            goto eval_apply;
+          }
+          case cell_symbol_null_p:
+            {
+              push_cc (CADR (r1), r1, r0, cell_vm_eval_null_p);
+              goto eval;
+            eval_null_p:
+              x = r1; gc_pop_frame (); r1 = null_p (x); goto eval_apply;
+            }
+#endif // MES_FIXED_PRIMITIVES
+          case cell_symbol_quote:
+            {
+              x = r1; gc_pop_frame (); r1 = CADR (x); goto eval_apply;
+            }
+          case cell_symbol_begin: goto begin;
+          case cell_symbol_lambda:
+            {
+              r1 = make_closure_ (CADR (r1), CDDR (r1), assq (cell_closure, r0));
+              goto vm_return;
+            }
+          case cell_symbol_if: {r1=CDR (r1); goto vm_if;}
+          case cell_symbol_set_x:
+            {
+              push_cc (CAR (CDDR (r1)), r1, r0, cell_vm_eval_set_x);
+              goto eval;
+            eval_set_x:
+              x = r2;
+              r1 = set_env_x (CADR (x), r1, r0);
+              goto vm_return;
+            }
+          case cell_vm_macro_expand:
+            {
+              push_cc (CADR (r1), r1, r0, cell_vm_return);
+              goto macro_expand;
+            }
+          default: {
+            push_cc (r1, r1, r0, cell_vm_eval_macro);
+            goto macro_expand;
+            eval_macro:
+            if (r1 != r2)
+              {
+                if (TYPE (r1) == TPAIR)
+                  {
+                    set_cdr_x (r2, CDR (r1));
+                    set_car_x (r2, CAR (r1));
+                  }
+                goto eval;
+              }
+            push_cc (CAR (r1), r1, r0, cell_vm_eval_check_func); goto eval;
+            eval_check_func:
+            push_cc (CDR (r2), r2, r0, cell_vm_eval2); goto evlis;
+            eval2:
+            r1 = cons (CAR (r2), r1);
+            goto apply;
+          }
+          }
+      }
+    case TSYMBOL:
+      {
+        r1 = assert_defined (r1, assq_ref_env (r1, r0));
+        goto vm_return;
+      }
+    default: goto vm_return;
+    }
+
+  SCM macro;
+  SCM expanders;
+ macro_expand:
+  if (TYPE (r1) == TPAIR
+      && (macro = lookup_macro_ (CAR (r1), r0)) != cell_f)
+    {
+      r1 = cons (macro, CDR (r1));
+      goto apply;
+    }
+  else if (TYPE (r1) == TPAIR
+           && TYPE (CAR (r1)) == TSYMBOL
+           && ((expanders = assq_ref_env (cell_symbol_sc_expander_alist, r0)) != cell_undefined)
+           && ((macro = assq (CAR (r1), expanders)) != cell_f))
+    {
+      SCM sc_expand = assq_ref_env (cell_symbol_macro_expand, r0);
+      if (sc_expand != cell_undefined && sc_expand != cell_f)
+        {
+          r1 = cons (sc_expand, cons (r1, cell_nil));
+          goto apply;
+        }
+    }
+  goto vm_return;
+
+ begin:
+  x = cell_unspecified;
+  while (r1 != cell_nil) {
+    gc_check ();
+    if (TYPE (r1) == TPAIR && TYPE (CAR (r1)) == TPAIR)
+      {
+        if (CAAR (r1) == cell_symbol_begin)
+          r1 = append2 (CDAR (r1), CDR (r1));
+        else if (CAAR (r1) == cell_symbol_primitive_load)
+          {
+            push_cc (cons (cell_symbol_read_input_file, cell_nil), r1, r0, cell_vm_begin_read_input_file);
+            goto apply;
+          begin_read_input_file:
+            r1 = append2 (r1, CDR (r2));
+          }
+      }
+    if (CDR (r1) == cell_nil)
+      {
+        r1 = CAR (r1);
+        goto eval;
+      }
+    push_cc (CAR (r1), r1, r0, cell_vm_begin2);
+    goto eval;
+  begin2:
+    x = r1;
+    r1 = CDR (r2);
+  }
+  r1 = x;
+  goto vm_return;
+
+ vm_if:
+  push_cc (CAR (r1), r1, r0, cell_vm_if_expr);
+  goto eval;
+ if_expr:
+  x = r1;
+  r1 = r2;
+  if (x != cell_f)
+    {
+      r1 = CADR (r1);
+      goto eval;
+    }
+  if (CDDR (r1) != cell_nil)
+    {
+      r1 = CAR (CDDR (r1));
+      goto eval;
+    }
+  r1 = cell_unspecified;
+  goto vm_return;
+
+ call_with_current_continuation:
+  gc_push_frame ();
+  x = MAKE_CONTINUATION (g_continuations++);
+  gc_pop_frame ();
+  push_cc (cons (CAR (r1), cons (x, cell_nil)), x, r0, cell_vm_call_with_current_continuation2);
+  goto apply;
+ call_with_current_continuation2:
+  CONTINUATION (r2) = g_stack;
+  goto vm_return;
+
+ call_with_values:
+  push_cc (cons (CAR (r1), cell_nil), r1, r0, cell_vm_call_with_values2);
+  goto apply;
+ call_with_values2:
+  if (TYPE (r1) == TVALUES)
+    r1 = CDR (r1);
+  r1 = cons (CADR (r2), r1);
+  goto apply;
+
+ vm_return:
+  x = r1;
+  gc_pop_frame ();
+  r1 = x;
+  goto eval_apply;
+#endif
+}
+
+SCM
+apply (SCM f, SCM x, SCM a) ///((internal))
+{
+  push_cc (cons (f, x), cell_unspecified, r0, cell_unspecified);
+  r3 = cell_vm_apply;
+  return eval_apply ();
+}
+
+SCM
+mes_g_stack (SCM a) ///((internal))
+{
+  r0 = a;
+  r1 = MAKE_CHAR (0);
+  r2 = MAKE_CHAR (0);
+  r3 = MAKE_CHAR (0);
+  g_stack = cons (cell_nil, cell_nil);
+  return r0;
+}
+
+//\f Environment setup
+
+SCM
+make_tmps (struct scm* cells)
+{
+  tmp = g_free++;
+  cells[tmp].type = TCHAR;
+  tmp_num = g_free++;
+  cells[tmp_num].type = TNUMBER;
+  tmp_num2 = g_free++;
+  cells[tmp_num2].type = TNUMBER;
+  return 0;
+}
+
+#include "posix.c"
+#include "math.c"
+#include "lib.c"
+
+//\f Jam Collector
+SCM g_symbol_max;
+
+SCM
+gc_init_cells () ///((internal))
+{
+  int size = ARENA_SIZE * 12;
+  size = size * 2;
+#if __GNUC__
+  g_arena = (char*)malloc (size);
+#else
+  char *p = 0;
+  p = malloc (size);
+  g_arena = p;
+#endif
+  g_cells = g_arena;
+  return 0;
+  //g_cells = (scm *)malloc (2*ARENA_SIZE*sizeof(scm));
+
+  TYPE (0) = TVECTOR;
+  LENGTH (0) = 1000;
+  VECTOR (0) = 0;
+  g_cells++;
+  TYPE (0) = TCHAR;
+  VALUE (0) = 'c';
+  return 0;
+}
+
+SCM
+gc_init_news () ///((internal))
+{
+  eputs ("gc_init_news\n");
+  ///g_news = g_cells-1 + ARENA_SIZE;
+  //g_news = g_cells + ARENA_SIZE * 12 + GC_SAFETY * 6;
+  char *p = g_cells;
+  // g_news = g_cells;
+  int halfway = ARENA_SIZE * 12;
+  int safety = GC_SAFETY * 12;
+  safety = safety / 2;
+  halfway = halfway + safety;
+  // g_news = g_news + halfway;
+  p = p + halfway;
+  g_news = p;
+  eputs ("g_cells=");
+  eputs (itoa (g_cells));
+  eputs (" size=");
+  eputs (itoa (halfway));
+  eputs (" news=");
+  eputs (itoa (g_news));
+  eputs (" news - cells=");
+  char * c = g_cells;
+  eputs (itoa (p - c));
+  eputs ("\n");
+
+
+  NTYPE (0) = TVECTOR;
+  NLENGTH (0) = 1000;
+  NVECTOR (0) = 0;
+  g_news++;
+  NTYPE (0) = TCHAR;
+  NVALUE (0) = 'n';
+  return 0;
+}
+
+SCM
+mes_symbols () ///((internal))
+{
+  gc_init_cells ();
+  gc_init_news ();
+
+#include "mes.mes.symbols.i"
+
+  g_symbol_max = g_free;
+  make_tmps (g_cells);
+
+  g_symbols = 0;
+  for (int i=1; i<g_symbol_max; i++)
+    g_symbols = cons (i, g_symbols);
+
+  SCM a = cell_nil;
+
+#include "mes.mes.symbol-names.i"
+
+  a = acons (cell_symbol_mes_version, MAKE_STRING (cstring_to_list (VERSION)), a);
+  a = acons (cell_symbol_mes_prefix, MAKE_STRING (cstring_to_list (PREFIX)), a);
+
+  a = acons (cell_symbol_dot, cell_dot, a);
+  a = acons (cell_symbol_begin, cell_begin, a);
+  a = acons (cell_symbol_call_with_values, cell_symbol_call_with_values, a);
+  a = acons (cell_symbol_current_module, cell_symbol_current_module, a);
+  a = acons (cell_symbol_call_with_current_continuation, cell_call_with_current_continuation, a);
+  a = acons (cell_symbol_sc_expand, cell_f, a);
+
+#if __GNUC__
+  a = acons (cell_symbol_gnuc, cell_t, a);
+  a = acons (cell_symbol_mesc, cell_f, a);
+#else
+  a = acons (cell_symbol_gnuc, cell_f, a);
+  a = acons (cell_symbol_mesc, cell_t, a);
+#endif
+
+  a = acons (cell_closure, a, a);
+
+  return a;
+}
+
+SCM
+mes_environment () ///((internal))
+{
+  SCM a = mes_symbols ();
+  return mes_g_stack (a);
+}
+
+SCM
+mes_builtins (SCM a) ///((internal))
+{
+#include "mes.mes.i"
+
+// Do not sort: Order of these includes define builtins
+#include "posix.mes.i"
+#include "math.mes.i"
+#include "lib.mes.i"
+#include "vector.mes.i"
+#include "gc.mes.i"
+// #include "reader.mes.i"
+
+#include "gc.mes.environment.i"
+#include "lib.mes.environment.i"
+#include "math.mes.environment.i"
+#include "mes.mes.environment.i"
+#include "posix.mes.environment.i"
+// #include "reader.mes.environment.i"
+#include "vector.mes.environment.i"
+
+  return a;
+}
+
+SCM
+bload_env (SCM a) ///((internal))
+{
+  char *mo = "module/mes/read-0-32.mo";
+  g_stdin = open (mo, 0);
+  if (g_stdin < 0) {eputs ("no such file: ");eputs (mo);eputs ("\n");return 1;} 
+  assert (getchar () == 'M');
+  assert (getchar () == 'E');
+  assert (getchar () == 'S');
+  eputs ("*GOT MES*\n");
+  g_stack = getchar () << 8;
+  g_stack += getchar ();
+
+  char *p = (char*)g_cells;
+  int c = getchar ();
+  while (c != EOF)
+    {
+      *p++ = c;
+      c = getchar ();
+    }
+  g_free = (p-(char*)g_cells) /
+  gc_peek_frame ();
+  g_symbols = r1;
+  g_stdin = STDIN;
+  r0 = mes_builtins (r0);
+
+#if __GNUC__
+  set_env_x (cell_symbol_gnuc, cell_t, r0);
+  set_env_x (cell_symbol_mesc, cell_f, r0);
+#else
+  set_env_x (cell_symbol_gnuc, cell_f, r0);
+  set_env_x (cell_symbol_mesc, cell_t, r0);
+#endif
+
+  if (g_debug)
+    {
+      eputs ("symbols: ");
+      SCM s = g_symbols;
+      while (s && s != cell_nil) {
+        display_error_ (CAR (s));
+        eputs (" ");
+        s = CDR (s);
+      }
+      eputs ("\n");
+      eputs ("functions: ");
+      eputs (itoa (g_function));
+      eputs ("\n");
+      for (int i = 0; i < g_function; i++)
+        {
+          eputs ("[");
+          eputs (itoa (i));
+          eputs ("]: ");
+          eputs (g_functions[i].name);
+          eputs ("\n");
+        }
+      //display_error_ (r0);
+      //puts ("\n");
+    }
+  return r2;
+}
+
+#include "vector.c"
+#include "gc.c"
+
+int
+main (int argc, char *argv[])
+{
+  char *p;
+  if (p = getenv ("MES_DEBUG")) g_debug = atoi (p);
+  if (g_debug) {eputs (";;; MODULEDIR=");eputs (MODULEDIR);eputs ("\n");}
+  if (p = getenv ("MES_MAX_ARENA")) MAX_ARENA_SIZE = atoi (p);
+  if (p = getenv ("MES_ARENA")) ARENA_SIZE = 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_stdout = STDOUT;
+  r0 = mes_environment ();
+
+  SCM program = bload_env (r0);
+  SCM lst = cell_nil;
+  for (int i=argc-1; i>=0; i--) lst = cons (MAKE_STRING (cstring_to_list (argv[i])), lst);
+  r0 = acons (cell_symbol_argv, lst, r0);
+  push_cc (r2, cell_unspecified, r0, cell_unspecified);
+  if (g_debug)
+    {
+      eputs ("program: ");
+      display_error_ (r1);
+      eputs ("\n");
+    }
+  r3 = cell_vm_begin;
+  r1 = eval_apply ();
+  display_error_ (r1);
+  eputs ("\n");
+  gc (g_stack);
+  if (g_debug)
+    {
+      eputs ("\nstats: [");
+      eputs (itoa (g_free));
+      eputs ("]\n");
+    }
+  return 0;
+}
diff --git a/scaffold/t-0.mes b/scaffold/t-0.mes
deleted file mode 100644 (file)
index 075757f..0000000
+++ /dev/null
@@ -1,2 +0,0 @@
-;;; -*-scheme-*-
-(core:display "t00\n")
diff --git a/scaffold/tiny-mes.c b/scaffold/tiny-mes.c
new file mode 100644 (file)
index 0000000..c48b7ae
--- /dev/null
@@ -0,0 +1,341 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2018 Jan 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/>.
+ */
+
+#if POSIX
+#error "POSIX not supported"
+#endif
+
+#include <stdio.h>
+#include <mlibc.h>
+
+char arena[300];
+
+typedef int SCM;
+
+SCM g_stack = 0;
+SCM r0 = 0; // a/env
+SCM r1 = 0; // param 1
+SCM r2 = 0; // save 2+load/dump
+SCM r3 = 0; // continuation
+
+enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVECTOR, TBROKEN_HEART};
+
+struct scm {
+  enum type_t type;
+  SCM car;
+  SCM cdr;
+};
+
+#if __MESC__
+struct scm *g_cells = arena;
+#else
+struct scm *g_cells = (struct scm*)arena;
+#endif
+
+#define cell_nil 1
+#define cell_f 2
+#define cell_t 3
+
+#define TYPE(x) (g_cells[x].type)
+
+#define CAR(x) g_cells[x].car
+
+#define CDR(x) g_cells[x].cdr
+#define VALUE(x) g_cells[x].cdr
+
+SCM
+car (SCM x)
+{
+  return CAR (x);
+}
+
+SCM
+cdr (SCM x)
+{
+  return CDR (x);
+}
+
+SCM caar (SCM x) {return car (car (x));}
+SCM cadr (SCM x) {return car (cdr (x));}
+SCM cdar (SCM x) {return cdr (car (x));}
+SCM cddr (SCM x) {return cdr (cdr (x));}
+
+SCM
+gc_peek_frame ()
+{
+  SCM frame = car (g_stack);
+  r1 = car (frame);
+  r2 = cadr (frame);
+  r3 = car (cddr (frame));
+  r0 = cadr (cddr (frame));
+  return frame;
+}
+
+//\f Environment setup
+
+SCM
+mes_environment ()
+{
+  return 0;
+}
+
+SCM
+mes_builtins (SCM a)
+{
+  return a;
+}
+
+SCM
+fill ()
+{
+  TYPE (0) = 0x6c6c6168;
+  CAR (0) = 0x6a746f6f;
+  CDR (0) = 0x00002165;
+
+  TYPE (1) = TSYMBOL;
+  CAR (1) = 0x2d2d2d2d;
+  CDR (1) = 0x3e3e3e3e;
+
+  TYPE (9) = 0x2d2d2d2d;
+  CAR (9) = 0x2d2d2d2d;
+  CDR (9) = 0x3e3e3e3e;
+
+  // (A(B))
+  TYPE (10) = TPAIR;
+  CAR (10) = 11;
+  CDR (10) = 12;
+
+  TYPE (11) = TCHAR;
+  CAR (11) = 0x58585858;
+  CDR (11) = 89;
+
+  TYPE (12) = TPAIR;
+  CAR (12) = 13;
+  CDR (12) = 1;
+
+  TYPE (13) = TCHAR;
+  CAR (11) = 0x58585858;
+  CDR (13) = 90;
+
+  TYPE (14) = 0x58585858;
+  CAR (14) = 0x58585858;
+  CDR (14) = 0x58585858;
+
+  TYPE (14) = 0x58585858;
+  CAR (14) = 0x58585858;
+  CDR (14) = 0x58585858;
+
+  TYPE (16) = 0x3c3c3c3c;
+  CAR (16) = 0x2d2d2d2d;
+  CDR (16) = 0x2d2d2d2d;
+  return 0;
+}
+
+SCM
+display_ (SCM x)
+{
+  //puts ("<display>\n");
+  switch (TYPE (x))
+    {
+    case TCHAR:
+      {
+        //puts ("<char>\n");
+        puts ("#\\");
+        putchar (VALUE (x));
+        break;
+      }
+    case TFUNCTION:
+      {
+        //puts ("<function>\n");
+        if (VALUE (x) == 0)
+          puts ("core:make-cell");
+        if (VALUE (x) == 1)
+          puts ("cons");
+        if (VALUE (x) == 2)
+          puts ("car");
+        if (VALUE (x) == 3)
+          puts ("cdr");
+        break;
+      }
+    case TNUMBER:
+      {
+        //puts ("<number>\n");
+#if __GNUC__
+        puts (itoa (VALUE (x)));
+#else
+        int i;
+        i = VALUE (x);
+        i = i + 48;
+        putchar (i);
+#endif
+        break;
+      }
+    case TPAIR:
+      {
+        //puts ("<pair>\n");
+        //if (cont != cell_f) puts "(");
+        puts ("(");
+        if (x && x != cell_nil) display_ (CAR (x));
+        if (CDR (x) && CDR (x) != cell_nil)
+          {
+#if __GNUC__
+            if (TYPE (CDR (x)) != TPAIR)
+              puts (" . ");
+#else
+            int c;
+            c = CDR (x);
+            c = TYPE (c);
+            if (c != TPAIR)
+              puts (" . ");
+#endif
+            display_ (CDR (x));
+          }
+        //if (cont != cell_f) puts (")");
+        puts (")");
+        break;
+      }
+    case TSPECIAL:
+      {
+        switch (x)
+          {
+          case 1: {puts ("()"); break;}
+          case 2: {puts ("#f"); break;}
+          case 3: {puts ("#t"); break;}
+          default:
+            {
+#if __GNUC__
+        puts ("<x:");
+        puts (itoa (x));
+        puts (">");
+#else
+        puts ("<x>");
+#endif
+            }
+          }
+        break;
+      }
+    case TSYMBOL:
+      {
+        switch (x)
+          {
+          case 11: {puts (" . "); break;}
+          case 12: {puts ("lambda"); break;}
+          case 13: {puts ("begin"); break;}
+          case 14: {puts ("if"); break;}
+          case 15: {puts ("quote"); break;}
+          case 37: {puts ("car"); break;}
+          case 38: {puts ("cdr"); break;}
+          case 39: {puts ("null?"); break;}
+          case 40: {puts ("eq?"); break;}
+          case 41: {puts ("cons"); break;}
+          default:
+            {
+#if __GNUC__
+        puts ("<s:");
+        puts (itoa (x));
+        puts (">");
+#else
+        puts ("<s>");
+#endif
+            }
+          }
+        break;
+      }
+    default:
+      {
+        //puts ("<default>\n");
+#if __GNUC__
+        puts ("<");
+        puts (itoa (TYPE (x)));
+        puts (":");
+        puts (itoa (x));
+        puts (">");
+#else
+        puts ("_");
+#endif
+        break;
+      }
+    }
+  return 0;
+}
+
+SCM
+bload_env (SCM a) ///((internal))
+{
+  puts ("reading: ");
+  char *mo = "module/mes/tiny-0-32.mo";
+  puts (mo);
+  puts ("\n");
+  g_stdin = open (mo, 0);
+  if (g_stdin < 0) {eputs ("no such file: module/mes/tiny-0-32.mo\n");return 1;}
+
+  // BOOM
+  //char *p = arena;
+  char *p = (char*)g_cells;
+  int c;
+
+  c = getchar ();
+  putchar (c);
+  if (c != 'M') exit (10);
+  c = getchar ();
+  putchar (c);
+  if (c != 'E') exit (11);
+  c = getchar ();
+  putchar (c);
+  if (c != 'S') exit (12);
+  puts (" *GOT MES*\n");
+
+  // skip stack
+  getchar ();
+  getchar ();
+
+  int i = 0;
+  c = getchar ();
+  while (c != -1)
+    {
+      i++;
+      eputs (itoa (i));
+      eputs (": ");
+      eputs (itoa (c));
+      eputs ("\n");
+      *p++ = c;
+      c = getchar ();
+    }
+
+  puts ("read done\n");
+  display_ (10);
+
+  puts ("\n");
+  return r2;
+}
+
+int
+main (int argc, char *argv[])
+{
+  fill ();
+  char *p = arena;
+  puts (p);
+  puts ("\n");
+  display_ (10);
+  puts ("\n");
+  SCM program = bload_env (r0);
+
+  return 0;
+}
index 3ac1e1305288d8a9cbcbfbb8609345e26157767c..ebc524d2c3f11496120b2d6375a85e6706369b58 100755 (executable)
@@ -31,69 +31,63 @@ exit $?
 (pass-if "first dummy" #t)
 (pass-if-not "second dummy" #f)
 
-
-(pass-if "begin" (seq? (begin 'a 'b (+ 1 2)) 3))
 (pass-if "lambda" (symbol? 'lambda))
 
-(define *top-define-a* '*top-define-a*)
-(pass-if "top define " (seq? *top-define-a* '*top-define-a*))
-
-(begin (define *top-begin-define-a* '*top-begin-define-a*))
-(pass-if "top begin define " (seq? *top-begin-define-a* '*top-begin-define-a*))
-(pass-if "if" (seq? (if #t 'true) 'true))
-(pass-if "if 2" (seq? (if #f #f) *unspecified*))
-(pass-if "if 3" (seq? (if (seq? 0 '0) 'true 'false) 'true))
-(pass-if "if 4" (seq? (if (= 1 2) 'true 'false) 'false))
-
-(pass-if-equal "append" '(0 1) (append '(0) '(1)))
-(pass-if-equal "append 1" '0 (append '() 0))
-(pass-if-equal "append 2" '(0) (append '(0) '()))
-(pass-if-equal "append 3" 0 (append 0))
-(pass-if-equal "append 4" 'cons (append (cdr '(c)) (car '(cons))))
-(pass-if-equal "append 5" '(0 1 2) (append '(0) '(1) '(2)))
-
-;;(pass-if ">=" (seq? (>= 3 2 1) #t))
-
-(if (defined? 'cond)
-    (begin
-      (pass-if "cond" (seq? (cond (#f #f) (#t #t)) #t))
-      (pass-if "cond" (seq? (cond (#t)) #t))
-      (pass-if "cond 2" (seq? (cond (#f)) *unspecified*))
-      (pass-if "cond 3" (seq? (cond (#t 0)) 0))
-      (pass-if "cond 3" (seq? (cond (#f 1) (#t 0)) 0))
-      (pass-if-equal "cond side effect"
-                     1
-                     (let ((i 0))
-                       (cond ((set! i (1+ i)) i))))
-      (pass-if-equal "cond => "
-          0 (let ((lst '(0 1 2)))
-              (define (next)
-                (let ((r (car lst)))
-                  (set! lst (cdr lst))
-                  r))
-              (cond ((next) => identity))))))
-
-(pass-if "and" (seq? (and 1) 1))
-(pass-if "and 2" (seq? (and 1 (= 0 1) #f) #f))
-(pass-if "or" (seq? (or) #f))
-(pass-if "or 2" (seq? (or 1) 1))
-(pass-if "or 3" (seq? (or #f (= 0 1) 3) 3))
-(pass-if "or 4" (seq? (or (= 0 0) (= 0 1)) #t))
-(pass-if "or 5" (seq? (or (= 0 1) (= 0 0)) #t))
-(pass-if-equal "or only once"
+(cond-expand
+ (guile (define append2 append))
+ (mes))
+
+(pass-if-equal "append" '(0 1) (append2 '(0) '(1)))
+(pass-if-equal "append 2" '(0) (append2 '(0) '()))
+(pass-if-equal "append 3" '(0 1 2) (append '(0) '(1) '(2)))
+
+(pass-if-equal "cond #f" #t (cond (#f #f) (#t #t)))
+(pass-if "cond #t" (cond (#t)))
+(pass-if "cond #f" (cond (#f #f) (#t #t)))
+(pass-if-equal "cond 2" *unspecified* (cond (#f)))
+(pass-if-equal "cond 3" 0 (cond (#t 0)))
+(pass-if-equal "cond 3a" 0 (cond (#f 1) (#t 0)))
+(pass-if-equal "cond side effect"
                1
-               (let ()
-                 (define read
-                   (let ((lst '(1 0)))
-                     (lambda ()
-                       (let ((r (car lst)))
+               ((lambda (i)
+                  (cond ((set! i (+ i 1)) i)))
+                0))
+(pass-if-equal "cond => "
+               0 ((lambda (lst)
+                    (define (next)
+                      ((lambda (r)
                          (set! lst (cdr lst))
-                         r))))
-                 (or (read) #t)))
-
-(pass-if "let" (seq? (let () 0) 0))
-(pass-if "let 2" (seq? (let ((x 0)) x) 0))
-(pass-if "let 3" (seq? (let ((p 5) (q 6)) (+ p q)) 11))
+                         r)
+                       (car lst)))
+                    (cond ((next) => identity)))
+                  '(0 1 2)))
+
+(pass-if-equal "and" 1 (and 1))
+(pass-if-not "and 2" (and 1 (= 0 1) #f))
+(pass-if-not "or" (or))
+(pass-if-equal "or 2" 1 (or 1))
+(pass-if-equal "or 3" 3 (or #f (= 0 1) 3))
+(pass-if "or 4" (or (= 0 0) (= 0 1)))
+(pass-if "or 5" (or (= 0 1) (= 0 0)))
+(pass-if-equal "or only once"
+               1
+               ((lambda ()
+                  (define read
+                    ((lambda (lst)
+                       (lambda ()
+                         ((lambda (r)
+                            (set! lst (cdr lst))
+                            r)
+                          (car lst))))
+                     '(1 0)))
+                  (or (read) #t))))
+
+(pass-if-eq "let" 0 (let () 0))
+(pass-if-eq "let 2" 0 (let ((x 0)) x))
+(pass-if-eq "let 3" 11 (let ((p 5) (q 6)) (+ p q)))
+
+(let () (define *top-let-define-a* '*top-let-define-a*) #t)
+(pass-if-not "top let define " (defined? '*top-let-define-a*))
 
 (pass-if "apply" (sequal? (apply list '(1)) '(1)))
 (pass-if "apply 2" (sequal? (apply list 1 '(2)) '(1 2)))
@@ -102,17 +96,21 @@ exit $?
   (define local-answer 41))
 (pass-if-equal "begin 2" 41 (begin local-answer))
 
-(if (not guile?)
-  (pass-if-equal "load" 42 (begin (load "tests/data/load.scm") the-answer)))
+(pass-if-equal "primitive-load" 42 (primitive-load "tests/data/load.scm") the-answer)
+
+(cond-expand
+ (guile)
+ (mes
+  (pass-if-equal "include" 42 (include "tests/data/load.scm") the-answer)))
 
-(pass-if-equal "call/cc"
+(pass-if-eq "call/cc"
     0
-  (let ((cont #f)
-        (seen? #f))
-    (+ 1 (call/cc (lambda (c) (set! cont c) 1)))
-    (if seen? 0
-        (begin (set! seen? #t)
-               (cont 2)))))
+    ((lambda (cont seen?)
+       (+ 1 (call/cc (lambda (c) (set! cont c) 1)))
+       (if seen? 0
+           (begin (set! seen? #t)
+                  (cont 2))))
+     #f #f))
 
 (if (not guile?)
     (pass-if-not "#<eof>"
diff --git a/tests/boot.test b/tests/boot.test
new file mode 100755 (executable)
index 0000000..5ed77e0
--- /dev/null
@@ -0,0 +1,54 @@
+#! /bin/sh
+# -*-scheme-*-
+MES=${MES-$(dirname $0)/../scripts/mes}
+echo ' ()' | cat $0 /dev/stdin | $MES $MES_FLAGS "$@"
+#paredit:||
+exit $?
+!#
+
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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/>.
+
+(begin
+  (primitive-load "module/mes/test.mes"))
+;;(mes-use-module (mes test))
+
+(pass-if "first dummy" #t)
+(pass-if-not "second dummy" #f)
+
+(pass-if-eq "begin" 3 (begin 'a 'b (+ 1 2)))
+
+(define *top-define-a* '*top-define-a*)
+(begin (define *top-begin-define-a* '*top-begin-define-a*))
+(pass-if-eq "top define " '*top-define-a* *top-define-a*)
+
+(pass-if "eq?" (eq? 0 '0))
+
+(pass-if-eq "if" 'true (if #t 'true))
+(pass-if-eq "if 2" *unspecified* (if #f #f))
+(pass-if-eq "if 3" 'true (if #t 'true))
+(pass-if-eq "if 4" 'true (if (eq? 0 '0) 'true))
+(pass-if-eq "if 5" 'false (if (= 1 2) 'true 'false))
+
+(pass-if-eq "append2 1" '0 (append2 '() 0))
+(pass-if-eq "append2 3" 0 (append 0))
+(pass-if-eq "append2 4" 'cons (append2 (cdr '(c)) (car '(cons))))
+
+(result 'report)
diff --git a/tests/boot.test-guile b/tests/boot.test-guile
new file mode 120000 (symlink)
index 0000000..5631f4a
--- /dev/null
@@ -0,0 +1 @@
+base.test-guile
\ No newline at end of file
index 96ab4b5043cf4429bdc98f0eb156268161c9ce10..b466fe66ea01d6bace85c5e88b3a773717fd16ce 100755 (executable)
@@ -9,7 +9,7 @@ exit $?
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -34,7 +34,8 @@ exit $?
 (define b 0)
 (define x (lambda () b))
 (define (x) b)
-(pass-if "closure" (seq? (x) 0))
+(pass-if-equal "closure" 0 (x))
+(display "===>") (display (x)) (newline)
 (define (c b)
   (x))
 (pass-if "closure 2" (seq? (c 1) 0))
@@ -102,4 +103,17 @@ exit $?
 (pass-if-not "closure is not a pair"
              (pair? (lambda () #t)))
 
+(define shared
+  (let ((x 0))
+    (lambda () (set! x (+ 1 x)) x)))
+(define-macro (share)
+  (list 'begin
+        (list 'shared)))
+
+(pass-if-equal "shared variable macro access"
+    2
+  (begin
+    (share)
+    (shared)))
+
 (result 'report)
index 5f2fbeeb522c559c114d88a5f95ce50f272d23b3..3822bbebaa909b7b73ce51f6ae8348b3ed0e6fda 100755 (executable)
@@ -9,7 +9,7 @@ exit $?
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -34,11 +34,11 @@ exit $?
 
 (pass-if "let-syntax"
   (seq?
-   (let-syntax ((when (syntax-rules ()
-                        ((when condition exp ...)
+   (let-syntax ((xwhen (syntax-rules ()
+                        ((xwhen condition exp ...)
                          (if (not condition)
                              (begin exp ...))))))
-     (when #f 3))
+     (xwhen #f 3))
    3))
 
 (pass-if "let-syntax no-leak"
index 0ba62c757b2c6582bc968d40cec313ef7015a89f..c479818bb3789027881c50f63d767f0da86c30e1 100755 (executable)
@@ -9,7 +9,7 @@ exit $?
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -32,32 +32,35 @@ exit $?
 (pass-if "first dummy" #t)
 (pass-if-not "second dummy" #f)
 
-(let () (define *top-let-a* '*top-let-a*) #f)
-(pass-if "top let " (seq? (and (defined? '*top-let-a*) *top-let-a*) #f))
-
-(pass-if "let loop"
-  (sequal?
-   (let loop ((lst '(3 2 1)))
-     (cond ((null? lst) '())
-           (#t (cons (car lst) (loop (cdr lst))))))
-   '(3 2 1)))
-
-(pass-if "let* comments"
-  (seq? (let* ((aa 2)
-               (bb (+ aa 3))
-               #! boo !#
-               ;;(bb 4)
-               )
-          bb)
-        5))
-
-(pass-if "letrec"
-  (seq?
-   (letrec ((factorial (lambda (n)
-                         (cond ((= n 1) 1)
-                               (#t (* n (factorial (- n 1))))))))
-     (factorial 4))
-   24))
+(pass-if-equal "let " 1
+  (let ((x 1)) 1))
 
-(result 'report)
+(let () (define *let-define* '*let-define*) #f)
+(pass-if-equal "let define "
+    #f
+    (and (defined? '*let-define*) *let-define*))
+
+(begin (define *begin-define* '*begin-define*) #f)
+(pass-if-equal "begin define" '*begin-define*
+               (and (defined? '*begin-define*) *begin-define*))
+
+(pass-if-equal "let loop" '(3 2 1)
+  (let loop ((lst '(3 2 1)))
+    (cond ((null? lst) '())
+          (#t (cons (car lst) (loop (cdr lst)))))))
 
+(pass-if-equal "let* comments" 5
+  (let* ((aa 2)
+         (bb (+ aa 3))
+         #! boo !#
+         ;;(bb 4)
+         )
+    bb))
+
+(pass-if-equal "letrec" 24
+  (letrec ((factorial (lambda (n)
+                        (cond ((= n 1) 1)
+                              (#t (* n (factorial (- n 1))))))))
+    (factorial 4)))
+
+(result 'report)
index d1b7c8728bd7f5fced9a5c529d45c7d836c9ed4c..77ad589e8033c030bdd0cd47bac9d206db884288 100755 (executable)
@@ -9,7 +9,7 @@ exit $?
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -29,9 +29,10 @@ exit $?
 (mes-use-module (mes match))
 (mes-use-module (mes test))
 
-(when guile?
-  (use-modules (ice-9 match))
-  )
+(cond-expand
+ (guile
+  (use-modules (ice-9 match)))
+  (mes))
 
 (pass-if "first dummy" #t)
 (pass-if-not "second dummy" #f)
index ac02bc8f3a38a808a5ef639988cb74319fb14255..6b77696dc201a775bebb85699c490b91f3d80685 100755 (executable)
@@ -27,7 +27,6 @@ exit $?
 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
 (cond-expand
- (guile-2)
  (guile
   (use-modules (ice-9 optargs)))
  (mes
@@ -52,15 +51,12 @@ exit $?
 (pass-if-equal "keyword->symbol" 'foo (keyword->symbol #:foo))
 (pass-if-equal "symbol->keyword" #:foo (symbol->keyword 'foo))
 (pass-if-not "keywords" (eq? #:foo ':foo))
+
 (pass-if "optargs #:optional" ((lambda* (#:optional (x #f)) x) #t))
 (pass-if-equal "optargs #:optional default" #f ((lambda* (#:optional (x #f)) x)))
 (pass-if "optargs key" ((lambda* (#:key (foo #f)) foo) #:foo #t))
 (pass-if-equal "optargs key default" #f ((lambda* (#:key (foo #f)) foo)))
 
-(cond-expand
- (guile (use-modules (ice-9 optargs)))
- (mes))
-
 (define <info> '<info>)
 (define <functions> '<functions>)
 (define <globals> '<globals>)
index 3a549f020bc5cb4f345a26538715453369643626..1a87dc77cea5f37a9978dba8ad9b203d2b9f3326 100755 (executable)
@@ -9,7 +9,7 @@ exit $?
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -53,10 +53,19 @@ exit $?
 (pass-if-equal "qq 1" '(list a (quote a))
   (let ((name 'a))
     `(list ,name ',name)) )
+(define (>= . rest)
+  (or (apply > rest)
+      (apply = rest)))
+(define (abs x)
+  (if (>= x 0) x (- x)))
 (pass-if-equal "qq 2" '(a 3 4 5 6 b)
   `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b))
 (pass-if-equal "qq 3" '((foo 7) . cons)
   `((foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons))))
+(define (remainder x y)
+  (- x (* (quotient x y) y)))
+(define (even? x)
+  (= 0 (remainder x 2)))
 (pass-if-equal "qq 4" '#(10 5 #t #t #f #f #f 8)
   `#(10 5 ,(even? 4) ,@(map even? '(2 3 5 7)) 8))
 ;; (pass-if-equal "qq 5" '(foo foo foo)
index e42dc31333c363608447c1580f30fadcac88ca90..008e1f44dbe7380cabe3a4c40debfd135c0dcd11 100755 (executable)
@@ -9,7 +9,7 @@ exit $?
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -26,11 +26,14 @@ exit $?
 ;;; 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 (srfi srfi-0))
 (mes-use-module (srfi srfi-9))
 (mes-use-module (mes test))
 
-(when guile?
+(cond-expand
+ (guile
   (use-modules (srfi srfi-9)))
+ (mes))
 
 (pass-if "first dummy" #t)
 (pass-if-not "second dummy" #f)
index ee1c38ce437ec853f80e549a860239e30cb4e314..12a92d7bc35999c49496125f4857fed2a52002e2 100755 (executable)
@@ -9,7 +9,7 @@ exit $?
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -49,10 +49,7 @@ exit $?
 
 (pass-if "do" (sequal? (let ((acc '())) (do ((i 0 (+ i 1))) ((>= i 3)) (set! acc (cons i acc))) acc) '(2 1 0)))
 
-
-
-
-
+(pass-if ">=" (>= 3 2 1))
 
 (pass-if-equal "string-length"
     0
@@ -140,4 +137,9 @@ exit $?
 
 (pass-if-equal "compose" 1 ((compose car cdr car) '((0 1 2))))
 
+(if (not guile?)
+    (pass-if "make-vector" (sequal? (make-vector 3) #(*unspecified* *unspecified* *unspecified*))))
+
+(pass-if "make-vector 2" (sequal? (make-vector 3 1) #(1 1 1)))
+
 (result 'report)
diff --git a/tests/srfi-16.test b/tests/srfi-16.test
new file mode 100755 (executable)
index 0000000..69dbdba
--- /dev/null
@@ -0,0 +1,46 @@
+#! /bin/sh
+# -*-scheme-*-
+MES=${MES-$(dirname $0)/../scripts/mes}
+echo ' ()' | cat $(dirname $0)/../module/mes/base-0.mes $0 /dev/stdin | $MES $MES_FLAGS "$@"
+#paredit:||
+exit $?
+!#
+
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan 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 (srfi srfi-16))
+(mes-use-module (mes test))
+
+(pass-if "first dummy" #t)
+(pass-if-not "second dummy" #f)
+
+(pass-if-equal "case-lambda" 0
+    ((case-lambda
+       (() 0)
+       ((x) 1))))
+
+(pass-if-equal "case-lambda" 1
+  ((case-lambda
+     (() 0)
+     ((x) 1)) #f))
+
+(result 'report)
+
diff --git a/tests/srfi-16.test-guile b/tests/srfi-16.test-guile
new file mode 120000 (symlink)
index 0000000..5631f4a
--- /dev/null
@@ -0,0 +1 @@
+base.test-guile
\ No newline at end of file
index df5962b2bfed3fc5dfbaf38e0af0e5187eac3d50..9166d84819d5a454a4c305543236641886630f57 100755 (executable)
@@ -26,12 +26,30 @@ exit $?
 ;;; 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 syntax))
 (mes-use-module (mes test))
+(mes-use-module (mes syntax))
 
 (pass-if "first dummy" #t)
 (pass-if-not "second dummy" #f)
 
+(define-syntax sr:when
+  (syntax-rules ()
+    ((sr:when condition exp ...)
+     (if condition
+         (begin exp ...)))))
+
+(sr:when #t
+         (display "hallo\n")
+         (display "daar\n"))
+
+
+;; FIXME: macro inside let
+(define-syntax sr:when
+  (syntax-rules ()
+    ((sc:when condition exp ...)
+     (if condition
+         (begin exp ...)))))
+
 (pass-if "define-syntax when"
   (sequal?
    (let ()
@@ -44,6 +62,10 @@ exit $?
        (sr:when #t "if not now, then?")))
    "if not now, then?"))
 
+;; FIXME: macro inside let
+(define-syntax-rule (sre:when c e ...)
+  (if c (begin e ...)))
+
 (pass-if "define-syntax-rule"
   (sequal?
    (let ()
index e510511dc81a15046a950a65b9392e2e4b9b0387..c313acdf274be7f86b1e867a4842f157696dc56d 100755 (executable)
@@ -38,11 +38,9 @@ exit $?
 (pass-if "vector?" (vector? #(1 2 c)))
 (pass-if "vector-length" (seq? (vector-length #(1)) 1))
 
-(when (not guile?)
-  (pass-if "core:make-vector" (sequal? (core:make-vector 3) #(*unspecified* *unspecified* *unspecified*)))
-  (pass-if "make-vector" (sequal? (make-vector 3) #(*unspecified* *unspecified* *unspecified*))))
+(if (not guile?)
+    (pass-if "core:make-vector" (sequal? (core:make-vector 3) #(*unspecified* *unspecified* *unspecified*))))
 
-(pass-if "make-vector 2" (sequal? (make-vector 3 1) #(1 1 1)))
 (pass-if "vector-ref" (seq? (vector-ref #(0 1) 1) 1))
 (pass-if "vector-set!" (equal? (let ((v #(0 1))) (vector-set! v 1 'q) v) #(0 q)))
 (pass-if "vector-set! 2" (not (equal? (let ((v #(0 1))) (vector-set! v 1 'q) v) #())))
@@ -53,8 +51,8 @@ exit $?
                                     v2)
                                   #((0 . 0))))
 (pass-if "list->vector" (sequal? (list->vector '(a b c)) #(a b c)))
-(pass-if "vector list" (let* ((v #(0))
-                              (l '(a b c)))
+(pass-if "vector list" (let ((v #(0))
+                             (l '(a b c)))
                          (vector-set! v 0 l)
                          (set-cdr! l '())
                          (sequal? (vector->list v) '((a)))))