From: Rob Browning <rlb@defaultvalue.org>
Date: Tue, 12 Mar 2002 21:53:56 +0000 (+0000)
Subject: * syncase.scm: fix bad let.
X-Git-Url: https://git.hcoop.net/bpt/guile.git/commitdiff_plain/56fd1933cc51d7e817bc0a1b515da8629c9c892f

* syncase.scm: fix bad let.
(gensym): fix failure on non-threaded
---

diff --git a/ice-9/syncase.scm b/ice-9/syncase.scm
index dc8c321c7..1a2cc01c4 100644
--- a/ice-9/syncase.scm
+++ b/ice-9/syncase.scm
@@ -160,17 +160,36 @@
 ;;
 (define gensym
   (let ((counter 0))
+
+    (define next-id
+      (if (provided? 'threads)
+          (let ((symlock (make-mutex)))
+            (lambda ()
+              (let ((result #f))
+                (with-mutex symlock
+                  (set! result counter)
+                  (set! counter (+ counter 1)))
+                result)))
+          ;; faster, non-threaded case.
+          (lambda ()
+            (let ((result counter))
+              (set! counter (+ counter 1))
+              result))))
+    
+    ;; actual gensym body code.
     (lambda (. rest)
-      (let ((val (number->string counter)))
-        (set! counter (+ counter 1))
-        (cond
-         ((null? rest)
-          (string->symbol (string-append "syntmp-" val)))
-         ((null? (cdr rest))
-          (string->symbol (string-append "syntmp-" (car rest) "-" val)))
-         (else
-          (error
-           "syncase's gensym called with the wrong number of arguments")))))))
+      (let* ((next-val (next-id))
+             (valstr (number->string next-val)))
+          (cond
+           ((null? rest)
+            (string->symbol (string-append "syntmp-" valstr)))
+           ((null? (cdr rest))
+            (string->symbol (string-append "syntmp-" (car rest) "-" valstr)))
+           (else
+            (error
+             (string-append
+              "syncase's gensym expected 0 or 1 arguments, got "
+              (length rest)))))))))
 
 ;;; Load the preprocessed code