/[guile]/guile/guile-core/ice-9/syncase.scm
ViewVC logotype

Diff of /guile/guile-core/ice-9/syncase.scm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.21 by rlb, Mon Feb 25 05:49:05 2002 UTC revision 1.22 by rlb, Tue Mar 12 21:53:56 2002 UTC
# Line 160  Line 160 
160  ;;  ;;
161  (define gensym  (define gensym
162    (let ((counter 0))    (let ((counter 0))
163    
164        (define next-id
165          (if (provided? 'threads)
166              (let ((symlock (make-mutex)))
167                (lambda ()
168                  (let ((result #f))
169                    (with-mutex symlock
170                      (set! result counter)
171                      (set! counter (+ counter 1)))
172                    result)))
173              ;; faster, non-threaded case.
174              (lambda ()
175                (let ((result counter))
176                  (set! counter (+ counter 1))
177                  result))))
178        
179        ;; actual gensym body code.
180      (lambda (. rest)      (lambda (. rest)
181        (let ((val (number->string counter)))        (let* ((next-val (next-id))
182          (set! counter (+ counter 1))               (valstr (number->string next-val)))
183          (cond            (cond
184           ((null? rest)             ((null? rest)
185            (string->symbol (string-append "syntmp-" val)))              (string->symbol (string-append "syntmp-" valstr)))
186           ((null? (cdr rest))             ((null? (cdr rest))
187            (string->symbol (string-append "syntmp-" (car rest) "-" val)))              (string->symbol (string-append "syntmp-" (car rest) "-" valstr)))
188           (else             (else
189            (error              (error
190             "syncase's gensym called with the wrong number of arguments")))))))               (string-append
191                  "syncase's gensym expected 0 or 1 arguments, got "
192                  (length rest)))))))))
193    
194  ;;; Load the preprocessed code  ;;; Load the preprocessed code
195    

Legend:
Removed from v.1.21  
changed lines
  Added in v.1.22

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26