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

Fixing the negative blame associated with provide/contracted identifiers.

Browse Source 
The contract system now keeps track of three points of blame: the positive
blame, assigned to the provider of a contracted value; the negative blame,
assigned to the receiver of a contracted value; and the user "blame",
assigned to the party that actually misuses the value.  While the latter
is not really blame, as blame is not assigned to that party when that party
is not either the negative or positive party, it's useful information for
programmers when debugging.

For provide/contract, the negative party should be the first module to
require an identifier provided via provide/contract.  What was previously
the negative party is really the user, and is now handled as such.
This commit is contained in:
Stevie Strickland 2010-05-18 18:45:34 -04:00
parent 3fd5c49172
commit bb798b4ba5
1 changed files with 28 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/racket/contract/private/provide.rkt
View File

@ -38,6 +38,32 @@
(current-inspector) #f '(0))])
make-))
(define (first-requiring-module id self)
(define (resolved-module-path->module-path rmp)
(cond
[(not rmp) 'top-level]
[(path? (resolved-module-path-name rmp))
`(file ,(path->string (resolved-module-path-name rmp)))]
[(symbol? (resolved-module-path-name rmp))
`(module ,(resolved-module-path-name rmp))]))
;; Here we get the module-path-index corresponding to the identifier.
;; We know we can split it at least once, because the contracted identifier
;; we've provided must have been required. If the second returned value is #f,
;; we just fall back on the old behavior. If we split again without getting
;; either "self", that is, the first value returned is not #f, then we should
;; use the second mpi result as the module that required the value.
(let ([mpi (syntax-source-module id)])
(let*-values ([(first-mp second-mpi)
(module-path-index-split mpi)]
[(second-mp third-mpi)
(if second-mpi
(module-path-index-split second-mpi)
(values #f #f))])
(if second-mp
(resolved-module-path->module-path
(module-path-index-resolve second-mpi))
self))))
(define-for-syntax (make-provide/contract-transformer contract-id id external-id pos-module-source)
(make-set!-transformer
(let ([saved-id-table (make-hasheq)])
@ -52,21 +78,13 @@
(with-syntax ([contract-id contract-id]
[id id]
[external-id external-id]
[pos-module-source pos-module-source]
[id-ref (syntax-case stx (set!)
[(set! whatever e)
id] ;; just avoid an error here, signal the error later
[(id . x)
#'id]
[id
(identifier? #'id)
#'id])])
[pos-module-source pos-module-source])
(syntax-local-introduce
(syntax-local-lift-expression
#`(contract contract-id
id
pos-module-source
(quote-module-path)
(first-requiring-module (quote-syntax id) (quote-module-path))
'external-id
(quote-srcloc id))))))])
(when key