uuid and gensym were not generating pretty unique strings. fixed.

This commit is contained in:
Abdulaziz Ghuloum 2008-01-04 05:47:18 -05:00
parent 976694a3ab
commit 755beeb7d7
3 changed files with 34 additions and 17 deletions

View File

@ -1 +1 @@
1323
1324

View File

@ -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))

View File

@ -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;
}