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