/[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.18.2.5 by rlb, Sun Mar 3 20:37:41 2002 UTC revision 1.18.2.6 by rlb, Mon Mar 4 14:53:35 2002 UTC
# Line 170  Line 170 
170    (let ((counter 0)    (let ((counter 0)
171          (symlock (make-mutex)))          (symlock (make-mutex)))
172      (lambda (. rest)      (lambda (. rest)
173        (lock-mutex symlock)        (let ((counter-val #f))
174        (let* ((val (number->string counter))          (lock-mutex symlock)
175               (result          (set! counter-val counter)
176                (set! counter (+ counter 1))          (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  
                 'bad-args))))  
177          (unlock-mutex symlock)          (unlock-mutex symlock)
178          (if (eq? result 'bad-args)          (let* ((valstr (number->string counter-val)))
179              (error            (cond
180               "syncase's gensym called with the wrong number of arguments")             ((null? rest)
181              result)))))              (string->symbol (string-append "syntmp-" valstr)))
182                     ((null? (cdr rest))
183                (string->symbol (string-append "syntmp-" (car rest) "-" valstr)))
184               (else
185                (if (eq? result 'bad-args)
186                    (error
187                     (string-append
188                      "syncase's gensym expected 0 or 1 arguments, got "
189                      (length rest)))))))))))
190    
191  ;;; Load the preprocessed code  ;;; Load the preprocessed code
192    
193  (let ((old-debug #f)  (let ((old-debug #f)

Legend:
Removed from v.1.18.2.5  
changed lines
  Added in v.1.18.2.6

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