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

22
collects/mzlib/unit.ss
View File

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