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

mes: Add incremental test suite.

Browse source 
* 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.
This commit is contained in:
Jan Nieuwenhuizen 2018-01-25 06:58:44 +01:00
parent 459e4f6a57
commit 9c8e2dbd9f
104 changed files with 5716 additions and 210 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

125
check-boot.sh Executable file
View file

@ -0,0 +1,125 @@
#! /bin/bash
# Mes --- Maxwell Equations of Software
# Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
#
# This file is part of Mes.
#
# Mes is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or (at
# your option) any later version.
#
# Mes is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Mes. If not, see <http://www.gnu.org/licenses/>.
set -e
export GUILE=${GUILE-guile}
export MES=${MES-./mes}
tests="
00-zero.scm
01-true.scm
02-symbol.scm
03-string.scm
04-quote.scm
05-list.scm
06-tick.scm
07-if.scm
08-if-if.scm
10-cons.scm
11-list.scm
12-car.scm
13-cdr.scm
14-exit.scm
15-display.scm
16-if-eq-quote.scm
20-define.scm
20-define-quoted.scm
20-define-quote.scm
21-define-procedure.scm
22-define-procedure-2.scm
23-begin.scm
24-begin-define.scm
25-begin-define-2.scm
26-begin-define-later.scm
27-lambda-define.scm
28-define-define.scm
29-lambda-define.scm
2a-lambda-lambda.scm
2b-define-lambda.scm
2c-define-lambda-recurse.scm
2d-define-lambda-set.scm
2d-compose.scm
2e-define-first.scm
2f-define-second.scm
2f-define-second-lambda.scm
2g-vector.scm
30-capture.scm
31-capture-define.scm
32-capture-modify-close.scm
32-capture-modify-close.scm
33-procedure-override-close.scm
34-cdr-override-close.scm
35-closure-modify.scm
36-closure-override.scm
37-closure-lambda.scm
38-simple-format.scm
39-global-define-override.scm
3a-global-define-lambda-override.scm
40-define-macro.scm
41-when.scm
42-if-when.scm
43-or.scm
44-or-if.scm
45-pass-if.scm
46-report.scm
47-pass-if-eq.scm
48-let.scm
49-macro-override.scm
4a-define-macro-define-macro.scm
4b-define-macro-define.scm
4c-quasiquote.scm
4d-let-map.scm
4e-let-global.scm
50-primitive-load.scm
51-module.scm
52-define-module.scm
53-closure-display.scm
60-let-syntax.scm
"
for i in $tests; do
echo -n $i
if [ ! -f scaffold/boot/$i ]; then
echo ' [SKIP]'
continue;
fi
guile -L guile -L . <(echo '(use-modules (mes guile))'; cat scaffold/boot/$i) >& /dev/null
x=$(
if [ -z "${i/5[0-9]-*/}" ]; then
cat scaffold/boot/$i | MES_BOOT=boot-00.scm $MES 2>&1;
elif [ -z "${i/6[0-9]-*/}" ]; then
cat scaffold/boot/$i | MES_BOOT=boot-01.scm $MES 2>&1;
else
MES_BOOT=scaffold/boot/$i $MES 2>&1;
fi
) \
&& echo ' [PASS]' \
|| (r=$?; echo ' [FAIL]'; echo -e "$x"; echo scaffold/boot/$i; exit $r)
done

2
check-mescc.sh
View file

@ -20,7 +20,7 @@
export MES=${MES-src/mes.gcc} export MES=${MES-src/mes.gcc}
export MESCC=${MESCC-scripts/mescc.mes} export MESCC=${MESCC-scripts/mescc.mes}
#export MES_ARENA=${MES_ARENA-200000000} > 12GB mem #export MES_ARENA=${MES_ARENA-200000000} #9GiB
GUILE=${GUILE-guile} GUILE=${GUILE-guile}
MES=${MES-./mes} MES=${MES-./mes}

21
check.sh
View file

@ -20,13 +20,18 @@
export GUILE=${GUILE-guile} export GUILE=${GUILE-guile}
export MES=${MES-./mes} export MES=${MES-./mes}
#export MES_ARENA=${MES_ARENA-200000000} #9GiB
set -e
bash check-boot.sh
tests=" tests="
tests/boot.test
tests/read.test tests/read.test
tests/base.test tests/base.test
tests/closure.test
tests/quasiquote.test tests/quasiquote.test
tests/let.test tests/let.test
tests/closure.test
tests/scm.test tests/scm.test
tests/display.test tests/display.test
tests/cwv.test tests/cwv.test
@ -39,13 +44,13 @@ tests/optargs.test
tests/fluids.test tests/fluids.test
tests/catch.test tests/catch.test
tests/record.test tests/record.test
tests/syntax.test
tests/pmatch.test
tests/let-syntax.test
tests/guile.test
tests/getopt-long.test tests/getopt-long.test
tests/psyntax.test tests/guile.test
tests/syntax.test
tests/let-syntax.test
tests/pmatch.test
tests/match.test tests/match.test
tests/psyntax.test
" "
slow_or_broken=" slow_or_broken="
@ -58,6 +63,10 @@ set +e
fail=0 fail=0
total=0 total=0
for t in $tests; do for t in $tests; do
if [ ! -f $t ]; then
echo $t: [SKIP];
continue
fi
sh "$t" &> $t.log sh "$t" &> $t.log
r=$? r=$?
total=$((total+1)) total=$((total+1))

3
guile/mes-0.scm
View file

