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

Okay, let's try using the "internal" names instead of the "external", which

Browse Source 
might make some errors more obvious.

svn: r13141

original commit: bd802748e03c3434195279056f4223b94ddfc48f
This commit is contained in:
Stevie Strickland 2009-01-15 05:32:46 +00:00
parent f5961b496a
commit 650f7a3219
1 changed files with 9 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/mzlib/unit.ss
View File

@ -471,12 +471,12 @@
(define-syntax-parameter current-unit-blame-stx (lambda (stx) #'(#%variable-reference))) (define-syntax-parameter current-unit-blame-stx (lambda (stx) #'(#%variable-reference)))
(define-for-syntax (make-import-unboxing ext-var loc ctc) (define-for-syntax (make-import-unboxing var loc ctc)
(if ctc (if ctc
(quasisyntax/loc (error-syntax) (quasisyntax/loc (error-syntax)
(quote-syntax (contract #,ctc (unbox #,loc) 'cant-happen (quote-syntax (contract #,ctc (unbox #,loc) 'cant-happen
(current-unit-blame-stx) (current-unit-blame-stx)
#,(id->contract-src-info ext-var)))) #,(id->contract-src-info var))))
(quasisyntax/loc (error-syntax) (quasisyntax/loc (error-syntax)
(quote-syntax (unbox #,loc))))) (quote-syntax (unbox #,loc)))))
@ -564,17 +564,16 @@
(let-values ([(iloc ...) (let-values ([(iloc ...)
(vector->values (hash-table-get import-table import-key) 0 icount)] (vector->values (hash-table-get import-table import-key) 0 icount)]
...) ...)
(letrec-syntaxes (#,@(map (lambda (ivs evs ils ics) (letrec-syntaxes (#,@(map (lambda (ivs ils ics)
(quasisyntax/loc (error-syntax) (quasisyntax/loc (error-syntax)
[#,ivs [#,ivs
(make-id-mappers (make-id-mappers
#,@(map (lambda (ev l c) #,@(map (lambda (iv l c)
(make-import-unboxing ev l c)) (make-import-unboxing iv l c))
(syntax->list evs) (syntax->list ivs)
(syntax->list ils) (syntax->list ils)
ics))])) ics))]))
(syntax->list #'((int-ivar ...) ...)) (syntax->list #'((int-ivar ...) ...))
(syntax->list #'((ext-ivar ...) ...))
(syntax->list #'((iloc ...) ...)) (syntax->list #'((iloc ...) ...))
(map cadddr import-sigs))) (map cadddr import-sigs)))
(letrec-syntaxes+values (renames ... (letrec-syntaxes+values (renames ...
@ -583,7 +582,6 @@
(unit-body #,(error-syntax) (unit-body #,(error-syntax)
(int-ivar ... ...) (int-ivar ... ...)
(int-evar ... ...) (int-evar ... ...)
(ext-evar ... ...)
(eloc ... ...) (eloc ... ...)
(ectc ... ...) (ectc ... ...)
. body))))) . body)))))
@ -601,7 +599,7 @@
(define-syntax (unit-body stx) (define-syntax (unit-body stx)
(syntax-case stx () (syntax-case stx ()
((_ err-stx ivars evars ext-evars elocs ectcs body ...) ((_ err-stx ivars evars elocs ectcs body ...)
(parameterize ((error-syntax #'err-stx)) (parameterize ((error-syntax #'err-stx))
(let* ([expand-context (generate-expand-context)] (let* ([expand-context (generate-expand-context)]
[def-ctx (syntax-local-make-definition-context)] [def-ctx (syntax-local-make-definition-context)]
@ -682,7 +680,7 @@
;; Mark exported names and ;; Mark exported names and
;; check that all exported names are defined (as var): ;; check that all exported names are defined (as var):
(for-each (for-each
(lambda (name loc var ctc) (lambda (name loc ctc)
(let ([v (bound-identifier-mapping-get defined-names-table (let ([v (bound-identifier-mapping-get defined-names-table
name name
(lambda () #f))]) (lambda () #f))])
@ -696,10 +694,9 @@
v v
(λ (e) (λ (e)
#`(contract #,(cdr (syntax-e ctc)) #,e (current-unit-blame-stx) #`(contract #,(cdr (syntax-e ctc)) #,e (current-unit-blame-stx)
'cant-happen #,(id->contract-src-info var))))))) 'cant-happen #,(id->contract-src-info e)))))))
(syntax->list (localify #'evars def-ctx)) (syntax->list (localify #'evars def-ctx))
(syntax->list #'elocs) (syntax->list #'elocs)
(syntax->list #'ext-evars)
(syntax->list #'ectcs)) (syntax->list #'ectcs))
;; Check that none of the imports are defined ;; Check that none of the imports are defined