conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Passed tests-1.6 in 64-bit mode.

This commit is contained in:
Abdulaziz Ghuloum 2008-01-04 05:54:35 -05:00
parent 755beeb7d7
commit 069ff811e2
3 changed files with 12 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
scheme/ikarus.boot.prebuilt
View File

Binary file not shown.

2
scheme/last-revision
View File

@ -1 +1 @@
1324 1325

21
scheme/test64.ss
View File

@ -21,8 +21,6 @@
(except (ikarus) assembler-output)) (except (ikarus) assembler-output))
(define (compile1 x) (define (compile1 x)
(printf "Compiling:\n")
(pretty-print x)
(let ([p (open-file-output-port "test64.fasl" (file-options no-fail))]) (let ([p (open-file-output-port "test64.fasl" (file-options no-fail))])
(parameterize ([assembler-output #t]) (parameterize ([assembler-output #t])
(compile-core-expr-to-port x p)) (compile-core-expr-to-port x p))
@ -36,7 +34,9 @@
(lambda () (get-string-all (current-input-port)))))) (lambda () (get-string-all (current-input-port))))))
(define (compile-test-and-run expr expected) (define (compile-test-and-run expr expected)
(let ([val (compile-and-run expr)]) (printf "Compiling:\n")
(pretty-print expr)
(let ([val (compile-and-run (fixup expr))])
(unless (equal? val expected) (unless (equal? val expected)
(error 'compile-test-and-run "failed:got:expected" val expected)))) (error 'compile-test-and-run "failed:got:expected" val expected))))
@ -91,6 +91,7 @@
[(,rator ,[rand*] ...) [(,rator ,[rand*] ...)
(guard (assq rator env)) (guard (assq rator env))
`(,(Expr rator env) ,rand* ...)] `(,(Expr rator env) ,rand* ...)]
[(quote ,x) `(quote ,x)]
[(,prim ,[args] ...) [(,prim ,[args] ...)
(guard (assq prim prims-alist)) (guard (assq prim prims-alist))
`((primitive ,(cadr (assq prim prims-alist))) ,args ...)] `((primitive ,(cadr (assq prim prims-alist))) ,args ...)]
@ -111,15 +112,13 @@
[(_ name [test => string] ...) [(_ name [test => string] ...)
#'(set! all-tests #'(set! all-tests
(append all-tests (append all-tests
(list '([test string] ...)))])))
(list (fixup 'test) string)
...)))])))
;(include "tests/tests-1.1-req.scm") (include "tests/tests-1.1-req.scm")
;(include "tests/tests-1.2-req.scm") (include "tests/tests-1.2-req.scm")
;(include "tests/tests-1.3-req.scm") (include "tests/tests-1.3-req.scm")
;(include "tests/tests-1.4-req.scm") (include "tests/tests-1.4-req.scm")
;(include "tests/tests-1.5-req.scm") (include "tests/tests-1.5-req.scm")
(include "tests/tests-1.6-req.scm") (include "tests/tests-1.6-req.scm")
(test-all) (test-all)