* 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.
--- /dev/null
+#! /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
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}
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
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="
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))
;;; -*-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.
;;;
(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)
#: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"
"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"
))
"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"
(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) '()
;;; 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)
((_ 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 ()
;;; 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)
;;; -*-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
;;; -*-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.
;;;
;;; Code:
+(define-macro (define-module module . rest) #t)
+(define (cond-expand-provide . rest) #t)
(include-from-path "srfi/srfi-16.scm")
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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"
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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")
+
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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)))
--- /dev/null
+;;; 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")
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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
+
+
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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))))
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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)
--- /dev/null
+(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)
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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))
+
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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 ()) '())
--- /dev/null
+;;; 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 "(")
--- /dev/null
+(define (read) 1)
+(define read (lambda () 0))
+(exit (read))
--- /dev/null
+(define (read) 1)
+(exit
+ ((lambda ()
+ (define read (lambda () 0))
+ (read))))
--- /dev/null
+;;; 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)))
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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)))
--- /dev/null
+;;; 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)
--- /dev/null
+;;; 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))
+
--- /dev/null
+;;; 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)))
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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)))
--- /dev/null
+
+(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)
--- /dev/null
+;;; 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")
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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))
--- /dev/null
+;;; 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")
--- /dev/null
+;;; 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)))
+
--- /dev/null
+;; -*-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")
--- /dev/null
+;;; 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*")
--- /dev/null
+;; -*-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
--- /dev/null
+/* -*-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;
+}
+
--- /dev/null
+/* -*-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;
+}
+++ /dev/null
-;;; -*-scheme-*-
-(core:display "t00\n")
--- /dev/null
+/* -*-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;
+}
(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)))
(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>"
--- /dev/null
+#! /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)
--- /dev/null
+base.test-guile
\ No newline at end of file
;;; -*-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 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))
(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)
;;; -*-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.
;;;
(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"
;;; -*-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.
;;;
(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)
;;; -*-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.
;;;
(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)
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(cond-expand
- (guile-2)
(guile
(use-modules (ice-9 optargs)))
(mes
(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>)
;;; -*-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.
;;;
(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)
;;; -*-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.
;;;
;;; 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)
;;; -*-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.
;;;
(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
(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)
--- /dev/null
+#! /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)
+
--- /dev/null
+base.test-guile
\ No newline at end of file
;;; 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 ()
(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 ()
(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) #())))
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)))))
projects / mes.git / commitdiff