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) |