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

View file

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

View file

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

View file

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

View file

@ -26,7 +26,7 @@
(list
'begin
(list core:display "test: ") (list core:display name)
(list result t)))
(list (quote result) t)))
(define-macro (pass-if-eq name expect . 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
;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
(define (map1 f lst)
(define (map f lst)
(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-macro (let bindings . rest)
(cons (cons 'lambda (cons (map1 car bindings) rest))
(map1 cadr bindings)))
(cons (cons 'lambda (cons (map car bindings) rest))
(map cadr bindings)))
(let ((x 0)) x)
(let ((y 0)) y)

View file

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

View file

@ -248,6 +248,15 @@
(or (null? 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-*-
;;; GNU Mes --- Maxwell Equations of Software