From f49412add8363db39de28f579add722094e21cb7 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Thu, 7 Apr 2011 13:45:43 -0600 Subject: [PATCH] moved unstable/poly-c to racket/contract/parametric --- .../contract/parametric.rkt} | 20 +--- .../scribblings/reference/contracts.scrbl | 38 +++++++- .../typed-scheme/private/type-contract.rkt | 2 +- collects/unstable/scribblings/poly-c.scrbl | 95 ------------------- collects/unstable/scribblings/unstable.scrbl | 1 - 5 files changed, 39 insertions(+), 117 deletions(-) rename collects/{unstable/poly-c.rkt => racket/contract/parametric.rkt} (82%) delete mode 100644 collects/unstable/scribblings/poly-c.scrbl diff --git a/collects/unstable/poly-c.rkt b/collects/racket/contract/parametric.rkt similarity index 82% rename from collects/unstable/poly-c.rkt rename to collects/racket/contract/parametric.rkt index ff94778a12..823877ea60 100644 --- a/collects/unstable/poly-c.rkt +++ b/collects/racket/contract/parametric.rkt @@ -1,14 +1,7 @@ #lang racket/base - -(require racket/bool racket/contract) - -(provide poly/c parametric/c opaque/c memory/c) - -(define-syntax-rule (poly/c [x ...] c) - (make-polymorphic-contract 'poly/c - memory/c - '(x ...) - (lambda (x ...) c))) +(require racket/bool + racket/contract) +(provide parametric/c) (define-syntax-rule (parametric/c [x ...] c) (make-polymorphic-contract 'parametric/c @@ -57,13 +50,6 @@ [(a b c d e f g h) ((wrap p) a b c d e f g h)] [args (apply (wrap p) args)]))))))) -(define (memory/c positive? name) - (define memory (make-weak-hasheq)) - (define (make x) (hash-set! memory x #t) x) - (define (pred x) (hash-has-key? memory x)) - (define (get x) x) - (make-barrier-contract name positive? make pred get)) - (define (opaque/c positive? name) (define-values [ type make pred getter setter ] (make-struct-type name #f 1 0)) diff --git a/collects/scribblings/reference/contracts.scrbl b/collects/scribblings/reference/contracts.scrbl index 12e967d465..b27caf6f5c 100644 --- a/collects/scribblings/reference/contracts.scrbl +++ b/collects/scribblings/reference/contracts.scrbl @@ -1,11 +1,12 @@ #lang scribble/doc @(require "mz.rkt") -@(require (for-label syntax/modcollapse)) +@(require (for-label syntax/modcollapse + racket/contract/parametric)) @(define contract-eval (lambda () (let ([the-eval (make-base-eval)]) - (the-eval '(require racket/contract)) + (the-eval '(require racket/contract racket/contract/parametric)) the-eval))) @title[#:tag "contracts" #:style 'toc]{Contracts} @@ -785,6 +786,38 @@ be blamed using the above contract: @racket[the-unsupplied-arg]. } + +@subsection[#:tag "parametric-contracts"]{Parametric Contracts} + +@defmodule[racket/contract/parametric] + +@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 +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 +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]) +are checked for the appropriate wrapper. If they have it, they are unwrapped; +if they do not, a contract violation is signalled. + +@examples[#:eval (contract-eval) +(define/contract (check x y) (parametric/c [X] (boolean? X . -> . X)) + (if (or (not x) (equal? y 'surprise)) + 'invalid + y)) +(check #t 'ok) +(check #f 'ignored) +(check #t 'surprise) +] +} + + @; ------------------------------------------------------------------------ @section{Lazy Data-structure Contracts} @@ -1840,4 +1873,3 @@ defines the @racket[bst/c] contract that checks the binary search tree invariant. Removing the @racket[-opt/c] also makes a binary search tree contract, but one that is (approximately) 20 times slower.} - diff --git a/collects/typed-scheme/private/type-contract.rkt b/collects/typed-scheme/private/type-contract.rkt index de55679545..5f0713252a 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 unstable/poly-c (utils any-wrap) + (for-template scheme/base scheme/contract racket/contract/parametric (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) diff --git a/collects/unstable/scribblings/poly-c.scrbl b/collects/unstable/scribblings/poly-c.scrbl deleted file mode 100644 index 55090d6c6f..0000000000 --- a/collects/unstable/scribblings/poly-c.scrbl +++ /dev/null @@ -1,95 +0,0 @@ -#lang scribble/manual -@(require scribble/eval - "utils.rkt" - (for-label unstable/poly-c - racket/contract - racket/base)) - -@title[#:tag "poly-c"]{Polymorphic Contracts} - -@(define (build-eval) - (let* ([e (make-base-eval)]) - (e '(require unstable/poly-c racket/contract)) - e)) - -@defmodule[unstable/poly-c] - -@unstable[@author+email["Sam Tobin-Hochstadt" "samth@ccs.neu.edu"] - @author+email["Carl Eastlund" "cce@ccs.neu.edu"]] - -@defform[(poly/c (x ...) c)]{ - -Creates a contract for polymorphic functions that may inspect their arguments. -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[poly/c] contract constructs a new -weak, @racket[eq?]-based hash table 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[poly/c]) are stored in the hash table. Values -flowing out of the polymorphic function (i.e. protected by some @racket[x] in -positive position with respect to @racket[poly/c]) are checked for their -presence in the hash table. If they are present, they are returned; otherwise, -a contract violation is signalled. - -@examples[#:eval (build-eval) -(define/contract (check x y) (poly/c [X] (boolean? X . -> . X)) - (if (or (not x) (equal? y 'surprise)) - 'invalid - y)) -(check #t 'ok) -(check #f 'ignored) -(check #t 'surprise) -] - -} - -@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 -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 -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]) -are checked for the appropriate wrapper. If they have it, they are unwrapped; -if they do not, a contract violation is signalled. - -@examples[#:eval (build-eval) -(define/contract (check x y) (parametric/c [X] (boolean? X . -> . X)) - (if (or (not x) (equal? y 'surprise)) - 'invalid - y)) -(check #t 'ok) -(check #f 'ignored) -(check #t 'surprise) -] - -} - -@defproc[(memory/c [positive? boolean?] [name any/c]) contract?]{ - -This function constructs a contract that records values flowing in one direction -in a fresh, weak hash table, and looks up values flowing in the other direction, -signalling a contract violation if those values are not in the table. - -If @racket[positive?] is true, values in positive position get stored and values -in negative position are checked. Otherwise, the reverse happens. - -} - -@defproc[(opaque/c [positive? boolean?] [name any/c]) contract?]{ - -This function constructs a contract that wraps values flowing in one direction -in a unique, opaque wrapper, and unwraps values flowing in the other direction, -signalling a contract violation if those values are not wrapped. - -If @racket[positive?] is true, values in positive position get wrapped and -values in negative position get unwrapped. Otherwise, the reverse happens. - -} diff --git a/collects/unstable/scribblings/unstable.scrbl b/collects/unstable/scribblings/unstable.scrbl index b8f49297fa..800383df14 100644 --- a/collects/unstable/scribblings/unstable.scrbl +++ b/collects/unstable/scribblings/unstable.scrbl @@ -97,7 +97,6 @@ Keep documentation and tests up to date. @include-section["text.scrbl"] @include-section["values.scrbl"] @include-section["web.scrbl"] -@include-section["poly-c.scrbl"] @include-section["mutated-vars.scrbl"] @include-section["find.scrbl"] @include-section["class-iop.scrbl"]