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
|
||||
%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>)
|
||||
|
|
|
@ -28,7 +28,7 @@
|
|||
(or #t a))
|
||||
|
||||
(define-macro (foo bar)
|
||||
(list f bar))
|
||||
(list 'f bar))
|
||||
|
||||
(foo 3)
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -54,7 +54,7 @@
|
|||
(list
|
||||
'begin
|
||||
(list display "test: ") (list display name)
|
||||
(list result t)))
|
||||
(list (quote result) t)))
|
||||
|
||||
(pass-if "first dummy" #t)
|
||||
|
||||
|
|
|
@ -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))))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue