From 570a3e58b9e82a50a35466a17cd293e1df74f6bc Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sat, 9 Apr 2011 20:11:16 -0500 Subject: [PATCH] renamed parametric/c to parametric->/c and cleaned up the organization of the related files --- collects/racket/contract.rkt | 2 ++ .../contract/{ => private}/parametric.rkt | 29 +++++++++++++------ .../scribblings/reference/contracts.scrbl | 20 ++++++------- .../typed-scheme/private/type-contract.rkt | 4 +-- 4 files changed, 33 insertions(+), 22 deletions(-) rename collects/racket/contract/{ => private}/parametric.rkt (75%) diff --git a/collects/racket/contract.rkt b/collects/racket/contract.rkt index 1a7408ccbc..cf6e34a523 100644 --- a/collects/racket/contract.rkt +++ b/collects/racket/contract.rkt @@ -7,9 +7,11 @@ "contract/private/legacy.rkt" "contract/private/ds.rkt" "contract/private/opt.rkt" + "contract/private/parametric.rkt" "private/define-struct.rkt") (provide (all-from-out "contract/base.rkt") + (all-from-out "contract/private/parametric.rkt") (except-out (all-from-out racket/contract/exists) ∀∃?) (all-from-out racket/contract/regions) diff --git a/collects/racket/contract/parametric.rkt b/collects/racket/contract/private/parametric.rkt similarity index 75% rename from collects/racket/contract/parametric.rkt rename to collects/racket/contract/private/parametric.rkt index 823877ea60..7193eda990 100644 --- a/collects/racket/contract/parametric.rkt +++ b/collects/racket/contract/private/parametric.rkt @@ -1,13 +1,24 @@ #lang racket/base -(require racket/bool - racket/contract) -(provide parametric/c) +(require "guts.rkt" + "prop.rkt" + "blame.rkt" + (for-syntax racket/base)) +(provide parametric->/c) -(define-syntax-rule (parametric/c [x ...] c) - (make-polymorphic-contract 'parametric/c - opaque/c - '(x ...) - (lambda (x ...) c))) +(define-syntax (parametric->/c stx) + (syntax-case stx () + [(_ [x ...] c) + (begin + (for ([x (in-list (syntax->list #'(x ...)))]) + (unless (identifier? x) + (raise-syntax-error 'parametric->/c + "expected an identifier" + stx + x))) + #'(make-polymorphic-contract 'parametric->/c + opaque/c + '(x ...) + (lambda (x ...) c)))])) (define-struct polymorphic-contract [title barrier vars body] #:property prop:contract @@ -63,7 +74,7 @@ #:projection (lambda (c) (lambda (b) - (if (boolean=? (blame-original? b) (barrier-contract-positive? c)) + (if (equal? (blame-original? b) (barrier-contract-positive? c)) (lambda (x) ((barrier-contract-make c) x)) (lambda (x) diff --git a/collects/scribblings/reference/contracts.scrbl b/collects/scribblings/reference/contracts.scrbl index b27caf6f5c..ff3ea2a451 100644 --- a/collects/scribblings/reference/contracts.scrbl +++ b/collects/scribblings/reference/contracts.scrbl @@ -1,12 +1,11 @@ #lang scribble/doc @(require "mz.rkt") -@(require (for-label syntax/modcollapse - racket/contract/parametric)) +@(require (for-label syntax/modcollapse)) @(define contract-eval (lambda () (let ([the-eval (make-base-eval)]) - (the-eval '(require racket/contract racket/contract/parametric)) + (the-eval '(require racket/contract)) the-eval))) @title[#:tag "contracts" #:style 'toc]{Contracts} @@ -789,25 +788,24 @@ be blamed using the above contract: @subsection[#:tag "parametric-contracts"]{Parametric Contracts} -@defmodule[racket/contract/parametric] - -@defform[(parametric/c (x ...) c)]{ +@defform[(parametric->/c (x ...) c)]{ Creates a contract for parametric polymorphic functions. Each function is protected by @racket[c], where each @racket[x] is bound in @racket[c] and refers to a polymorphic type that is instantiated each time the function is applied. -At each application of a function, the @racket[parametric/c] contract constructs +At each application of a function, the @racket[parametric->/c] contract constructs a new opaque wrapper for each @racket[x]; values flowing into the polymorphic function (i.e. values protected by some @racket[x] in negative position with -respect to @racket[parametric/c]) are wrapped in the corresponding opaque +respect to @racket[parametric->/c]) are wrapped in the corresponding opaque wrapper. Values flowing out of the polymorphic function (i.e. values protected -by some @racket[x] in positive position with respect to @racket[parametric/c]) +by some @racket[x] in positive position with respect to @racket[parametric->/c]) are checked for the appropriate wrapper. If they have it, they are unwrapped; -if they do not, a contract violation is signalled. +if they do not, a contract violation is signaled. @examples[#:eval (contract-eval) -(define/contract (check x y) (parametric/c [X] (boolean? X . -> . X)) +(define/contract (check x y) + (parametric->/c [X] (boolean? X . -> . X)) (if (or (not x) (equal? y 'surprise)) 'invalid y)) diff --git a/collects/typed-scheme/private/type-contract.rkt b/collects/typed-scheme/private/type-contract.rkt index 5f0713252a..20bda229ca 100644 --- a/collects/typed-scheme/private/type-contract.rkt +++ b/collects/typed-scheme/private/type-contract.rkt @@ -14,7 +14,7 @@ (private parse-type) racket/match unstable/match syntax/struct syntax/stx mzlib/trace racket/syntax scheme/list (only-in scheme/contract -> ->* case-> cons/c flat-rec-contract provide/contract any/c) - (for-template scheme/base scheme/contract racket/contract/parametric (utils any-wrap) + (for-template scheme/base racket/contract (utils any-wrap) (only-in scheme/class object% is-a?/c subclass?/c object-contract class/c init object/c class?))) (define (define/fixup-contract? stx) @@ -207,7 +207,7 @@ (with-syntax ([(v ...) (generate-temporaries vs-nm)]) (parameterize ([vars (append (map list vs (syntax->list #'(v ...))) (vars))]) - #`(parametric/c (v ...) #,(t->c b))))))] + #`(parametric->/c (v ...) #,(t->c b))))))] [(Mu: n b) (match-let ([(Mu-name: n-nm _) ty]) (with-syntax ([(n*) (generate-temporaries (list n-nm))])