test: Resurrect running boot tests on Guile.

* module/mes/guile.scm (keyword->string): New function.
* scaffold/boot/43-or.scm (foo): Add quoting.
* scaffold/boot/45-pass-if.scm (pass-if): Likewise.
* scaffold/boot/46-report.scm (pass-if): Likewise.
* scaffold/boot/47-pass-if-eq.scm (pass-if): Likewise.
* scaffold/boot/48-let.scm (map): Rename from map1.
* scaffold/boot/60-let-syntax-expanded.scm: Some work.
This commit is contained in:
Jan Nieuwenhuizen 2019-05-27 22:57:44 +02:00
parent eff35b8a54
commit 44f8117886
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
8 changed files with 20 additions and 10 deletions

View file

@ -47,6 +47,7 @@
core:type core:type
%compiler %compiler
equal2? equal2?
keyword->string
pmatch-car pmatch-car
pmatch-cdr pmatch-cdr
) )
@ -85,6 +86,7 @@
(define <cell:vector> 15) (define <cell:vector> 15)
(define %compiler "gnuc") (define %compiler "gnuc")
(define keyword->string (compose symbol->string keyword->symbol))
(define (core:type x) (define (core:type x)
(cond ((guile:keyword? x) <cell:keyword>) (cond ((guile:keyword? x) <cell:keyword>)

View file

@ -28,7 +28,7 @@
(or #t a)) (or #t a))
(define-macro (foo bar) (define-macro (foo bar)
(list f bar)) (list 'f bar))
(foo 3) (foo 3)

View file

@ -26,6 +26,6 @@
(list (list
'begin 'begin
(list core:display "test: ") (list core:display name) (list core:display "test: ") (list core:display name)
(list result t))) (list (quote result) t)))
(pass-if "first dummy" #t) (pass-if "first dummy" #t)

View file

@ -54,7 +54,7 @@
(list (list
'begin 'begin
(list display "test: ") (list display name) (list display "test: ") (list display name)
(list result t))) (list (quote result) t)))
(pass-if "first dummy" #t) (pass-if "first dummy" #t)

View file

@ -26,7 +26,7 @@
(list (list
'begin 'begin
(list core:display "test: ") (list core:display name) (list core:display "test: ") (list core:display name)
(list result t))) (list (quote result) t)))
(define-macro (pass-if-eq name expect . body) (define-macro (pass-if-eq name expect . body)
(list 'pass-if name (list eq? expect (cons 'begin body)))) (list 'pass-if name (list eq? expect (cons 'begin body))))

View file

@ -16,15 +16,15 @@
;;; 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 GNU Mes. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
(define (map1 f lst) (define (map f lst)
(if (null? lst) (list) (if (null? lst) (list)
(cons (f (car lst)) (map1 f (cdr lst))))) (cons (f (car lst)) (map f (cdr lst)))))
(define (cadr x) (car (cdr x))) (define (cadr x) (car (cdr x)))
(define-macro (let bindings . rest) (define-macro (let bindings . rest)
(cons (cons 'lambda (cons (map1 car bindings) rest)) (cons (cons 'lambda (cons (map car bindings) rest))
(map1 cadr bindings))) (map cadr bindings)))
(let ((x 0)) x) (let ((x 0)) x)
(let ((y 0)) y) (let ((y 0)) y)

View file

@ -17,8 +17,7 @@
;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
(cond-expand (cond-expand
(guile (guile)
(set! %load-path (append %load-path '("mes/module"))))
(mes (mes
(define (cons* . rest) (define (cons* . rest)
(if (null? (cdr rest)) (car rest) (if (null? (cdr rest)) (car rest)

View file

@ -248,6 +248,15 @@
(or (null? x) (or (null? x)
(and (pair? x) (list? (cdr x))))) (and (pair? x) (list? (cdr x)))))
(cond-expand
(guile)
(mes
(define (boolean? x)
(or (eq? x #f) (eq? x #t)))
(define (char? x)
(and (eq? (core:type x) <cell:char>)
(> (char->integer x) -1)))))
;; -*-scheme-*- ;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software ;;; GNU Mes --- Maxwell Equations of Software