@ -1,7 +1,7 @@
;;; -*-scheme-*- ;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software ;;; 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. ;;; mes-0.scm: This file is part of Mes.
;;; ;;;
@ -33,3 +33,4 @@
(define guile-2? (and (not mes?) (not guile-1.8?))) (define guile-2? (and (not mes?) (not guile-1.8?)))
(if guile-1.8? (use-modules (ice-9 syncase))) (if guile-1.8? (use-modules (ice-9 syncase)))
(define EOF (if #f #f)) (define EOF (if #f #f))
(define append2 append)

17
make.scm
View file

@ -460,11 +460,12 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
#:includes '("src"))) #:includes '("src")))
(define mes-tests (define mes-tests
'("tests/read.test" '("tests/boot.test"
"tests/read.test"
"tests/base.test" "tests/base.test"
"tests/closure.test"
"tests/quasiquote.test" "tests/quasiquote.test"
"tests/let.test" "tests/let.test"
"tests/closure.test"
"tests/scm.test" "tests/scm.test"
"tests/display.test" "tests/display.test"
"tests/cwv.test" "tests/cwv.test"
@ -473,17 +474,18 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
"tests/srfi-1.test" "tests/srfi-1.test"
"tests/srfi-13.test" "tests/srfi-13.test"
"tests/srfi-14.test" "tests/srfi-14.test"
"tests/srfi-16.test"
"tests/optargs.test" "tests/optargs.test"
"tests/fluids.test" "tests/fluids.test"
"tests/catch.test" "tests/catch.test"
"tests/record.test" "tests/record.test"
"tests/syntax.test"
"tests/pmatch.test"
"tests/let-syntax.test"
"tests/guile.test"
"tests/getopt-long.test" "tests/getopt-long.test"
"tests/psyntax.test" "tests/guile.test"
"tests/syntax.test"
"tests/let-syntax.test"
"tests/pmatch.test"
"tests/match.test" "tests/match.test"
"tests/psyntax.test"
;;sloooowwww/broken? ;;sloooowwww/broken?
;;"tests/peg.test" ;;"tests/peg.test"
)) ))
@ -557,6 +559,7 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
"module/mes/getopt-long.mes" "module/mes/getopt-long.mes"
"module/mes/getopt-long.scm" "module/mes/getopt-long.scm"
"module/mes/guile.mes" "module/mes/guile.mes"
"module/mes/guile.scm"
"module/mes/lalr.mes" "module/mes/lalr.mes"
"module/mes/lalr.scm" "module/mes/lalr.scm"
"module/mes/let.mes" "module/mes/let.mes"

24
module/mes/base-0.mes
View file

@ -68,23 +68,6 @@
(define else #t) (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) (define-macro (load file)
(list 'begin (list 'begin
(list 'if (list getenv "MES_DEBUG") (list 'if (list getenv "MES_DEBUG")
@ -92,12 +75,9 @@
(list core:display-error ";;; read ") (list core:display-error ";;; read ")
(list core:display-error file) (list core:display-error file)
(list core:display-error "\n"))) (list core:display-error "\n")))
(list 'push! '*input-ports* (list current-input-port)) (list 'primitive-load file)))
(list 'set-current-input-port (list open-input-file file))
(list 'primitive-load)
(list 'set-current-input-port (list 'pop! '*input-ports*))))
(define include load) (define-macro (include file) (list 'load file))
(define (append . rest) (define (append . rest)
(if (null? rest) '() (if (null? rest) '()

39
module/mes/guile.scm
View file

@ -23,14 +23,51 @@
;;; Code: ;;; Code:
(define-module (mes guile) (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) ;;#:re-export (open-input-file open-input-string with-input-from-string)
) )
(cond-expand (cond-expand
(guile (guile
(define core:exit exit)
(define core:display display) (define core:display display)
(define core:display-port display)
(define (core:display-error o) (display o (current-error-port))) (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 core:open-input-file open-input-file)
;; (define (open-input-file file) ;; (define (open-input-file file)

44
module/mes/match.scm
View file

@ -837,30 +837,30 @@
((_ loop ((var init) ...) . body) ((_ loop ((var init) ...) . body)
(match-named-let loop ((var init) ...) . body)))) (match-named-let loop ((var init) ...) . body))))
;;> Similar to @scheme{match-let}, but analogously to @scheme{letrec} ;; ;;> Similar to @scheme{match-let}, but analogously to @scheme{letrec}
;;> matches and binds the variables with all match variables in scope. ;; ;;> matches and binds the variables with all match variables in scope.
(define-syntax match-letrec ;; (define-syntax match-letrec
(syntax-rules () ;; (syntax-rules ()
((_ ((var value) ...) . body) ;; ((_ ((var value) ...) . body)
(match-let/helper letrec () () ((var value) ...) . body)))) ;; (match-let/helper letrec () () ((var value) ...) . body))))
(define-syntax match-let/helper ;; (define-syntax match-let/helper
(syntax-rules () ;; (syntax-rules ()
((_ let ((var expr) ...) () () . body) ;; ((_ let ((var expr) ...) () () . body)
(let ((var expr) ...) . body)) ;; (let ((var expr) ...) . body))
((_ let ((var expr) ...) ((pat tmp) ...) () . body) ;; ((_ let ((var expr) ...) ((pat tmp) ...) () . body)
(let ((var expr) ...) ;; (let ((var expr) ...)
(match-let* ((pat tmp) ...) ;; (match-let* ((pat tmp) ...)
. body))) ;; . body)))
((_ let (v ...) (p ...) (((a . b) expr) . rest) . body) ;; ((_ let (v ...) (p ...) (((a . b) expr) . rest) . body)
(match-let/helper ;; (match-let/helper
let (v ... (tmp expr)) (p ... ((a . b) tmp)) rest . body)) ;; let (v ... (tmp expr)) (p ... ((a . b) tmp)) rest . body))
((_ let (v ...) (p ...) ((#(a ...) expr) . rest) . body) ;; ((_ let (v ...) (p ...) ((#(a ...) expr) . rest) . body)
(match-let/helper ;; (match-let/helper
let (v ... (tmp expr)) (p ... (#(a ...) tmp)) rest . body)) ;; let (v ... (tmp expr)) (p ... (#(a ...) tmp)) rest . body))
((_ let (v ...) (p ...) ((a expr) . rest) . body) ;; ((_ let (v ...) (p ...) ((a expr) . rest) . body)
(match-let/helper let (v ... (a expr)) (p ...) rest . body)))) ;; (match-let/helper let (v ... (a expr)) (p ...) rest . body))))
(define-syntax match-named-let (define-syntax match-named-let
(syntax-rules () (syntax-rules ()

2
module/mes/module.mes
View file

@ -23,7 +23,7 @@
;;; Code: ;;; Code:
(define (module->file o) (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 *modules* '(mes/base-0.mes))
(define (mes-load-module-env module a) (define (mes-load-module-env module a)

58
module/mes/test.mes
View file

@ -1,7 +1,7 @@
;;; -*-scheme-*- ;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software ;;; 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. ;;; This file is part of Mes.
;;; ;;;
@ -29,47 +29,58 @@
(define guile? (not (pair? (current-module)))) (define guile? (not (pair? (current-module))))
(define result (define result
(let ((pass 0) ((lambda (pass fail)
(fail 0))
(lambda (. t) (lambda (. t)
(cond ((or (null? t) (eq? (car t) result)) (list pass fail)) (if (or (null? t) (eq? (car t) 'result)) (list pass fail)
((eq? (car t) 'report) (if (eq? (car t) 'report)
(let ((expect (if (null? (cdr t)) 0 (cadr t)))) (begin
((lambda (expect)
(begin (display "expect: ") (write expect) (newline))
(newline) (newline)
(display "passed: ") (display pass) (newline) (display "passed: ") (display pass) (newline)
(display "failed: ") (display fail) (newline) (display "failed: ") (display fail) (newline)
(if (not (eq? expect 0)) (begin (display "expect: ") (display expect) (newline))) (if (not (eq? expect 0)) (begin (display "expect: ") (write expect) (newline)))
(display "total: ") (display (+ pass fail)) (newline) (display "total: ") (display (+ pass fail)) (newline)
(exit (if (eq? expect fail) 0 fail)))) (exit (if (eq? expect fail) 0 fail)))
((car t) (display ": pass") (newline) (set! pass (+ pass 1))) (if (null? (cdr t)) 0 (cadr t))))
(#t (display ": fail") (newline) (set! fail (+ fail 1))))))) (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) (define (seq? expect a) ;;REMOVE ME
(or (eq? a b) (or (eq? a expect)
(begin (begin
(display ": fail") (display ": fail")
(newline) (newline)
(display "expected: ") (display "expected: ")
(display b) (newline) (display expect) (newline)
(display "actual: ") (display "actual: ")
(display a) (display a)
(newline) (newline)
#f))) #f)))
(define (sequal? a b) (define (sequal? expect a) ;;REMOVE ME
(or (equal? a b) (or (equal? a expect)
(begin (begin
(display ": fail") (display ": fail")
(newline) (newline)
(display "expected: ") (display "expected: ")
(display b) (newline) (display expect) (newline)
(display "actual: ") (display "actual: ")
(display a) (display a)
(newline) (newline)
#f))) #f)))
(define (sequal2? expect actual) (define (seq2? a expect)
(or (equal? expect actual) (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 (begin
(display ": fail") (newline) (display ": fail") (newline)
(display "expected: ") (display expect) (newline) (display "expected: ") (display expect) (newline)
@ -80,16 +91,19 @@
(list (list
'begin 'begin
(list display "test: ") (list display name) (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) (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) (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) (define-macro (pass-if-not name f)
(list (list
'begin 'begin
(list display "test: ") (list display name) (list display "test: ") (list display name)
(list result (list not f)))) (list 'result (list not f)))) ;; FIXME

4
module/srfi/srfi-16.mes
View file

@ -1,7 +1,7 @@
;;; -*-scheme-*- ;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software ;;; 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. ;;; This file is part of Mes.
;;; ;;;
@ -22,4 +22,6 @@
;;; Code: ;;; Code:
(define-macro (define-module module . rest) #t)
(define (cond-expand-provide . rest) #t)
(include-from-path "srfi/srfi-16.scm") (include-from-path "srfi/srfi-16.scm")

19
scaffold/boot/00-zero.scm Normal file
View file

@ -0,0 +1,19 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
0

19
scaffold/boot/01-true.scm Normal file
View file

@ -0,0 +1,19 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
#t

19
scaffold/boot/02-symbol.scm Normal file
View file

@ -0,0 +1,19 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
'mes

19
scaffold/boot/03-string.scm Normal file
View file

@ -0,0 +1,19 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
"mes"

19
scaffold/boot/04-cons.scm Normal file
View file

@ -0,0 +1,19 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(cons 0 1)

19
scaffold/boot/04-quote.scm Normal file
View file

@ -0,0 +1,19 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(quote (0 1))

19
scaffold/boot/05-list.scm Normal file
View file

@ -0,0 +1,19 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(list 0 1)

19
scaffold/boot/06-tick.scm Normal file
View file

@ -0,0 +1,19 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
'(0 1)

19
scaffold/boot/07-if.scm Normal file
View file

@ -0,0 +1,19 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(if #t 0 1)

19
scaffold/boot/08-if-if.scm Normal file
View file

@ -0,0 +1,19 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(if #t (if #t 'foo))

19
scaffold/boot/10-cons.scm Normal file
View file

@ -0,0 +1,19 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(cons 0 1)

19
scaffold/boot/11-list.scm Normal file
View file

@ -0,0 +1,19 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(list 0 1)

19
scaffold/boot/12-car.scm Normal file
View file

@ -0,0 +1,19 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(car '(0 1))

19
scaffold/boot/13-cdr.scm Normal file
View file

@ -0,0 +1,19 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(cdr '(0 . 1))

19
scaffold/boot/14-exit.scm Normal file
View file

@ -0,0 +1,19 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(exit 0)

20
scaffold/boot/15-display.scm Normal file
View file

@ -0,0 +1,20 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(core:display "t00\n")

20
scaffold/boot/16-if-eq-quote.scm Normal file
View file

@ -0,0 +1,20 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(if (if #t (eq? 0 '0)) (exit 0))
(exit 1)

22
scaffold/boot/20-define-quote.scm Normal file
View file

@ -0,0 +1,22 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define <cell:char> 0)
(define cell:type-alist
(list (cons <cell:char> (quote <cell:char>))))
cell:type-alist

20
scaffold/boot/20-define-quoted.scm Normal file
View file

@ -0,0 +1,20 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define mes '(0 1))
mes

19
scaffold/boot/20-define.scm Normal file
View file

@ -0,0 +1,19 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define t #t)

20
scaffold/boot/21-define-procedure.scm Normal file
View file

@ -0,0 +1,20 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define (not x) (if x #f #t))
(if (not #f) (exit 0) (exit 1))

22
scaffold/boot/22-define-procedure-2.scm Normal file
View file

@ -0,0 +1,22 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define (not x) (if x #f #t))
(define (not2 x) (if x #f #t))
(if (not #f) (exit 0) (exit 1))
(if (not2 #f) (exit 0) (exit 1))

20
scaffold/boot/23-begin.scm Normal file
View file

@ -0,0 +1,20 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(begin
#t)

21
scaffold/boot/24-begin-define.scm Normal file
View file

@ -0,0 +1,21 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(begin
(define (not x) (if x #f #t)))
(if (not #f) (exit 0) (exit 1))

23
scaffold/boot/25-begin-define-2.scm Normal file
View file

@ -0,0 +1,23 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(begin
(define (not x) (if x #f #t))
(define (not2 x) (if x #f #t)))
(not #t)
(not2 #t)

22
scaffold/boot/26-begin-define-later.scm Normal file
View file

@ -0,0 +1,22 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(begin
(define (foo) (bar))
(define (bar) 0)
(exit (bar)))

33
scaffold/boot/26-define-define.scm Normal file
View file

@ -0,0 +1,33 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define (x x1 x2)
(define b 1)
(define b1 1)
(define b2 1)
(define (y) b)
(define (y1) b)
(define (y2) b)
(set! b 0)
(list b (y)))
(core:display "x:")
(core:display x)
(core:display "\n")
(core:display (x 1 2))
(core:display "\n")

25
scaffold/boot/27-lambda-define.scm Normal file
View file

@ -0,0 +1,25 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
((lambda (foo bar lst)
(define (next)
foo
bar
lst)
(next))
'foo 'bar '(0 1 2))

25
scaffold/boot/28-define-define.scm Normal file
View file

@ -0,0 +1,25 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define (f foo lst)
(define (next)
lst)
(next))
(if (eq? (f 'foo '24) 24) (exit 0))
(exit 1)

27
scaffold/boot/29-lambda-define.scm Normal file
View file

@ -0,0 +1,27 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(if (eq?
((lambda (foo lst)
(define (next)
foo)
(next))
'12 '(0 1 2))
12)
(exit 0))
(exit 1)

27
scaffold/boot/2a-lambda-lambda.scm Normal file
View file

@ -0,0 +1,27 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(if (eq?
((lambda (foo lst)
((lambda (bar)
lst)
42))
'12 '24)
24)
(exit 0))
(exit 1)

24
scaffold/boot/2b-define-lambda.scm Normal file
View file

@ -0,0 +1,24 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define f (lambda (t) t))
(f 0)
;;f

33
scaffold/boot/2c-define-lambda-recurse.scm Normal file
View file

@ -0,0 +1,33 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define (foo x pair?)
(core:display "foo x=") (core:display x) (core:display "\n")
(core:display " pair?=") (core:display pair?) (core:display "\n")
(if pair? ((lambda (a d)
(cons a d))
(begin
(core:display "BEFORE x=") (core:display x) (core:display "\n")
(foo (car x) #f))
(begin
(core:display "EFTER x=") (core:display x) (core:display "\n")
(foo (cdr x) #f)))
x))
(if (null? (cdr (foo '(42) #t))) (exit 0))
(exit 1)

23
scaffold/boot/2d-compose.scm Normal file
View file

@ -0,0 +1,23 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define (compose proc . rest)
(if (null? rest) proc
(lambda args
(proc (core:apply (core:apply compose rest) args)))))
(exit ((compose car cdr car) '((1 0 2))))

23
scaffold/boot/2d-define-lambda-set.scm Normal file
View file

@ -0,0 +1,23 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define foo #f)
((lambda (bar)
(set! foo (lambda () bar)))
0)
(exit (foo))

34
scaffold/boot/2e-define-first.scm Normal file
View file

@ -0,0 +1,34 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define display core:display)
(define write core:write)
(define (foo doit bar)
(display "foo doit=")
(write doit)
(display "\n")
(display " bar=")
(write bar)
(display "\n")
(doit bar))
(foo display 1)
(foo exit 0)
(exit 1)

30
scaffold/boot/2f-define-second-lambda.scm Normal file
View file

@ -0,0 +1,30 @@
(define display core:display)
(define write core:write)
;; unmemoize removes formal caching...but only one level
(define (foo doit bar)
(define baz
(lambda (doit)
(display " baz:doit=")
(write doit)
(display " baz:bar=")
(write bar)
(display "\n")
(doit bar)))
(display "foo doit=")
(write doit)
(display "\n")
(display " bar=")
(write bar)
(display "\n")
(display " baz=")
(write baz)
(display "\n")
(baz doit))
(foo display 1)
(display "foo=")
(write foo)
(display "\n")
(foo exit 0)
(exit 1)

47
scaffold/boot/2f-define-second.scm Normal file
View file

@ -0,0 +1,47 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define display core:display)
(define write core:write)
;; unmemoize removes formal caching...but only one level
(define (foo doit bar)
(define (baz doit)
(display " baz:doit=")
(write doit)
(display " baz:bar=")
(write bar)
(display "\n")
(doit bar))
(display "foo doit=")
(write doit)
(display "\n")
(display " bar=")
(write bar)
(display "\n")
(display " baz=")
(write baz)
(display "\n")
(baz doit))
(foo display 1)
(display "foo=")
(write foo)
(display "\n")
(foo exit 0)
(exit 1)

23
scaffold/boot/2g-vector.scm Normal file
View file

@ -0,0 +1,23 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define (remainder x y)
(- x (* (/ x y) y)))
(define (even? x)
(= 0 (remainder x 2)))
#(10 5 ,(even? 4) ,@(map even? '(2 3 5 7)) 8)

20
scaffold/boot/30-capture.scm Normal file
View file

@ -0,0 +1,20 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define (x) 0)
(exit (x))

21
scaffold/boot/31-capture-define.scm Normal file
View file

@ -0,0 +1,21 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define (x) 0)
(define y (x))
(exit y)

21
scaffold/boot/32-capture-modify-close.scm Normal file
View file

@ -0,0 +1,21 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define (x) 0)
(exit (x))
(set! x (lambda () 1))

23
scaffold/boot/33-procedure-override-close.scm Normal file
View file

@ -0,0 +1,23 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define core:exit exit)
(define (x) 0)
(core:display "x=") (core:display (x)) (core:display "\n")
(exit (x))
(define (exit x) (core:exit 1))

21
scaffold/boot/34-cdr-override-close.scm Normal file
View file

@ -0,0 +1,21 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define (x) 0)
(exit (x))
(define (x) 1)

23
scaffold/boot/35-closure-modify.scm Normal file
View file

@ -0,0 +1,23 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define x 1)
(define (f) x)
(set! x 0)
(exit (f))

22
scaffold/boot/36-closure-override.scm Normal file
View file

@ -0,0 +1,22 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define (x) 1)
(define (f) (x))
(define (x) 0)
(exit (f))

67
scaffold/boot/37-closure-lambda.scm Normal file
View file

@ -0,0 +1,67 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define <cell:pair> 7)
(define (pair? x)
(eq? (core:type x) <cell:pair>))
(define (atom? x)
(if (pair? x) #f
(if (null? x) #f
#t)))
(define (memq x lst)
(if (null? lst) #f
(if (eq? x (car lst)) lst
(memq x (cdr lst)))))
(define (caar x) (car (car x)))
(define (cadr x) (car (cdr x)))
(define (cdar x) (cdr (car x)))
(define (cddr x) (cdr (cdr x)))
(define (loop first rest accum)
(core:display-error "\nloop\n first=")
(core:write-error first)
(core:display-error "\n")
(core:display-error " rest=")
(core:write-error rest)
(core:display-error "\n")
(core:display-error " accum=")
(core:write-error accum)
(core:display-error "\n")
((lambda (next)
(if (atom? first)
(next (cons (cons first
(car rest)) accum))
(if (null? rest)
accum
(next accum))))
(lambda (a)
(core:display-error "\nnext a=")
(core:write-error a)
(core:display-error "\n")
(core:display-error " rest=")
(core:write-error rest)
(core:display-error "\n")
(if (null? (cdr rest))
a
(loop (cadr rest) (cddr rest) a)))))
(loop 'functions '(() 'globals ()) '())

73
scaffold/boot/38-simple-format.scm Normal file
View file

@ -0,0 +1,73 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define <cell:pair> 7)
(define (pair? x) (eq? (core:type x) <cell:pair>))
(define (not x) (if x #f #t))
(define-macro (or . x)
(if (null? x) #f
(if (null? (cdr x)) (car x)
(list (list (quote lambda) (list (quote r))
(list (quote if) (quote r) (quote r)
(cons (quote or) (cdr x))))
(car x)))))
(define (boolean? x)
(or (eq? x #f) (eq? x #t)))
(define (display x . rest)
(if (null? rest) (core:display x)
(core:display-port x (car rest))))
(define (write x . rest)
(if (null? rest) (core:write x)
(core:write-port x (car rest))))
(define (cadr x) (car (cdr x)))
(define (cddr x) (cdr (cdr x)))
;;(define (current-output-port) 1)
(define (simple-format destination format . rest)
((lambda (port lst)
(define (simple-format lst args)
(if (pair? lst)
((lambda (c)
(if (not (eq? c #\~)) (begin (write-char (car lst) port)
(simple-format (cdr lst) args))
((lambda (c)
(if (or (eq? c #\A)
(eq? c #\a))
(display (car args) port)
(if (or (eq? c #\S)
(eq? c #\s))
(write (car args) port)
(write (car args) port)))
(simple-format (cddr lst) (cdr args)))
(cadr lst))))
(car lst))))
(if destination (simple-format lst rest)
(with-output-to-string
(lambda () (simple-format lst rest)))))
(if (boolean? destination) (current-output-port) destination)
;;(string->list format)
format))
;;(simple-format 2 "~A:~A: parse failed at state ~A, on input ~S\n" "<stdin>" 1 59 "(")
(simple-format #t '(#\~ #\A #\: #\~ #\A #\: #\space #\p #\a #\r #\s #\e #\space #\f #\a #\i #\l #\e #\d #\space #\a #\t #\space #\s #\t #\a #\t #\e #\space #\~ #\A #\, #\space #\o #\n #\space #\i #\n #\p #\u #\t #\space #\~ #\S #\newline) "<stdin>" 1 59 "(")

3
scaffold/boot/39-global-define-override.scm Normal file
View file

@ -0,0 +1,3 @@
(define (read) 1)
(define read (lambda () 0))
(exit (read))

5
scaffold/boot/3a-global-define-lambda-override.scm Normal file
View file

@ -0,0 +1,5 @@
(define (read) 1)
(exit
((lambda ()
(define read (lambda () 0))
(read))))

20
scaffold/boot/40-define-macro.scm Normal file
View file

@ -0,0 +1,20 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define-macro (when exp . body)
(list 'if exp (cons 'begin body)))

24
scaffold/boot/41-when.scm Normal file
View file

@ -0,0 +1,24 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define-macro (when exp . body)
(list 'if exp (cons 'begin body)))
(when #t
(exit 0))
(exit 1)

22
scaffold/boot/42-if-when.scm Normal file
View file

@ -0,0 +1,22 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define-macro (foo bar)
(list 'begin bar))
(if #t (foo 3))

35
scaffold/boot/43-or.scm Normal file
View file

@ -0,0 +1,35 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define-macro (or . x)
(if (null? x) #f
(if (null? (cdr x)) (car x)
(list (list (quote lambda) (list (quote r))
(list (quote if) (quote r) (quote r)
(cons (quote or) (cdr x))))
(car x)))))
(define (f a)
(or #t a))
(define-macro (foo bar)
(list f bar))
(foo 3)
(if #t (foo 3))

27
scaffold/boot/44-or-if.scm Normal file
View file

@ -0,0 +1,27 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define-macro (or . x)
(if (null? x) #f
(if (null? (cdr x)) (car x)
(list (list (quote lambda) (list (quote r))
(list (quote if) (quote r) (quote r)
(cons (quote or) (cdr x))))
(car x)))))
(or #t (if #t 'false))

31
scaffold/boot/45-pass-if.scm Normal file
View file

@ -0,0 +1,31 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define result
(lambda (. t)
(core:display "result: t=")
(core:display t)
(core:display "\n")))
(define-macro (pass-if name t)
(list
'begin
(list core:display "test: ") (list core:display name)
(list result t)))
(pass-if "first dummy" #t)

61
scaffold/boot/46-report.scm Normal file
View file

@ -0,0 +1,61 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define display core:display)
(define write core:write)
(define (newline) (display "\n"))
(define-macro (or . x)
(if (null? x) #f
(if (null? (cdr x)) (car x)
(list (list (quote lambda) (list (quote r))
(list (quote if) (quote r) (quote r)
(cons (quote or) (cdr x))))
(car x)))))
(define (cadr x) (car (cdr x)))
(define (not x) (if x #f #t))
(define result
((lambda (pass fail)
(lambda (. t)
(if (or (null? t) (eq? (car t) 'result)) (list pass fail)
(if (eq? (car t) 'report)
(begin
((lambda (expect)
(newline)
(display "passed: ") (display pass) (newline)
(display "failed: ") (display fail) (newline)
(if (not (eq? expect 0)) (begin (display "expect: ") (write expect) (newline)))
(display "total: ") (display (+ pass fail)) (newline)
(exit (if (eq? expect fail) 0 fail)))
(begin
(if (null? (cdr t)) 0 (cadr t)))))
(if (car t) (begin (display ": pass") (newline) (set! pass (+ pass 1)))
(begin (display ": fail") (newline) (set! fail (+ fail 1))))))))
0 0))
(define-macro (pass-if name t)
(list
'begin
(list display "test: ") (list display name)
(list result t)))
(pass-if "first dummy" #t)
(result 'report 1)

36
scaffold/boot/47-pass-if-eq.scm Normal file
View file

@ -0,0 +1,36 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define result
(lambda (. t)
(core:display "result: t=")
(core:display t)
(core:display "\n")))
(define-macro (pass-if name t)
(list
'begin
(list core:display "test: ") (list core:display name)
(list result t)))
(define-macro (pass-if-eq name expect . body)
(list 'pass-if name (list eq? expect (cons 'begin body))))
(pass-if-eq "if" 'true (if #t 'foo))
(result 'report)

32
scaffold/boot/48-let.scm Normal file
View file

@ -0,0 +1,32 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define (map1 f lst)
(if (null? lst) (list)
(cons (f (car lst)) (map1 f (cdr lst)))))
(define (cadr x) (car (cdr x)))
(define-macro (let bindings . rest)
(cons (cons 'lambda (cons (map1 car bindings) rest))
(map1 cadr bindings)))
(let ((x 0)) x)
(let ((y 0)) y)
(exit (let ((xx 0)) xx))
(exit 1)

22
scaffold/boot/49-macro-override.scm Normal file
View file

@ -0,0 +1,22 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define-macro (when exp . body)
#t)
(define-macro (when test . rest)
(list 'if test (cons 'begin rest)))

27
scaffold/boot/4a-define-macro-define-macro.scm Normal file
View file

@ -0,0 +1,27 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define-macro (foo)
(list 'define-macro (list 'bar)
(list 'define-macro (list 'append)
42)
#t))
(foo)
(bar)
(append)

25
scaffold/boot/4b-define-macro-define.scm Normal file
View file

@ -0,0 +1,25 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define-macro (foo)
(list 'lambda (list 'exp 'r)
(list 'define '%input (list 'r ''*input*))
'exp))
((foo) 'bla (lambda (x0) x0))

164
scaffold/boot/4c-quasiquote.scm Normal file
View file

@ -0,0 +1,164 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define <cell:pair> 7)
(define (pair? x) (eq? (core:type x) <cell:pair>))
(define <cell:vector> 14)
(define (vector? x)
(eq? (core:type x) <cell:vector>))
(define-macro (cond . clauses)
(list 'if (pair? clauses)
(list (cons
'lambda
(cons
'(test)
(list (list 'if 'test
(if (pair? (cdr (car clauses)))
(if (eq? (car (cdr (car clauses))) '=>)
(append2 (cdr (cdr (car clauses))) '(test))
(list (cons 'lambda (cons '() (cons 'test (cdr (car clauses)))))))
(list (cons 'lambda (cons '() (cons 'test (cdr (car clauses)))))))
(if (pair? (cdr clauses))
(cons 'cond (cdr clauses)))))))
(car (car clauses)))))
(define else #t)
(define append append2)
(define (not x) (if x #f #t))
(define-macro (and . x)
(if (null? x) #t
(if (null? (cdr x)) (car x)
(list (quote if) (car x) (cons (quote and) (cdr x))
#f))))
(define (cons* . rest)
(if (null? (cdr rest)) (car rest)
(cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
(define (memq x lst)
(if (null? lst) #f
(if (eq? x (car lst)) lst
(memq x (cdr lst)))))
;; (define (quasiquote-expand x)
;; (core:display "quasiquote-expand x=") (core:display x) (core:display "\n")
;; (cond ((null? x)
;; (core:display "NULL\n")
;; '())
;; ((vector? x)
;; (core:display "vector\n")
;; (list 'list->vector (quasiquote-expand (vector->list x))))
;; ((not (pair? x))
;; (core:display "NOT a pair\n")
;; (cons 'quote (cons x '())))
;; ((eq? (car x) 'quasiquote) (quasiquote-expand (quasiquote-expand
;; (if (null? (cddr x)) (cadr x)
;; (cons 'list (cdr x))))))
;; ((eq? (car x) 'unquote) (if (null? (cddr x)) (cadr x)
;; (cons 'list (cdr x))))
;; ((and (pair? (car x)) (eq? (caar x) 'unquote-splicing))
;; ((lambda (d)
;; (if (null? (cddar x)) (list 'append (cadar x) d)
;; (list 'quote (append (cdar x) d))))
;; (quasiquote-expand (cdr x))))
;; (else
;; (core:display "ELSje\n")
;; (core:display "CAR x=") (core:display (car x))
;; (core:display "\n")
;; (core:display "CDR x=") (core:display (cdr x))
;; (core:display "\n")
;; ((lambda (a d)
;; (core:display " a=") (core:display a) (core:display "\n")
;; (core:display " d=") (core:display d)
;; (if (pair? d)
;; (if (eq? (car d) 'quote)
;; (if (and (pair? a) (eq? (car a) 'quote))
;; (list 'quote (cons (cadr a) (cadr d)))
;; (if (null? (cadr d))
;; (list 'list a)
;; (list 'cons* a d)))
;; (if (memq (car d) '(list cons*))
;; (cons (car d) (cons a (cdr d)))
;; (list 'cons* a d)))
;; (list 'cons* a d)))
;; (quasiquote-expand (car x))
;; (list 'quasiquote-expand (list 'cdr x))))))
(define (caar x) (car (car x)))
(define (cadr x) (car (cdr x)))
(define (cdar x) (cdr (car x)))
(define (cddr x) (cdr (cdr x)))
(define (cadar x) (car (cdr (car x))))
(define (cddar x) (cdr (cdr (car x))))
(define (quasiquote-expand x)
(core:display "quasiquote-expand x=") (core:display x) (core:display "\n")
(cond ((vector? x) (list 'list->vector (quasiquote-expand (vector->list x))))
((not (pair? x)) (cons 'quote (cons x '())))
((eq? (car x) 'quasiquote) (quasiquote-expand (quasiquote-expand
(if (null? (cddr x)) (cadr x)
(cons 'list (cdr x))))))
((eq? (car x) 'unquote) (if (null? (cddr x)) (cadr x)
(cons 'list (cdr x))))
((and (pair? (car x)) (eq? (caar x) 'unquote-splicing))
((lambda (d)
(if (null? (cddar x)) (list 'append (cadar x) d)
(list 'quote (append (cdar x) d))))
(quasiquote-expand (cdr x))))
(else
(core:display "ELSje\n")
(core:display "CAR x=") (core:display (car x))
(core:display "\n")
(core:display "CDR x=") (core:display (cdr x))
(core:display "\n")
((lambda (a d)
(core:display "CAR a=") (core:display a)
(core:display "\n")
(core:display "CDR d=") (core:display d)
(core:display "\n")
(if (pair? d)
(if (eq? (car d) 'quote)
(if (and (pair? a) (eq? (car a) 'quote))
(list 'quote (cons (cadr a) (cadr d)))
(if (null? (cadr d))
(list 'list a)
(list 'cons* a d)))
(if (memq (car d) '(list cons*))
(cons (car d) (cons a (cdr d)))
(list 'cons* a d)))
(list 'cons* a d)))
(quasiquote-expand (car x))
(quasiquote-expand (cdr x))
))))
(define-macro (quasiquote x)
(quasiquote-expand x))
;; (define (remainder x y)
;; (- x (* (/ x y) y)))
;; (define (even? x)
;; (eq? 0 (remainder x v2)))
;; (pass-if-equal "qq 4" '#(10 5 #t #t #f #f #f 8)
;; `#(10 5 ,(even? 4) ,@(map even? '(2 3 5 7)) 8))
;;(core:display (quasiquote #(42)))
(core:display (quasiquote-expand #(42)))

39
scaffold/boot/4d-let-map.scm Normal file
View file

@ -0,0 +1,39 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define map 'boo)
(define (map f lst)
(if (null? lst) (list)
(cons (f (car lst)) (map f (cdr lst)))))
(define (cadr x) (car (cdr x)))
(define-macro (let bindings . rest)
(cons (cons 'lambda (cons (map car bindings) rest))
(map cadr bindings)))
(let ((a 0)
(b 1)
(c 2)
(d 3)
(e 4)
(f 5)
(g 6)
(h 7)
(i 8))
(+ a b))

33
scaffold/boot/4e-let-global.scm Normal file
View file

@ -0,0 +1,33 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define (cadr x) (car (cdr x)))
(define (map f lst)
(if (null? lst) (list)
(cons (f (car lst)) (map f (cdr lst)))))
(define-macro (let bindings . rest)
(cons (cons 'lambda (cons (map car bindings) rest))
(map cadr bindings)))
(define (list-length list)
(let ((length (length list)))
(- length 2)))
(exit (list-length '(bar baz)))

98
scaffold/boot/4e-string-split.scm Normal file
View file

@ -0,0 +1,98 @@
(define (cons* . rest)
(if (null? (cdr rest)) (car rest)
(cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
(define (caar x) (car (car x)))
(define (cadr x) (car (cdr x)))
(define (cdar x) (cdr (car x)))
(define (cddr x) (cdr (cdr x)))
(define <cell:symbol> 11)
(define (symbol? x)
(eq? (core:type x) <cell:symbol>))
(define (map f lst)
(if (null? lst) (list)
(cons (f (car lst)) (map f (cdr lst)))))
(define-macro (simple-let bindings . rest)
(cons (cons 'lambda (cons (map car bindings) rest))
(map cadr bindings)))
;; (define-macro (xsimple-let bindings rest)
;; `(,`(lambda ,(map car bindings) ,@rest)
;; ,@(map cadr bindings)))
(define-macro (xsimple-let bindings rest)
(cons* (cons* (quote lambda)
(map car bindings) (append2 rest (quote ())))
(append2 (map cadr bindings) (quote ()))))
;; (define-macro (xnamed-let name bindings rest)
;; `(simple-let ((,name *unspecified*))
;; (set! ,name (lambda ,(map car bindings) ,@rest))
;; (,name ,@(map cadr bindings))))
(define-macro (xnamed-let name bindings rest)
(list (quote simple-let)
(list (cons* name (quote (*unspecified*))))
(list (quote set!)
name
(cons* (quote lambda)
(map car bindings)
(append2 rest (quote ()))))
(cons* name (append2 (map cadr bindings) (quote ())))))
;; (define-macro (let bindings-or-name . rest)
;; (if (symbol? bindings-or-name)
;; `(xnamed-let ,bindings-or-name ,(car rest) ,(cdr rest))
;; `(xsimple-let ,bindings-or-name ,rest)))
(define-macro (let bindings-or-name . rest)
(if (symbol? bindings-or-name) (list (quote xnamed-let) bindings-or-name (car rest) (cdr rest))
(list (quote xsimple-let) bindings-or-name rest)))
(define ss-memq-inner #f)
(define (ss-memq x lst)
(if (null? lst) #f ;; IF
(if (eq? x (car lst)) lst
(ss-memq-inner x (cdr lst)))))
(define (ss-memq-inner x lst)
(if (null? lst) #f ;; IF
(if (eq? x (car lst)) lst
(ss-memq-inner x (cdr lst)))))
(define (ss-list-head x n)
(if (= 0 n) '()
(cons (car x) (ss-list-head (cdr x) (- n 1)))))
;; (define (foo x y)
;; (cons x y))
;; (define (ss-list-head x n)
;; (if (= 0 n) '()
;; (foo (car x) (ss-list-head (cdr x) (- n 1)))))
(define (string->list s)
(core:car s))
(define <cell:string> 10)
(define (list->string lst)
(core:make-cell <cell:string> lst 0))
(define (not x) (if x #f #t))
(define (string-split s c)
(let loop ((lst (string->list s)) (result '()))
(let ((rest (ss-memq c lst)))
(if (not rest) (append2 result (list (list->string lst)))
(loop (cdr rest)
(append2 result
(list (list->string (ss-list-head lst (- (length lst) (length rest)))))))))))
(core:display-error "*START*\n")
(string-split "foo bar" #\space)
(string-split "baz bla" #\space)

35
scaffold/boot/50-primitive-load.scm Normal file
View file

@ -0,0 +1,35 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(cond-expand
(guile)
(mes
(define-macro (include-from-path file)
(list
'begin
(list 'primitive-load file)))))
(include-from-path "scaffold/boot/data/i.scm")
(core:display "from-i:")
(core:display from-i)
(core:display "\n")
(core:display "from-i-macro")
(core:display (from-i-macro))
(core:display "\n")

114
scaffold/boot/51-module.scm Normal file
View file

@ -0,0 +1,114 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(cond-expand
(guile)
(mes
(define (cons* . rest)
(if (null? (cdr rest)) (car rest)
(cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
(define (apply f h . t)
(if (null? t) (core:apply f h (current-module))
(apply f (apply cons* (cons h t)))))
(define (append . rest)
(core:display-error "append rest=")
(core:write-error rest)
(core:display-error "\n")
(if (null? rest) '()
(if (null? (cdr rest)) (car rest)
(append2 (car rest) (apply append (cdr rest))))))
(define (string->list s)
(core:car s))
(define <cell:string> 10)
(define (string . lst)
(core:make-cell <cell:string> lst 0))
(define (string-append . rest)
(apply string (apply append (map string->list rest))))
(define %prefix (getenv "MES_PREFIX"))
(define (not x) (if x #f #t))
(define (map1 f lst)
(if (null? lst) (list)
(cons (f (car lst)) (map1 f (cdr lst)))))
(define map map1)
(define (list->string lst)
(core:make-cell <cell:string> lst 0))
(define %moduledir
(if (not %prefix ) "module/"
(list->string
(append (string->list %prefix)
(string->list "/module") ; `module/' gets replaced upon install
(string->list "/")))))
(define-macro (load file)
(list 'begin
(list 'if (list getenv "MES_DEBUG")
(list 'begin
(list core:display-error ";;; read ")
(list core:display-error file)
(list core:display-error "\n")))
(list 'primitive-load file)))
(define-macro (include-from-path file)
(list 'load (list string-append %moduledir file)))
(define (string->symbol s)
(core:lookup-symbol (core:car s)))
(define (symbol->list s)
(core:car s))
(define <cell:string> 10)
(define (string . lst)
(core:make-cell <cell:string> lst 0))
(define (symbol->string s)
(apply string (symbol->list s)))
(define (getcwd) ".")
(define (display x . rest)
(if (null? rest) (core:display x)
(core:display-port x (car rest))))
))
(define (memq x lst)
(if (null? lst) #f
(if (eq? x (car lst)) lst
(memq x (cdr lst)))))
(define (string-join lst infix)
(if (null? (cdr lst)) (car lst)
(string-append (car lst) infix (string-join (cdr lst) infix))))
(include-from-path "mes/module.mes")
(core:display-error module->file) (core:display-error "\n")
(define %moduledir (string-append (getcwd) "/"))
(mes-use-module (scaffold boot data module))
(mes-use-module (scaffold boot data module))

83
scaffold/boot/52-define-module.scm Normal file
View file

@ -0,0 +1,83 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(cond-expand
(guile
)
(mes
;;;;;;;;;;;;;;;
(define (cons* . rest)
(if (null? (cdr rest)) (car rest)
(cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
(define (apply f h . t)
(if (null? t) (core:apply f h (current-module))
(apply f (apply cons* (cons h t)))))
(define (append . rest)
(if (null? rest) '()
(if (null? (cdr rest)) (car rest)
(append2 (car rest) (apply append (cdr rest))))))
(define (string->list s)
(core:car s))
(define <cell:string> 10)
(define (string . lst)
(core:make-cell <cell:string> lst 0))
(define (map1 f lst)
(if (null? lst) (list)
(cons (f (car lst)) (map1 f (cdr lst)))))
(define map map1)
(define (string-append . rest)
(apply string (apply append (map string->list rest))))
;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;
(define (symbol->list s)
(core:car s))
(define (symbol->string s)
(apply string (symbol->list s)))
(define (string-join lst infix)
(if (null? (cdr lst)) (car lst)
(string-append (car lst) infix (string-join (cdr lst) infix))))
;;;;;;;;;;;;;;;;;;
(define (string->symbol s)
(core:lookup-symbol (core:car s)))
(define-macro (load file)
(list 'primitive-load file))
(define (not x) (if x #f #t))
(define (memq x lst)
(if (null? lst) #f
(if (eq? x (car lst)) lst
(memq x (cdr lst)))))
))
(define %moduledir "./")
(primitive-load "module/mes/module.mes")
(mes-use-module (scaffold boot data bar))

58
scaffold/boot/53-closure-display.scm Normal file
View file

@ -0,0 +1,58 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(cond-expand
(guile
(define closure identity))
(mes
(define display core:display)
(define write core:write)
(define (newline) (display "\n"))
(define (cadr x) (car (cdr x)))
(define (map f lst)
(if (null? lst) (list)
(cons (f (car lst)) (map f (cdr lst)))))
(define (closure x)
(map car (cdr (core:cdr (core:car (core:cdr (cdr (assq 'x (current-module)))))))))))
(define (x t) #t)
(define (xx x1 x2)
(define blabla 4)
(define (blubblub) 5)
#t)
(newline)
(display "x:")
(display x)
(newline)
(newline)
(display "xx:")
(display xx)
(newline)
(display "closure:")
(display closure)
(newline)
(display "closure xx:")
(write (closure xx))
(display "\n")
(xx 0 1)
(display " => closure xx:")
(write (closure xx))
(display "\n")

476
scaffold/boot/60-let-syntax.scm Normal file
View file

@ -0,0 +1,476 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define-macro (and . x)
(if (null? x) #t
(if (null? (cdr x)) (car x)
(list (quote if) (car x) (cons (quote and) (cdr x))
#f))))
(define-macro (or . x)
(if (null? x) #f
(if (null? (cdr x)) (car x)
(list (list (quote lambda) (list (quote r))
(list (quote if) (quote r) (quote r)
(cons (quote or) (cdr x))))
(car x)))))
(define else #t)
(define-macro (cond . clauses)
(list 'if (pair? clauses)
(list (cons
'lambda
(cons
'(test)
(list (list 'if 'test
(if (pair? (cdr (car clauses)))
(if (eq? (car (cdr (car clauses))) '=>)
(append2 (cdr (cdr (car clauses))) '(test))
(list (cons 'lambda (cons '() (cons 'test (cdr (car clauses)))))))
(list (cons 'lambda (cons '() (cons 'test (cdr (car clauses)))))))
(if (pair? (cdr clauses))
(cons 'cond (cdr clauses)))))))
(car (car clauses)))))
(define (memq x lst)
(if (null? lst) #f
(if (eq? x (car lst)) lst
(memq x (cdr lst)))))
;; (cond-expand
;; (guile
;; (define closure identity)
;; (define body identity)
;; (define append2 append)
;; (define (core:apply f a m) (f a))
;; )
;; (mes
(define <cell:symbol> 11)
(define (symbol? x)
(eq? (core:type x) <cell:symbol>))
(define (string->symbol s)
(if (not (pair? (core:car s))) '()
(core:lookup-symbol (core:car s))))
(define <cell:string> 10)
(define (string? x)
(eq? (core:type x) <cell:string>))
(define <cell:vector> 14)
(define (vector? x)
(eq? (core:type x) <cell:vector>))
;; (define (body x)
;; (core:cdr (core:cdr (core:cdr (cdr (assq 'x (current-module)))))))
;; (define (closure x)
;; (map car (cdr (core:cdr (core:car (core:cdr (cdr (assq 'x (current-module)))))))))
;; ))
(define (cons* . rest)
(if (null? (cdr rest)) (car rest)
(cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
(define (apply f h . t)
(if (null? t) (core:apply f h (current-module))
(apply f (apply cons* (cons h t)))))
(define (append . rest)
(if (null? rest) '()
(if (null? (cdr rest)) (car rest)
(append2 (car rest) (apply append (cdr rest))))))
(define-macro (quasiquote x)
;;(core:display-error "quasiquote:") (core:write-error x) (core:display-error "\n")
(define (loop x)
;;(core:display-error "loop:") (core:write-error x) (core:display-error "\n")
(if (vector? x) (list 'list->vector (loop (vector->list x)))
(if (not (pair? x)) (cons 'quote (cons x '()))
(if (eq? (car x) 'quasiquote) (loop (loop (cadr x)))
(if (eq? (car x) 'unquote) (cadr x)
(if (and (pair? (car x)) (eq? (caar x) 'unquote-splicing))
((lambda (d)
(list 'append (car (cdr (car x))) d))
(loop (cdr x)))
((lambda (a d)
(if (pair? d)
(if (eq? (car d) 'quote)
(if (and (pair? a) (eq? (car a) 'quote))
(list 'quote (cons (cadr a) (cadr d)))
(if (null? (cadr d))
(list 'list a)
(list 'cons* a d)))
(if (memq (car d) '(list cons*))
(cons (car d) (cons a (cdr d)))
(list 'cons* a d)))
(list 'cons* a d)))
(loop (car x))
(loop (cdr x)))))))))
(loop x))
(define (caar x) (car (car x)))
(define (cadr x) (car (cdr x)))
(define (cdar x) (cdr (car x)))
(define (cddr x) (cdr (cdr x)))
(define-macro (simple-let bindings . rest)
(cons (cons 'lambda (cons (map car bindings) rest))
(map cadr bindings)))
(define-macro (xsimple-let bindings rest)
`(,`(lambda ,(map car bindings) ,@rest)
,@(map cadr bindings)))
(define-macro (xnamed-let name bindings rest)
`(simple-let ((,name *unspecified*))
(set! ,name (lambda ,(map car bindings) ,@rest))
(,name ,@(map cadr bindings))))
(define-macro (let bindings-or-name . rest)
(if (symbol? bindings-or-name) ;; IF
`(xnamed-let ,bindings-or-name ,(car rest) ,(cdr rest))
`(xsimple-let ,bindings-or-name ,rest)))
(define (expand-let* bindings body)
(if (null? bindings)
`((lambda () ,@body))
`((lambda (,(caar bindings))
,(expand-let* (cdr bindings) body))
,@(cdar bindings))))
(define-macro (let* bindings . body)
(expand-let* bindings body))
(define (equal2? a b)
(if (and (null? a) (null? b)) #t
(if (and (pair? a) (pair? b))
(and (equal2? (car a) (car b))
(equal2? (cdr a) (cdr b)))
(if (and (string? a) (string? b))
(eq? (string->symbol a) (string->symbol b))
(if (and (vector? a) (vector? b))
(equal2? (vector->list a) (vector->list b))
(eq? a b))))))
(define equal? equal2?)
(define (member x lst)
(if (null? lst) #f
(if (equal2? x (car lst)) lst
(member x (cdr lst)))))
(define (<= . rest)
(or (apply < rest)
(apply = rest)))
(define (>= . rest)
(or (apply > rest)
(apply = rest)))
(define (list? x)
(or (null? x)
(and (pair? x) (list? (cdr x)))))
;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software
;;; Copyright (c) 1993-2004 by Richard Kelsey and Jonathan Rees.
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; syntax.mes is loaded after scm.mes. It provides the R5RS hygienic
;;; macros define-syntax, syntax-rules and define-syntax-rule.
;;; syntax-rules is adapted from scheme48-1.1/scheme/alt/syntax.scm
;;; Code:
;;; Copyright (c) 1993-2004 by Richard Kelsey and Jonathan Rees. See file COPYING.
;;; scheme48-1.1/COPYING
;; Copyright (c) 1993-2004 Richard Kelsey and Jonathan Rees
;; All rights reserved.
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 1. Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;; notice, this list of conditions and the following disclaimer in the
;; documentation and/or other materials provided with the distribution.
;; 3. The name of the authors may not be used to endorse or promote products
;; derived from this software without specific prior written permission.
;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
;; IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(cond-expand
(guile)
(mes
(define-macro (define-syntax macro-name transformer . stuff)
`(define-macro (,macro-name . args)
(,transformer (cons ',macro-name args)
(lambda (x0) x0)
eq?)))))
;; Rewrite-rule compiler (a.k.a. "extend-syntax")
;; Example:
;;
;; (define-syntax or
;; (syntax-rules ()
;; ((or) #f)
;; ((or e) e)
;; ((or e1 e ...) (let ((temp e1))
;; (if temp temp (or e ...))))))
(cond-expand
(guile)
(mes
(define-syntax syntax-rules
(let ()
(define name? symbol?)
(define (segment-pattern? pattern)
(and (segment-template? pattern)
(or (null? (cddr pattern))
(syntax-error "segment matching not implemented" pattern))))
(define (segment-template? pattern)
(and (pair? pattern)
(pair? (cdr pattern))
(memq (cadr pattern) indicators-for-zero-or-more)))
(define indicators-for-zero-or-more (list (string->symbol "...") '---))
(lambda (exp r c)
(define %input (r '%input)) ;Gensym these, if you like.
(define %compare (r '%compare))
(define %rename (r '%rename))
(define %tail (r '%tail))
(define %temp (r '%temp))
(define rules (cddr exp))
(define subkeywords (cadr exp))
(define (make-transformer rules)
;;(core:display-error "make-transformer:") (core:write-error rules) (core:display-error "\n")
`(lambda (,%input ,%rename ,%compare)
(let ((,%tail (cdr ,%input)))
(cond ,@(map process-rule rules)
(else
(syntax-error
"use of macro doesn't match definition"
,%input))))))
(define (process-rule rule)
;;(core:display-error "process-rule:") (core:write-error rule) (core:display-error "\n")
(if (and (pair? rule)
(pair? (cdr rule))
(null? (cddr rule)))
(let ((pattern (cdar rule))
(template (cadr rule)))
`((and ,@(process-match %tail pattern))
(let* ,(process-pattern pattern
%tail
(lambda (x) x))
,(process-template template
0
(meta-variables pattern 0 '())))))
(syntax-error "ill-formed syntax rule" rule)))
;; Generate code to test whether input expression matches pattern
(define (process-match input pattern)
;;(core:display-error "process-match:") (core:write-error input) (core:display-error "\n")
;;(core:display-error " pattern:") (core:write-error pattern) (core:display-error "\n")
(cond ((name? pattern)
(if (member pattern subkeywords)
`((,%compare ,input (,%rename ',pattern)))
`()))
((segment-pattern? pattern)
(process-segment-match input (car pattern)))
((pair? pattern)
`((let ((,%temp ,input))
(and (pair? ,%temp)
,@(process-match `(car ,%temp) (car pattern))
,@(process-match `(cdr ,%temp) (cdr pattern))))))
((or (null? pattern) (boolean? pattern) (char? pattern))
`((eq? ,input ',pattern)))
(else
`((equal? ,input ',pattern)))))
(define (process-segment-match input pattern)
;;(core:display-error "process-segment-match:") (core:write-error input) (core:display-error "\n")
;;(core:display-error " pattern:") (core:write-error pattern) (core:display-error "\n")
(let ((conjuncts (process-match '(car l) pattern)))
(if (null? conjuncts)
`((list? ,input)) ;+++
`((let loop ((l ,input))
(or (null? l)
(and (pair? l)
,@conjuncts
(loop (cdr l)))))))))
;; Generate code to take apart the input expression
;; This is pretty bad, but it seems to work (can't say why).
(define (process-pattern pattern path mapit)
;;(core:display-error "process-pattern:") (core:write-error pattern) (core:display-error "\n")
;;(core:display-error " path:") (core:write-error path) (core:display-error "\n")
(cond ((name? pattern)
(if (memq pattern subkeywords)
'()
(list (list pattern (mapit path)))))
((segment-pattern? pattern)
(process-pattern (car pattern)
%temp
(lambda (x) ;temp is free in x
(mapit (if (eq? %temp x)
path ;+++
`(map (lambda (,%temp) ,x)
,path))))))
((pair? pattern)
(append (process-pattern (car pattern) `(car ,path) mapit)
(process-pattern (cdr pattern) `(cdr ,path) mapit)))
(else '())))
;; Generate code to compose the output expression according to template
(define (process-template template rank env)
;;(core:display-error "process-template:") (core:write-error template) (core:display-error "\n")
(cond ((name? template)
(let ((probe (assq template env)))
(if probe
(if (<= (cdr probe) rank)
template
(syntax-error "template rank error (too few ...'s?)"
template))
`(,%rename ',template))))
((segment-template? template)
(let ((vars
(free-meta-variables (car template) (+ rank 1) env '())))
(if (null? vars)
(silent-syntax-error "too many ...'s" template)
(let* ((x (process-template (car template)
(+ rank 1)
env))
(gen (if (equal? (list x) vars)
x ;+++
`(map (lambda ,vars ,x)
,@vars))))
(if (null? (cddr template))
gen ;+++
`(append ,gen ,(process-template (cddr template)
rank env)))))))
((pair? template)
`(cons ,(process-template (car template) rank env)
,(process-template (cdr template) rank env)))
(else `(quote ,template))))
;; Return an association list of (var . rank)
(define (meta-variables pattern rank vars)
;;(core:display-error "meta-variables:") (core:write-error pattern) (core:display-error "\n")
(cond ((name? pattern)
(if (memq pattern subkeywords)
vars
(cons (cons pattern rank) vars)))
((segment-pattern? pattern)
(meta-variables (car pattern) (+ rank 1) vars))
((pair? pattern)
(meta-variables (car pattern) rank
(meta-variables (cdr pattern) rank vars)))
(else vars)))
;; Return a list of meta-variables of given higher rank
(define (free-meta-variables template rank env free)
;;(core:display-error "meta-variables:") (core:write-error template) (core:display-error "\n")
(cond ((name? template)
(if (and (not (memq template free))
(let ((probe (assq template env)))
(and probe (>= (cdr probe) rank))))
(cons template free)
free))
((segment-template? template)
(free-meta-variables (car template)
rank env
(free-meta-variables (cddr template)
rank env free)))
((pair? template)
(free-meta-variables (car template)
rank env
(free-meta-variables (cdr template)
rank env free)))
(else free)))
c ;ignored
;; Kludge for Scheme48 linker.
;; `(cons ,(make-transformer rules)
;; ',(find-free-names-in-syntax-rules subkeywords rules))
(make-transformer rules))))))
(cond-expand
(guile)
(mes
(define-macro (let-syntax bindings . rest)
`((lambda ()
,@(map (lambda (binding)
`(define-macro (,(car binding) . args)
(,(cadr binding) (cons ',(car binding) args)
(lambda (x0) x0)
eq?)))
bindings)
,@rest)))))
(core:display
(let-syntax ((xwhen (syntax-rules ()
((xwhen condition exp ...)
(if (not condition)
(begin exp ...))))))
(xwhen #f 42)))

24
scaffold/boot/data/bar.mes Normal file
View file

@ -0,0 +1,24 @@
;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define-macro (define-module module . rest) #t)
(define-module (ice-9 optargs)
#t)
(core:display-error "bar!\n")

21
scaffold/boot/data/i.scm Normal file
View file

@ -0,0 +1,21 @@
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(core:display "hello i.scm\n")
(define (from-i) "*from-i*")
(define-macro (from-i-macro) "*from-i-macro*")

21
scaffold/boot/data/module.mes Normal file
View file

@ -0,0 +1,21 @@
;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(display "hallo\n")

872
scaffold/cons-mes.c Normal file
View file

@ -0,0 +1,872 @@
/* -*-comment-start: "//";comment-end:""-*-
* Mes --- Maxwell Equations of Software
* Copyright © 2016,2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
*
* This file is part of Mes.
*
* Mes is free software; you can redistribute it and/or modify it
* under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 3 of the License, or (at
* your option) any later version.
*
* Mes is distributed in the hope that it will be useful, but
* WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with Mes. If not, see <http://www.gnu.org/licenses/>.
*/
#if POSIX
#error "POSIX not supported"
#endif
#include <stdio.h>
#include <assert.h>
#include <stdlib.h>
#include <string.h>
#include <mlibc.h>
char arena[2000];
typedef int SCM;
int g_debug = 0;
int g_free = 0;
SCM g_continuations = 0;
SCM g_symbols = 0;
SCM g_stack = 0;
SCM r0 = 0; // a/env
SCM r1 = 0; // param 1
SCM r2 = 0; // save 2+load/dump
SCM r3 = 0; // continuation
enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVECTOR, TBROKEN_HEART};
struct scm {
enum type_t type;
SCM car;
SCM cdr;
};
struct function {
int (*function) (void);
int arity;
char *name;
};
#if __MESC__
struct scm *g_cells = arena;
#else
struct scm *g_cells = (struct scm*)arena;
#endif
#define cell_nil 1
#define cell_f 2
#define cell_t 3
#define cell_dot 4
// #define cell_arrow 5
#define cell_undefined 6
#define cell_unspecified 7
#define cell_closure 8
#define cell_circular 9
#define cell_begin 10
#define cell_symbol_dot 11
#define cell_symbol_lambda 12
#define cell_symbol_begin 13
#define cell_symbol_if 14
#define cell_symbol_quote 15
#define cell_symbol_set_x 16
#define cell_vm_apply 45
#define cell_vm_apply2 46
#define cell_vm_eval 47
#define cell_vm_begin 56
//#define cell_vm_begin_read_input_file 57
#define cell_vm_begin2 58
#define cell_vm_return 63
SCM tmp;
SCM tmp_num;
SCM tmp_num2;
int ARENA_SIZE = 200;
struct function g_functions[5];
int g_function = 0;
SCM make_cell_ (SCM type, SCM car, SCM cdr);
struct function fun_make_cell_ = {&make_cell_,3,"core:make-cell"};
struct scm scm_make_cell_ = {TFUNCTION,0,0};
//, "core:make-cell", 0};
SCM cell_make_cell_;
SCM cons (SCM x, SCM y);
struct function fun_cons = {&cons,2,"cons"};
struct scm scm_cons = {TFUNCTION,0,0};
// "cons", 0};
SCM cell_cons;
SCM car (SCM x);
struct function fun_car = {&car,1,"car"};
struct scm scm_car = {TFUNCTION,0,0};
// "car", 0};
SCM cell_car;
SCM cdr (SCM x);
struct function fun_cdr = {&cdr,1,"cdr"};
struct scm scm_cdr = {TFUNCTION,0,0};
// "cdr", 0};
SCM cell_cdr;
// SCM eq_p (SCM x, SCM y);
// struct function fun_eq_p = {&eq_p,2,"eq?"};
// scm scm_eq_p = {TFUNCTION,0,0};
// SCM cell_eq_p;
#define TYPE(x) (g_cells[x].type)
#define CAR(x) g_cells[x].car
#define LENGTH(x) g_cells[x].car
#define STRING(x) g_cells[x].car
#define CDR(x) g_cells[x].cdr
#define CONTINUATION(x) g_cells[x].cdr
#define FUNCTION(x) g_functions[g_cells[x].cdr]
#define VALUE(x) g_cells[x].cdr
#define VECTOR(x) g_cells[x].cdr
#define MAKE_CHAR(n) make_cell_ (tmp_num_ (TCHAR), 0, tmp_num2_ (n))
#define MAKE_NUMBER(n) make_cell_ (tmp_num_ (TNUMBER), 0, tmp_num2_ (n))
#define CAAR(x) CAR (CAR (x))
#define CADAR(x) CAR (CDR (CAR (x)))
#define CDADAR(x) CAR (CDR (CAR (CDR (x))))
#define CADR(x) CAR (CDR (x))
#define MAKE_STRING(x) make_cell_ (tmp_num_ (TSTRING), x, 0)
SCM
alloc (int n)
{
assert (g_free + n < ARENA_SIZE);
SCM x = g_free;
g_free += n;
return x;
}
SCM
make_cell_ (SCM type, SCM car, SCM cdr)
{
SCM x = alloc (1);
assert (TYPE (type) == TNUMBER);
TYPE (x) = VALUE (type);
if (VALUE (type) == TCHAR || VALUE (type) == TNUMBER) {
if (car) CAR (x) = CAR (car);
if (cdr) CDR(x) = CDR(cdr);
}
else if (VALUE (type) == TFUNCTION) {
if (car) CAR (x) = car;
if (cdr) CDR(x) = CDR(cdr);
}
else {
CAR (x) = car;
CDR(x) = cdr;
}
return x;
}
SCM
tmp_num_ (int x)
{
VALUE (tmp_num) = x;
return tmp_num;
}
SCM
tmp_num2_ (int x)
{
VALUE (tmp_num2) = x;
return tmp_num2;
}
SCM
cons (SCM x, SCM y)
{
VALUE (tmp_num) = TPAIR;
return make_cell_ (tmp_num, x, y);
}
SCM
car (SCM x)
{
return CAR (x);
}
SCM
cdr (SCM x)
{
return CDR(x);
}
SCM
gc_push_frame ()
{
SCM frame = cons (r1, cons (r2, cons (r3, cons (r0, cell_nil))));
g_stack = cons (frame, g_stack);
return g_stack;
}
SCM
append2 (SCM x, SCM y)
{
if (x == cell_nil) return y;
assert (TYPE (x) == TPAIR);
return cons (car (x), append2 (cdr (x), y));
}
SCM
pairlis (SCM x, SCM y, SCM a)
{
if (x == cell_nil)
return a;
if (TYPE (x) != TPAIR)
return cons (cons (x, y), a);
return cons (cons (car (x), car (y)),
pairlis (cdr (x), cdr (y), a));
}
SCM
assq (SCM x, SCM a)
{
while (a != cell_nil && x == CAAR (a)) a = CDR (a);
return a != cell_nil ? car (a) : cell_f;
}
SCM
push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
{
puts ("push cc\n");
SCM x = r3;
r3 = c;
r2 = p2;
gc_push_frame ();
r1 = p1;
r0 = a;
r3 = x;
return cell_unspecified;
}
SCM caar (SCM x) {return car (car (x));}
SCM cadr (SCM x) {return car (cdr (x));}
SCM cdar (SCM x) {return cdr (car (x));}
SCM cddr (SCM x) {return cdr (cdr (x));}
#if __GNUC__
//FIXME
SCM call (SCM,SCM);
SCM gc_pop_frame ();
#endif
SCM
eval_apply ()
{
eval_apply:
switch (r3)
{
case cell_vm_apply: {goto apply;}
case cell_unspecified: {return r1;}
}
SCM x = cell_nil;
SCM y = cell_nil;
apply:
switch (TYPE (car (r1)))
{
case TFUNCTION: {
puts ("apply.function\n");
r1 = call (car (r1), cdr (r1));
goto vm_return;
}
}
vm_return:
x = r1;
gc_pop_frame ();
r1 = x;
goto eval_apply;
}
SCM
call (SCM fn, SCM x)
{
puts ("call\n");
if ((FUNCTION (fn).arity > 0 || FUNCTION (fn).arity == -1)
&& x != cell_nil && TYPE (CAR (x)) == TVALUES)
x = cons (CADAR (x), CDR (x));
if ((FUNCTION (fn).arity > 1 || FUNCTION (fn).arity == -1)
&& x != cell_nil && TYPE (CDR (x)) == TPAIR && TYPE (CADR (x)) == TVALUES)
x = cons (CAR (x), cons (CDADAR (x), CDR (x)));
switch (FUNCTION (fn).arity)
{
case 0: {return (FUNCTION (fn).function) ();}
case 1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (car (x));}
case 2: {return ((SCM(*)(SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x));}
case 3: {return ((SCM(*)(SCM,SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x), car (cddr (x)));}
case -1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);}
}
return cell_unspecified;
}
SCM
gc_peek_frame ()
{
SCM frame = car (g_stack);
r1 = car (frame);
r2 = cadr (frame);
r3 = car (cddr (frame));
r0 = cadr (cddr (frame));
return frame;
}
SCM
gc_pop_frame ()
{
SCM frame = gc_peek_frame (g_stack);
g_stack = cdr (g_stack);
return frame;
}
SCM
mes_g_stack (SCM a) ///((internal))
{
r0 = a;
r1 = MAKE_CHAR (0);
r2 = MAKE_CHAR (0);
r3 = MAKE_CHAR (0);
g_stack = cons (cell_nil, cell_nil);
return r0;
}
// 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);
}
// 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;
}

1261
scaffold/mini-mes.c Normal file
View file

File diff suppressed because it is too large Load diff

2
scaffold/t-0.mes
View file

@ -1,2 +0,0 @@
;;; -*-scheme-*-
(core:display "t00\n")

341
scaffold/tiny-mes.c Normal file
View file

@ -0,0 +1,341 @@
/* -*-comment-start: "//";comment-end:""-*-
* Mes --- Maxwell Equations of Software
* Copyright © 2016,2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
*
* This file is part of Mes.
*
* Mes is free software; you can redistribute it and/or modify it
* under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 3 of the License, or (at
* your option) any later version.
*
* Mes is distributed in the hope that it will be useful, but
* WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with Mes. If not, see <http://www.gnu.org/licenses/>.
*/
#if POSIX
#error "POSIX not supported"
#endif
#include <stdio.h>
#include <mlibc.h>
char arena[300];
typedef int SCM;
SCM g_stack = 0;
SCM r0 = 0; // a/env
SCM r1 = 0; // param 1
SCM r2 = 0; // save 2+load/dump
SCM r3 = 0; // continuation
enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVECTOR, TBROKEN_HEART};
struct scm {
enum type_t type;
SCM car;
SCM cdr;
};
#if __MESC__
struct scm *g_cells = arena;
#else
struct scm *g_cells = (struct scm*)arena;
#endif
#define cell_nil 1
#define cell_f 2
#define cell_t 3
#define TYPE(x) (g_cells[x].type)
#define CAR(x) g_cells[x].car
#define CDR(x) g_cells[x].cdr
#define VALUE(x) g_cells[x].cdr
SCM
car (SCM x)
{
return CAR (x);
}
SCM
cdr (SCM x)
{
return CDR (x);
}
SCM caar (SCM x) {return car (car (x));}
SCM cadr (SCM x) {return car (cdr (x));}
SCM cdar (SCM x) {return cdr (car (x));}
SCM cddr (SCM x) {return cdr (cdr (x));}
SCM
gc_peek_frame ()
{
SCM frame = car (g_stack);
r1 = car (frame);
r2 = cadr (frame);
r3 = car (cddr (frame));
r0 = cadr (cddr (frame));
return frame;
}
// 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;
}

104
tests/base.test
View file

@ -31,69 +31,63 @@ exit $?
(pass-if "first dummy" #t) (pass-if "first dummy" #t)
(pass-if-not "second dummy" #f) (pass-if-not "second dummy" #f)
(pass-if "begin" (seq? (begin 'a 'b (+ 1 2)) 3))
(pass-if "lambda" (symbol? 'lambda)) (pass-if "lambda" (symbol? 'lambda))
(define *top-define-a* '*top-define-a*) (cond-expand
(pass-if "top define " (seq? *top-define-a* '*top-define-a*)) (guile (define append2 append))
(mes))
(begin (define *top-begin-define-a* '*top-begin-define-a*)) (pass-if-equal "append" '(0 1) (append2 '(0) '(1)))
(pass-if "top begin define " (seq? *top-begin-define-a* '*top-begin-define-a*)) (pass-if-equal "append 2" '(0) (append2 '(0) '()))
(pass-if "if" (seq? (if #t 'true) 'true)) (pass-if-equal "append 3" '(0 1 2) (append '(0) '(1) '(2)))
(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 "cond #f" #t (cond (#f #f) (#t #t)))
(pass-if-equal "append 1" '0 (append '() 0)) (pass-if "cond #t" (cond (#t)))
(pass-if-equal "append 2" '(0) (append '(0) '())) (pass-if "cond #f" (cond (#f #f) (#t #t)))
(pass-if-equal "append 3" 0 (append 0)) (pass-if-equal "cond 2" *unspecified* (cond (#f)))
(pass-if-equal "append 4" 'cons (append (cdr '(c)) (car '(cons)))) (pass-if-equal "cond 3" 0 (cond (#t 0)))
(pass-if-equal "append 5" '(0 1 2) (append '(0) '(1) '(2))) (pass-if-equal "cond 3a" 0 (cond (#f 1) (#t 0)))
;;(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" (pass-if-equal "cond side effect"
1 1
(let ((i 0)) ((lambda (i)
(cond ((set! i (1+ i)) i)))) (cond ((set! i (+ i 1)) i)))
0))
(pass-if-equal "cond => " (pass-if-equal "cond => "
0 (let ((lst '(0 1 2))) 0 ((lambda (lst)
(define (next) (define (next)
(let ((r (car lst))) ((lambda (r)
(set! lst (cdr lst)) (set! lst (cdr lst))
r)) r)
(cond ((next) => identity)))))) (car lst)))
(cond ((next) => identity)))
'(0 1 2)))
(pass-if "and" (seq? (and 1) 1)) (pass-if-equal "and" 1 (and 1))
(pass-if "and 2" (seq? (and 1 (= 0 1) #f) #f)) (pass-if-not "and 2" (and 1 (= 0 1) #f))
(pass-if "or" (seq? (or) #f)) (pass-if-not "or" (or))
(pass-if "or 2" (seq? (or 1) 1)) (pass-if-equal "or 2" 1 (or 1))
(pass-if "or 3" (seq? (or #f (= 0 1) 3) 3)) (pass-if-equal "or 3" 3 (or #f (= 0 1) 3))
(pass-if "or 4" (seq? (or (= 0 0) (= 0 1)) #t)) (pass-if "or 4" (or (= 0 0) (= 0 1)))
(pass-if "or 5" (seq? (or (= 0 1) (= 0 0)) #t)) (pass-if "or 5" (or (= 0 1) (= 0 0)))
(pass-if-equal "or only once" (pass-if-equal "or only once"
1 1
(let () ((lambda ()
(define read (define read
(let ((lst '(1 0))) ((lambda (lst)
(lambda () (lambda ()
(let ((r (car lst))) ((lambda (r)
(set! lst (cdr lst)) (set! lst (cdr lst))
r)))) r)
(or (read) #t))) (car lst))))
'(1 0)))
(or (read) #t))))
(pass-if "let" (seq? (let () 0) 0)) (pass-if-eq "let" 0 (let () 0))
(pass-if "let 2" (seq? (let ((x 0)) x) 0)) (pass-if-eq "let 2" 0 (let ((x 0)) x))
(pass-if "let 3" (seq? (let ((p 5) (q 6)) (+ p q)) 11)) (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" (sequal? (apply list '(1)) '(1)))
(pass-if "apply 2" (sequal? (apply list 1 '(2)) '(1 2))) (pass-if "apply 2" (sequal? (apply list 1 '(2)) '(1 2)))
@ -102,17 +96,21 @@ exit $?
(define local-answer 41)) (define local-answer 41))
(pass-if-equal "begin 2" 41 (begin local-answer)) (pass-if-equal "begin 2" 41 (begin local-answer))
(if (not guile?) (pass-if-equal "primitive-load" 42 (primitive-load "tests/data/load.scm") the-answer)
(pass-if-equal "load" 42 (begin (load "tests/data/load.scm") the-answer)))
(pass-if-equal "call/cc" (cond-expand
(guile)
(mes
(pass-if-equal "include" 42 (include "tests/data/load.scm") the-answer)))
(pass-if-eq "call/cc"
0 0
(let ((cont #f) ((lambda (cont seen?)
(seen? #f))
(+ 1 (call/cc (lambda (c) (set! cont c) 1))) (+ 1 (call/cc (lambda (c) (set! cont c) 1)))
(if seen? 0 (if seen? 0
(begin (set! seen? #t) (begin (set! seen? #t)
(cont 2))))) (cont 2))))
#f #f))
(if (not guile?) (if (not guile?)
(pass-if-not "#<eof>" (pass-if-not "#<eof>"

54
tests/boot.test Executable file
View file

@ -0,0 +1,54 @@
#! /bin/sh
# -*-scheme-*-
MES=${MES-$(dirname $0)/../scripts/mes}
echo ' ()' | cat $0 /dev/stdin | $MES $MES_FLAGS "$@"
#paredit:||
exit $?
!#
;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(begin
(primitive-load "module/mes/test.mes"))
;;(mes-use-module (mes test))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if-eq "begin" 3 (begin 'a 'b (+ 1 2)))
(define *top-define-a* '*top-define-a*)
(begin (define *top-begin-define-a* '*top-begin-define-a*))
(pass-if-eq "top define " '*top-define-a* *top-define-a*)
(pass-if "eq?" (eq? 0 '0))
(pass-if-eq "if" 'true (if #t 'true))
(pass-if-eq "if 2" *unspecified* (if #f #f))
(pass-if-eq "if 3" 'true (if #t 'true))
(pass-if-eq "if 4" 'true (if (eq? 0 '0) 'true))
(pass-if-eq "if 5" 'false (if (= 1 2) 'true 'false))
(pass-if-eq "append2 1" '0 (append2 '() 0))
(pass-if-eq "append2 3" 0 (append 0))
(pass-if-eq "append2 4" 'cons (append2 (cdr '(c)) (car '(cons))))
(result 'report)

1
tests/boot.test-guile Symbolic link
View file

@ -0,0 +1 @@
base.test-guile

18
tests/closure.test
View file

@ -9,7 +9,7 @@ exit $?
;;; -*-scheme-*- ;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software ;;; 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. ;;; This file is part of Mes.
;;; ;;;
@ -34,7 +34,8 @@ exit $?
(define b 0) (define b 0)
(define x (lambda () b)) (define x (lambda () b))
(define (x) b) (define (x) b)
(pass-if "closure" (seq? (x) 0)) (pass-if-equal "closure" 0 (x))
(display "===>") (display (x)) (newline)
(define (c b) (define (c b)
(x)) (x))
(pass-if "closure 2" (seq? (c 1) 0)) (pass-if "closure 2" (seq? (c 1) 0))
@ -102,4 +103,17 @@ exit $?
(pass-if-not "closure is not a pair" (pass-if-not "closure is not a pair"
(pair? (lambda () #t))) (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) (result 'report)

8
tests/let-syntax.test
View file

@ -9,7 +9,7 @@ exit $?
;;; -*-scheme-*- ;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software ;;; 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. ;;; This file is part of Mes.
;;; ;;;
@ -34,11 +34,11 @@ exit $?
(pass-if "let-syntax" (pass-if "let-syntax"
(seq? (seq?
(let-syntax ((when (syntax-rules () (let-syntax ((xwhen (syntax-rules ()
((when condition exp ...) ((xwhen condition exp ...)
(if (not condition) (if (not condition)
(begin exp ...)))))) (begin exp ...))))))
(when #f 3)) (xwhen #f 3))
3)) 3))
(pass-if "let-syntax no-leak" (pass-if "let-syntax no-leak"

35
tests/let.test
View file

@ -9,7 +9,7 @@ exit $?
;;; -*-scheme-*- ;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software ;;; 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. ;;; This file is part of Mes.
;;; ;;;
@ -32,32 +32,35 @@ exit $?
(pass-if "first dummy" #t) (pass-if "first dummy" #t)
(pass-if-not "second dummy" #f) (pass-if-not "second dummy" #f)
(let () (define *top-let-a* '*top-let-a*) #f) (pass-if-equal "let " 1
(pass-if "top let " (seq? (and (defined? '*top-let-a*) *top-let-a*) #f)) (let ((x 1)) 1))
(pass-if "let loop" (let () (define *let-define* '*let-define*) #f)
(sequal? (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))) (let loop ((lst '(3 2 1)))
(cond ((null? lst) '()) (cond ((null? lst) '())
(#t (cons (car lst) (loop (cdr lst)))))) (#t (cons (car lst) (loop (cdr lst)))))))
'(3 2 1)))
(pass-if "let* comments" (pass-if-equal "let* comments" 5
(seq? (let* ((aa 2) (let* ((aa 2)
(bb (+ aa 3)) (bb (+ aa 3))
#! boo !# #! boo !#
;;(bb 4) ;;(bb 4)
) )
bb) bb))
5))
(pass-if "letrec" (pass-if-equal "letrec" 24
(seq?
(letrec ((factorial (lambda (n) (letrec ((factorial (lambda (n)
(cond ((= n 1) 1) (cond ((= n 1) 1)
(#t (* n (factorial (- n 1)))))))) (#t (* n (factorial (- n 1))))))))
(factorial 4)) (factorial 4)))
24))
(result 'report) (result 'report)

9
tests/match.test
View file

@ -9,7 +9,7 @@ exit $?
;;; -*-scheme-*- ;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software ;;; 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. ;;; This file is part of Mes.
;;; ;;;
@ -29,9 +29,10 @@ exit $?
(mes-use-module (mes match)) (mes-use-module (mes match))
(mes-use-module (mes test)) (mes-use-module (mes test))
(when guile? (cond-expand
(use-modules (ice-9 match)) (guile
) (use-modules (ice-9 match)))
(mes))
(pass-if "first dummy" #t) (pass-if "first dummy" #t)
(pass-if-not "second dummy" #f) (pass-if-not "second dummy" #f)

6
tests/optargs.test
View file

@ -27,7 +27,6 @@ exit $?
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>. ;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(cond-expand (cond-expand
(guile-2)
(guile (guile
(use-modules (ice-9 optargs))) (use-modules (ice-9 optargs)))
(mes (mes
@ -52,15 +51,12 @@ exit $?
(pass-if-equal "keyword->symbol" 'foo (keyword->symbol #:foo)) (pass-if-equal "keyword->symbol" 'foo (keyword->symbol #:foo))
(pass-if-equal "symbol->keyword" #:foo (symbol->keyword 'foo)) (pass-if-equal "symbol->keyword" #:foo (symbol->keyword 'foo))
(pass-if-not "keywords" (eq? #:foo ':foo)) (pass-if-not "keywords" (eq? #:foo ':foo))
(pass-if "optargs #:optional" ((lambda* (#:optional (x #f)) x) #t)) (pass-if "optargs #:optional" ((lambda* (#:optional (x #f)) x) #t))
(pass-if-equal "optargs #:optional default" #f ((lambda* (#:optional (x #f)) x))) (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 "optargs key" ((lambda* (#:key (foo #f)) foo) #:foo #t))
(pass-if-equal "optargs key default" #f ((lambda* (#:key (foo #f)) foo))) (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 <info> '<info>)
(define <functions> '<functions>) (define <functions> '<functions>)
(define <globals> '<globals>) (define <globals> '<globals>)

11
tests/quasiquote.test
View file

@ -9,7 +9,7 @@ exit $?
;;; -*-scheme-*- ;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software ;;; 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. ;;; This file is part of Mes.
;;; ;;;
@ -53,10 +53,19 @@ exit $?
(pass-if-equal "qq 1" '(list a (quote a)) (pass-if-equal "qq 1" '(list a (quote a))
(let ((name 'a)) (let ((name 'a))
`(list ,name ',name)) ) `(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) (pass-if-equal "qq 2" '(a 3 4 5 6 b)
`(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b)) `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b))
(pass-if-equal "qq 3" '((foo 7) . cons) (pass-if-equal "qq 3" '((foo 7) . cons)
`((foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(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) (pass-if-equal "qq 4" '#(10 5 #t #t #f #f #f 8)
`#(10 5 ,(even? 4) ,@(map even? '(2 3 5 7)) 8)) `#(10 5 ,(even? 4) ,@(map even? '(2 3 5 7)) 8))
;; (pass-if-equal "qq 5" '(foo foo foo) ;; (pass-if-equal "qq 5" '(foo foo foo)

7
tests/record.test
View file

@ -9,7 +9,7 @@ exit $?
;;; -*-scheme-*- ;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software ;;; 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. ;;; This file is part of Mes.
;;; ;;;
@ -26,11 +26,14 @@ exit $?
;;; You should have received a copy of the GNU General Public License ;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>. ;;; 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 (srfi srfi-9))
(mes-use-module (mes test)) (mes-use-module (mes test))
(when guile? (cond-expand
(guile
(use-modules (srfi srfi-9))) (use-modules (srfi srfi-9)))
(mes))
(pass-if "first dummy" #t) (pass-if "first dummy" #t)
(pass-if-not "second dummy" #f) (pass-if-not "second dummy" #f)

12
tests/scm.test
View file

@ -9,7 +9,7 @@ exit $?
;;; -*-scheme-*- ;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software ;;; 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. ;;; This file is part of Mes.
;;; ;;;
@ -49,10 +49,7 @@ exit $?
(pass-if "do" (sequal? (let ((acc '())) (do ((i 0 (+ i 1))) ((>= i 3)) (set! acc (cons i acc))) acc) '(2 1 0))) (pass-if "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" (pass-if-equal "string-length"
0 0
@ -140,4 +137,9 @@ exit $?
(pass-if-equal "compose" 1 ((compose car cdr car) '((0 1 2)))) (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) (result 'report)

Some files were not shown because too many files have changed in this diff Show more