moved unstable/poly-c to racket/contract/parametric

collects/racket/contract/parametric.rkt

@@ -1,14 +1,7 @@
 #lang racket/base
-
+(require racket/bool
-(require racket/bool racket/contract)
+         racket/contract)
-
+(provide parametric/c)
-(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)))
 
 (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))

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.}
-

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)

collects/unstable/scribblings/poly-c.scrbl

@@ -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.
-
-}

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"]