original commit: ebcb81ce7419824a540b50a86742538e225cff6c
This commit is contained in:
Matthew Flatt 2001-02-10 14:18:47 +00:00
parent 1a90e665b5
commit f90ee6c074
2 changed files with 26 additions and 23 deletions

View File

@ -0,0 +1,23 @@
(module unitidmap mzscheme
(define (make-id-mapper unbox-stx)
(let ([set!-stx (datum->syntax 'set! #f unbox-stx)])
(set!-expander
(lambda (sstx)
(cond
[(identifier? sstx) unbox-stx]
[(module-identifier=? set!-stx (car (syntax-e sstx)))
(raise-syntax-error
'unit
"cannot set! imported or exported variables"
sstx)]
[else
(datum->syntax
(cons unbox-stx (cdr (syntax-e sstx)))
sstx
set!-stx)])))))
(export make-id-mapper))

View File

@ -2,7 +2,8 @@
;; Unit system
(module unit mzscheme
(import-for-syntax (lib "kerncase.ss" "syntax"))
(import-for-syntax (lib "kerncase.ss" "syntax")
"private/unitidmap.ss")
(define undefined (letrec ([x x]) x))
@ -233,28 +234,7 @@
(lambda (varloc)
(with-syntax ([(var loc) varloc])
(syntax
[var
(set!-expander
(lambda (sstx)
;; Avoiding syntax-case and other complex macros
;; here is a useful optimization, because
;; the expression below is expanded for every
;; imported and exported identifier.
(cond
[(identifier? sstx) (quote-syntax (unbox loc))]
[(module-identifier=?
(quote-syntax set!)
(car (syntax-e sstx)))
(raise-syntax-error
'unit
"cannot set! imported or exported variables"
sstx)]
[else
(datum->syntax
(cons (quote-syntax (unbox loc))
(cdr (syntax-e sstx)))
sstx
(quote-syntax here))])))])))
[var (make-id-mapper (quote-syntax (unbox loc)))])))
(syntax->list
(syntax ((ivar iloc) ... (expname eloc) ...))))]
[num-imports (datum->syntax