mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-05 11:40:20 +02:00
Code Activity

* syncase.scm (gensym): fix bad let.

Browse source
This commit is contained in:
Rob Browning 2002-03-04 14:53:35 +00:00
parent 2d17159f2e
commit 4d1c1da728
1 changed files with 17 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

33
ice-9/syncase.scm
View file

@ -170,23 +170,24 @@
(let ((counter 0) (let ((counter 0)
(symlock (make-mutex))) (symlock (make-mutex)))
(lambda (. rest) (lambda (. rest)
(lock-mutex symlock) (let ((counter-val #f))
(let* ((val (number->string counter)) (lock-mutex symlock)
(result (set! counter-val counter)
(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))))
(unlock-mutex symlock) (unlock-mutex symlock)
(if (eq? result 'bad-args) (let* ((valstr (number->string counter-val)))
(error (cond
"syncase's gensym called with the wrong number of arguments") ((null? rest)
result))))) (string->symbol (string-append "syntmp-" valstr)))
((null? (cdr rest))
(string->symbol (string-append "syntmp-" (car rest) "-" valstr)))
(else
(if (eq? result 'bad-args)
(error
(string-append
"syncase's gensym expected 0 or 1 arguments, got "
(length rest)))))))))))
;;; Load the preprocessed code ;;; Load the preprocessed code
(let ((old-debug #f) (let ((old-debug #f)