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

Changed to be more like what Sam and I envisioned.

Browse Source 
svn: r13039
This commit is contained in:
Stevie Strickland 2009-01-08 20:50:33 +00:00
parent d5f0b90981
commit bf0d872afd
1 changed files with 54 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
collects/mzlib/unit.ss
View File

@ -558,12 +558,7 @@
(syntax->list #'((int-ivar ...) ...))
(syntax->list #'((ext-ivar ...) ...))
(syntax->list #'((iloc ...) ...))
(map cadddr import-sigs))
[(int-evar ...)
(make-id-mappers
(quote-syntax (unbox eloc))
...)]
...)
(map cadddr import-sigs)))
(letrec-syntaxes+values (renames ...
mac ... ...)
(val ... ...)
@ -703,27 +698,25 @@
(var-info-id defid)))))
local-ivars)
(with-syntax ([(intname ...)
(foldr
(lambda (var res)
(cond
((not (or (var-info-syntax? (cdr var))
(var-info-exported? (cdr var))))
(cons (car var) res))
(else res)))
null
(bound-identifier-mapping-map defined-names-table cons))]
[(evar ...) #'evars]
[(l-evar ...) local-evars]
[(defn&expr ...)
(filter
values
(with-syntax ([(defn&expr ...)
(apply
append
(map (lambda (defn-or-expr)
(syntax-case defn-or-expr (define-values define-syntaxes)
[(define-values () expr)
(syntax/loc defn-or-expr (set!-values () expr))]
defn-or-expr]
[(define-values ids expr)
(let ([ids (syntax->list #'ids)]
(let* ([ids (syntax->list #'ids)]
[tmps (generate-temporaries ids)]
[new-defn (quasisyntax/loc defn-or-expr
(define-values #,(map (lambda (id tmp)
(if (var-info-exported?
(bound-identifier-mapping-get
defined-names-table
id))
tmp
id))
ids tmps) expr))]
[do-one
(lambda (id tmp name)
(let ([unit-name
@ -741,45 +734,29 @@
(cond
(export-loc
;; set! exported id:
(list
(quasisyntax/loc defn-or-expr
(set-box! #,export-loc
#,(if name
#`(let ([#,name #,(if add-ctc (add-ctc tmp) tmp)])
#,name)
tmp))))
tmp)))
(quasisyntax/loc defn-or-expr
(define-syntax #,id (make-id-mapper (quote-syntax #,tmp))))))
(else
;; not an exported id
(quasisyntax/loc defn-or-expr
(set! #,id #,tmp))))))])
null))))])
(if (null? (cdr ids))
(do-one (car ids) (syntax expr) (car ids))
(let ([tmps (generate-temporaries ids)])
(with-syntax ([(tmp ...) tmps]
[(set ...)
(cons new-defn (do-one (car ids) (car tmps) (car ids)))
(cons new-defn (apply append
(map (lambda (id tmp)
(do-one id tmp #f))
ids tmps)])
(syntax/loc defn-or-expr
(let-values ([(tmp ...) expr])
set ...))))))]
[(define-syntaxes . l) #f]
[else defn-or-expr]))
expanded-body))]
[(stx-defn ...)
(filter
values
(map (lambda (defn-or-expr)
(syntax-case defn-or-expr (define-syntaxes)
[(define-syntaxes . l) #'l]
[else #f]))
ids tmps)))))]
[else (list defn-or-expr)]))
expanded-body))])
#'(letrec-syntaxes+values (stx-defn
...
((l-evar) (make-rename-transformer (quote-syntax evar)))
...)
([(intname) undefined] ...)
(void) ; in case the body would be empty
defn&expr ...)))))))
#'(begin-with-definitions
defn&expr ...
(void))))))))
(define-for-syntax (redirect-imports/exports import?)
(lambda (table-stx