From 755beeb7d72087af63f834e99bfe674cec6ed330 Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Fri, 4 Jan 2008 05:47:18 -0500
Subject: [PATCH] uuid and gensym were not generating pretty unique strings. 
 fixed.

---
 scheme/last-revision |  2 +-
 scheme/test64.ss     | 37 +++++++++++++++++++++++++++----------
 src/ikarus-runtime.c | 12 ++++++------
 3 files changed, 34 insertions(+), 17 deletions(-)

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