From 2f065df88786e77f4681919edb27742ad2ac596f Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Tue, 3 Mar 2009 02:00:31 +0000 Subject: [PATCH] Instead of just using the quoted versions of the contracts, actually evaluate them, with signature elements rewritten to quoted versions of the same, so that we get a better result for the name of the contract used by contract errors. svn: r13903 --- collects/mzlib/private/unit-contract.ss | 26 +++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/collects/mzlib/private/unit-contract.ss b/collects/mzlib/private/unit-contract.ss index 66d2a583b3..58e4b5e9bb 100644 --- a/collects/mzlib/private/unit-contract.ss +++ b/collects/mzlib/private/unit-contract.ss @@ -122,6 +122,10 @@ (with-syntax ([(isig ...) isig] [(esig ...) esig] + [((import-id ...) ...) + (map (λ (sig) (map car (car sig))) import-sigs)] + [((export-id ...) ...) + (map (λ (sig) (map car (car sig))) export-sigs)] [((import-key ...) ...) (map tagged-info->keys import-tagged-infos)] [((export-key ...) ...) @@ -139,12 +143,30 @@ (cons 'import (list (cons 'isig (map list (list 'i.x ...) - (build-compound-type-name 'i.c ...))) + (let-syntax ([import-id + (make-set!-transformer + (λ (stx) + (syntax-case stx (set!) + [(id . x) + #'(list 'import-id . x)] + [id + (identifier? #'id) + #''import-id])))] ...) + (build-compound-type-name i.c ...)))) ...)) (cons 'export (list (cons 'esig (map list (list 'e.x ...) - (build-compound-type-name 'e.c ...))) + (let-syntax ([export-id + (make-set!-transformer + (λ (stx) + (syntax-case stx (set!) + [(id . x) + #'(list 'export-id . x)] + [id + (identifier? #'id) + #''export-id])))] ...) + (build-compound-type-name e.c ...)))) ...))) (λ (pos neg src-info name) (λ (unit-tmp)