From b00810360b89126d14f8d15626ac7b39c1c852cf Mon Sep 17 00:00:00 2001 From: chrdimo Date: Mon, 28 Jan 2013 16:56:32 -0500 Subject: [PATCH] fixing backwards compatibility problems for blame-positive and blame-negative --- collects/racket/contract/private/blame.rkt | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/collects/racket/contract/private/blame.rkt b/collects/racket/contract/private/blame.rkt index 1585772593..0b8a3bf48c 100644 --- a/collects/racket/contract/private/blame.rkt +++ b/collects/racket/contract/private/blame.rkt @@ -4,8 +4,8 @@ (provide blame? (rename-out [-make-blame make-blame]) blame-source - blame-positive - blame-negative + (rename-out [show-blame-positive blame-positive]) + (rename-out [show-blame-negative blame-negative]) blame-contract blame-value blame-original? @@ -104,6 +104,15 @@ [positive (append extra-positive pos)] [negative (append extra-negative neg)]))) +(define (show-blame accessor) + (λ (blm) + (let ([info (accessor blm)]) + (cond [(empty? (rest info)) (first info)] + [else info])))) + +(define show-blame-positive (show-blame blame-positive)) + +(define show-blame-negative (show-blame blame-negative)) (define (blame-swapped? b) (not (blame-original? b)))