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

cpvalid: obey enable-error-source-expression

Browse Source 
original commit: 45af7f62cfe9b0f77bb2c58e49c7543b9603458b
This commit is contained in:
Matthew Flatt 2019-12-05 16:41:47 -07:00
parent 4b61c87227
commit 71072b7221
3 changed files with 32 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
s/cpvalid.ss
View File

@ -194,25 +194,32 @@
(lambda (what maybe-src id p x)
(if (and p (not (eq? (proxy-state p) 'protected)))
(let ([valid-flag (prelex-info-valid-flag id)])
(if valid-flag
(let ([name (prelex-name id)])
(let ([mesg (format "attempt to ~a undefined variable ~~s" what)])
(when (undefined-variable-warnings)
($source-warning #f maybe-src #t (format "possible ~a" mesg) name))
(if (prelex-referenced valid-flag)
(set-prelex-multiply-referenced! valid-flag #t)
(set-prelex-referenced! valid-flag #t))
`(seq
(if (ref #f ,valid-flag)
(quote ,(void))
(call ,(make-preinfo-call) ,(lookup-primref 2 '$source-violation)
(quote #f)
(quote ,maybe-src)
(quote #t)
(quote ,mesg)
(quote ,name)))
,x)))
x))
(cond
[valid-flag
(if (prelex-referenced valid-flag)
(set-prelex-multiply-referenced! valid-flag #t)
(set-prelex-referenced! valid-flag #t))
(if (enable-error-source-expression)
(let ([name (prelex-name id)])
(let ([mesg (format "attempt to ~a undefined variable ~~s" what)])
(when (undefined-variable-warnings)
($source-warning #f maybe-src #t (format "possible ~a" mesg) name))
`(seq
(if (ref #f ,valid-flag)
(quote ,(void))
(call ,(make-preinfo-call) ,(lookup-primref 2 '$source-violation)
(quote #f)
(quote ,maybe-src)
(quote #t)
(quote ,mesg)
(quote ,name)))
,x)))
`(seq
(if (ref #f ,valid-flag)
(quote ,(void))
(call ,(make-preinfo-call) ,(lookup-primref 2 '$unknown-undefined-violation)))
,x))]
[else x]))
x))))
; wl = worklist

5
s/exceptions.ss
View File

@ -706,6 +706,11 @@ TODO:
(error-help #f who #f message #f
(condition (make-undefined-violation) (make-syntax-violation id #f)))))
(set-who! $unknown-undefined-violation
(lambda ()
(error-help #f who #f "undefined" #f
(make-undefined-violation))))
(set-who! $lexical-error
(case-lambda
[(whoarg msg args port ir?)

1
s/primdata.ss
View File

@ -2311,6 +2311,7 @@
($unbound-object [sig [() -> (ptr)]] [flags pure unrestricted mifoldable true])
($uncprep [flags single-valued]) ; side-effects preinfo-sexpr, at least
($undefined-violation [flags abort-op])
($unknown-undefined-violation [flags abort-op])
($untrace [flags single-valued])
($unwrap-ftype-pointer [flags single-valued])
($value [sig [(ptr) -> (ptr)]] [flags pure unrestricted discard cp02])