diff --git a/scheme/last-revision b/scheme/last-revision index f011551..82e3624 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1323 +1324 diff --git a/scheme/test64.ss b/scheme/test64.ss index c74b8d5..1c2b878 100755 --- a/scheme/test64.ss +++ b/scheme/test64.ss @@ -21,7 +21,8 @@ (except (ikarus) assembler-output)) (define (compile1 x) - (printf "Compiling ~s\n" x) + (printf "Compiling:\n") + (pretty-print x) (let ([p (open-file-output-port "test64.fasl" (file-options no-fail))]) (parameterize ([assembler-output #t]) (compile-core-expr-to-port x p)) @@ -80,14 +81,29 @@ (define (fixup x) - (match x - [,n (guard (self-evaluating? n)) `(quote ,n)] - [(,prim ,[args] ...) - (guard (assq prim prims-alist)) - `((primitive ,(cadr (assq prim prims-alist))) ,args ...)] - [(if ,[e0] ,[e1] ,[e2]) - `(if ,e0 ,e1 ,e2)] - [,_ (error 'fixup "invalid expression" _)])) + (define (Expr x env) + (match x + [,n (guard (self-evaluating? n)) `(quote ,n)] + [,var (guard (symbol? var)) + (cond + [(assq var env) => cdr] + [else (error 'fixup "unbound var" var)])] + [(,rator ,[rand*] ...) + (guard (assq rator env)) + `(,(Expr rator env) ,rand* ...)] + [(,prim ,[args] ...) + (guard (assq prim prims-alist)) + `((primitive ,(cadr (assq prim prims-alist))) ,args ...)] + [(if ,[e0] ,[e1] ,[e2]) + `(if ,e0 ,e1 ,e2)] + [(let ([,lhs* ,[rhs*]] ...) ,body) + (let ([nlhs* (map gensym lhs*)]) + (let ([env (append (map cons lhs* nlhs*) env)]) + `((case-lambda + [,nlhs* ,(Expr body env)]) + ,rhs* ...)))] + [,_ (error 'fixup "invalid expression" _)])) + (Expr x '())) (define-syntax add-tests-with-string-output (lambda (x) @@ -103,7 +119,8 @@ ;(include "tests/tests-1.2-req.scm") ;(include "tests/tests-1.3-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") (test-all) (printf "Passed ~s tests\n" (length all-tests)) diff --git a/src/ikarus-runtime.c b/src/ikarus-runtime.c index 29aed13..6abc22b 100644 --- a/src/ikarus-runtime.c +++ b/src/ikarus-runtime.c @@ -530,7 +530,7 @@ char* ik_uuid(char* str){ static const char* uuid_chars = "!$%&/0123456789<=>?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"; static int uuid_strlen = 1; -ikptr ik_uuid(ikptr str){ +ikptr ik_uuid(ikptr bv){ static int fd = -1; if(fd == -1){ fd = open("/dev/urandom", O_RDONLY); @@ -539,16 +539,16 @@ ikptr ik_uuid(ikptr str){ } uuid_strlen = strlen(uuid_chars); } - long int n = unfix(ref(str, off_bytevector_length)); - char* data = (char*)(long)(str+off_bytevector_data); + long int n = unfix(ref(bv, off_bytevector_length)); + unsigned char* data = (unsigned char*)(long)(bv+off_bytevector_data); read(fd, data, n); - char* p = data; - char* q = data + n; + unsigned char* p = data; + unsigned char* q = data + n; while(p < q){ *p = uuid_chars[*p % uuid_strlen]; p++; } - return str; + return bv; }