make parameter/c return impersonator contracts by default (but have an option to

return chaperones if the arguments are chaperones)

possibly related to racket/racket#3852

pkgs/racket-doc/scribblings/reference/contracts.scrbl

@@ -797,13 +797,22 @@ inspect the entire tree.
 @history[#:changed "6.0.1.6" @elem{Added @racket[#:inv].}]
 }
 
-@defproc[(parameter/c [in contract?] [out contract? in])
+@defproc[(parameter/c [in contract?]
+                      [out contract? in]
+                      [#:impersonator? impersonator? any/c #t])
          contract?]{
 
 Produces a contract on parameters whose values must match
 @racket[_out]. When the value in the contracted parameter
 is set, it must match @racket[_in].
 
+ If @racket[impersonator?] is a true value, then
+ @racket[parameter/c] always returns an @tech{impersonator
+ contract}. If it is @racket[#f], then the result will be a
+ @tech{chaperone contract} when both @racket[in] and
+ @racket[out] are @tech{chaperone contracts}, and an @tech{
+  impersonator contract} otherwise.
+
 @examples[#:eval (contract-eval) #:once
 (define/contract current-snack
   (parameter/c string?)

pkgs/racket-test/tests/racket/contract/parameter.rkt

@@ -80,12 +80,26 @@
    'parameter/c11
    '(chaperone-contract?
      (parameter/c integer?))
+   #f)
+
+  (test/spec-passed/result
+   'parameter/c11b
+   '(chaperone-contract?
+     (parameter/c integer?
+                  #:impersonator? #f))
    #t)
 
   (test/spec-passed/result
    'parameter/c12
    '(chaperone-contract?
      (parameter/c (-> integer? integer?)))
+   #f)
+
+  (test/spec-passed/result
+   'parameter/c12b
+   '(chaperone-contract?
+     (parameter/c (-> integer? integer?)
+                  #:impersonator? #f))
    #t)
   
   (test/spec-passed/result
@@ -111,7 +125,15 @@
 
   (test/spec-passed/result
    'parameter/c16
+   '(chaperone-contract?
+     (parameter/c integer?
+                  (-> integer? integer?)
+                  #:impersonator? #f))
+   #t)
+
+  (test/spec-passed/result
+   'parameter/c16b
    '(chaperone-contract?
      (parameter/c integer?
                   (-> integer? integer?)))
-   #t))
+   #f))

racket/collects/racket/contract/private/misc.rkt

@@ -464,23 +464,21 @@
 
 ;; (parameter/c in/out-ctc)
 ;; (parameter/c in-ctc out-ctc)
-(define/subexpression-pos-prop parameter/c
+(define unsupplied (gensym))
-  (case-lambda
+(define/subexpression-pos-prop (parameter/c in [out unsupplied] #:impersonator? [impersonator? #t])
-    [(in-ctc)
+  (define ctc (coerce-contract 'parameter/c in))
-     (define ctc (coerce-contract 'parameter/c in-ctc))
+  (define in-ctc (coerce-contract 'parameter/c in))
-     (cond
+  (define out-ctc/f
-       [(chaperone-contract? ctc)
+    (if (equal? out unsupplied)
-        (chaperone-parameter/c ctc #f)]
+        #f
-       [else
+        (coerce-contract 'parameter/c out)))
-        (impersonator-parameter/c ctc #f)])]
+  (cond
-    [(in-ctc out-ctc)
+    [(and (not impersonator?)
-     (define in (coerce-contract 'parameter/c in-ctc))
+          (chaperone-contract? in-ctc)
-     (define out (coerce-contract 'parameter/c out-ctc))
+          (or (not out-ctc/f) (chaperone-contract? out-ctc/f)))
-     (cond
+     (chaperone-parameter/c in-ctc out-ctc/f)]
-       [(and (chaperone-contract? in) (chaperone-contract? out))
+    [else
-        (chaperone-parameter/c in out)]
+     (impersonator-parameter/c in-ctc out-ctc/f)]))
-       [else
-        (impersonator-parameter/c in out)])]))
 
 (define (parameter/c-lnp ctc)
   (define in-proc (get/build-late-neg-projection (base-parameter/c-in ctc)))