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:
parent
eff35b8a54
commit
44f8117886
|
@ -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>)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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))))
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue