suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

.

Browse Source 
original commit: 2503c4e601c16f84017786e60dbc08de12f8bdf9
This commit is contained in:
Matthew Flatt 2001-06-12 17:11:08 +00:00
parent 5df811527a
commit 2cf0bb9bba
1 changed files with 14 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/mzlib/unit.ss
View File

@ -247,13 +247,19 @@
all-expanded))]) all-expanded))])
;; Build up set! redirection chain: ;; Build up set! redirection chain:
(with-syntax ([redirections (with-syntax ([redirections
(let ([varlocs
(syntax->list
(syntax ((ivar iloc) ... (expname eloc) ...)))])
(with-syntax ([vars (map stx-car varlocs)]
[rhss
(map (map
(lambda (varloc) (lambda (varloc)
(with-syntax ([(var loc) varloc]) (with-syntax ([(var loc) varloc])
(syntax (syntax
[var (make-id-mapper (quote-syntax (unbox loc)))]))) (make-id-mapper (quote-syntax (unbox loc))))))
(syntax->list varlocs)])
(syntax ((ivar iloc) ... (expname eloc) ...))))] (syntax
([vars (values . rhss)]))))]
[num-imports (datum->syntax-object [num-imports (datum->syntax-object
(quote-syntax here) (quote-syntax here)
(length (syntax->list (syntax (iloc ...)))) (length (syntax->list (syntax (iloc ...))))
@ -269,7 +275,7 @@
(list (vector eloc ...) (list (vector eloc ...)
(lambda (iloc ...) (lambda (iloc ...)
(let ([intname undefined] ...) (let ([intname undefined] ...)
(letrec-syntax redirections (letrec-syntaxes redirections
(void) ; in case the body would be empty (void) ; in case the body would be empty
defn&expr ...))))))))))))))))))]))) defn&expr ...))))))))))))))))))])))