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

Do the let so that (hopefully) the contract errors will get reported on the

Browse Source 
identifier.  With a small change in scheme/contract, it does, but even with
this, it doesn't seem to.  How odd.

svn: r12760

original commit: 90ad3f9221a9b5c31a673dcc820304e7b6c86872
This commit is contained in:
Stevie Strickland 2008-12-09 23:16:48 +00:00
parent d9d718daa8
commit bee6f21c4d
1 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/mzlib/unit.ss
View File

@ -451,10 +451,11 @@
(define-for-syntax process-unit-export (define-for-syntax process-unit-export
(process-unit-import/export process-tagged-export)) (process-unit-import/export process-tagged-export))
(define-for-syntax (make-import-unboxing loc ctc name) (define-for-syntax (make-import-unboxing var loc ctc name)
(if ctc (if ctc
(quasisyntax/loc (error-syntax) (quasisyntax/loc (error-syntax)
(quote-syntax (contract #,ctc (unbox #,loc) 'cant-happen '#,name))) (quote-syntax (let ([#,var (unbox #,loc)])
(contract #,ctc #,var 'cant-happen '#,name))))
(quasisyntax/loc (error-syntax) (quasisyntax/loc (error-syntax)
(quote-syntax (unbox #,loc))))) (quote-syntax (unbox #,loc)))))
@ -538,8 +539,9 @@
(quasisyntax/loc (error-syntax) (quasisyntax/loc (error-syntax)
[#,ivs [#,ivs
(make-id-mappers (make-id-mappers
#,@(map (lambda (l c) #,@(map (lambda (v l c)
(make-import-unboxing l c #'name)) (make-import-unboxing v l c #'name))
(syntax->list ivs)
(syntax->list ils) (syntax->list ils)
ics))])) ics))]))
(syntax->list #'((int-ivar ...) ...)) (syntax->list #'((int-ivar ...) ...))
@ -1220,11 +1222,13 @@
(map (map
(lambda (os ov) (lambda (os ov)
(map (map
(lambda (i c) (lambda (i iv c)
(if c (if c
#`(contract #,c (unbox (vector-ref #,ov #,i)) 'cant-happen (#%variable-reference)) #`(let ([#,iv (unbox (vector-ref #,ov #,i))])
(contract #,c #,iv 'cant-happen (#%variable-reference)))
#`(unbox (vector-ref #,ov #,i)))) #`(unbox (vector-ref #,ov #,i))))
(iota (length (car os))) (iota (length (car os)))
(map car (car os))
(cadddr os))) (cadddr os)))
out-sigs out-sigs
out-vec))) out-vec)))