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

Hide make-blame; remove blame-positive and blame-negative; make blame objects transparent (but allow equal?).

Browse Source 
svn: r17907
This commit is contained in:
Carl Eastlund 2010-01-31 01:47:48 +00:00
parent f8df3608d4
commit bf308563d2
1 changed files with 18 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/scheme/contract/private/blame.ss
View File

@ -9,8 +9,6 @@
blame-innocent blame-innocent
blame-contract blame-contract
blame-value blame-value
blame-positive
blame-negative
blame-swapped? blame-swapped?
blame-swap blame-swap
@ -18,9 +16,26 @@
current-blame-format current-blame-format
(struct-out exn:fail:contract:blame)) (struct-out exn:fail:contract:blame))
(define (blame=? a b equal?/recur)
(and (equal?/recur (blame-guilty a) (blame-guilty b))
(equal?/recur (blame-innocent a) (blame-innocent b))
(equal?/recur (blame-contract a) (blame-contract b))
(equal?/recur (blame-value a) (blame-value b))
(equal?/recur (blame-source a) (blame-source b))
(equal?/recur (blame-swapped? a) (blame-swapped? b))))
(define (blame-hash b hash/recur)
(bitwise-xor (hash/recur (blame-guilty b))
(hash/recur (blame-innocent b))
(hash/recur (blame-contract b))
(hash/recur (blame-value b))
(hash/recur (blame-source b))
(hash/recur (blame-swapped? b))))
(define-struct blame (define-struct blame
[source value contract positive negative swapped?] [source value contract positive negative swapped?]
#:transparent) #:property prop:equal+hash
(list blame=? blame-hash blame-hash))
(define (blame-guilty b) (define (blame-guilty b)
(if (blame-swapped? b) (if (blame-swapped? b)