prop:chaperone-contract and recursive-contract interact unexpectedly creating a nonsensical chaperone error

[dented42]

What version of Racket are you using?
e.g., 8.11.1 [cs]

What program did you run?
The following chaperone contract is made following the tutorial in the racket guide, at which point I noticed the bug and then simplified it as much as possible while still being able to trigger the bug.

#lang racket

(struct range-arrow (range)
  #:property prop:chaperone-contract
  (build-chaperone-contract-property
   #:late-neg-projection
   (λ (arr)
     (let* ([range-ctc (get/build-late-neg-projection (range-arrow-range arr))])
       (λ (blame)
         (λ (f neg-party)
           (chaperone-procedure f
                                (λ (arg)
                                  (values
                                         (λ (answer)
                                           ((range-ctc blame) answer neg-party))
                                         arg)))))))))

(define seq/c (or/c null? (cons/c any/c (recursive-contract seq/c))))

(define (run-plain f) (f 'yay))

(define/contract run-good1 (-> (-> any/c (-> seq/c)) any/c) run-plain)
(define/contract run-good2 (-> (-> any/c (-> (listof any/c))) any/c) run-plain)
(define/contract run-good3 (-> (-> any/c (-> list?)) any/c) run-plain)

(define/contract run-bad (-> (range-arrow (-> seq/c)) any/c) run-plain)

((run-plain (λ (a) (λ () (list a))))) ; => '(yay)

((run-good1 (λ (a) (λ () (list a))))) ; => '(yay)
((run-good2 (λ (a) (λ () (list a))))) ; => '(yay)
((run-good3 (λ (a) (λ () (list a))))) ; => '(yay)

((run-bad (λ (a) (λ () (list a))))) ; => weird error

What should have happened?
We should get the value '(yay) printed five times.

If you got an error message, please include it here.

procedure-result chaperone: non-chaperone result; received an argument that is not a chaperone of the original argument
  original: #<procedure:.../μrackanren/tmp.rkt:34:17>
  received: #<procedure:.../μrackanren/tmp.rkt:34:17>

Please include any other relevant details
It looks like the procedure being passed to the range-list-arrow contract is not being chaperoned correctly? Based on how the run-good examples work as expected, it seems to be an unintended interaction between the recursive nature of seq/c and the custom contract.

[LiberalArtist]

If you add:

  #:guard (λ (range name)
            (coerce-chaperone-contract 'range-arrow range))

to the definition of range-arrow, you will get this more useful error:

range-arrow: contract violation
  expected: chaperone-contract?
  given: (-> (or/c '() (cons/c any/c (recursive-contract seq/c))))

(You should also always use coerce-{chaperone-,flat-,}contract because e.g. (get/build-late-neg-projection 'i-am-a-contract) will not work: you need e.g. (get/build-late-neg-projection (coerce-contract 'who 'i-am-a-contract)).)

The documentation for recursive-contract explains that it creates an impersonator contract unless #:chaperone or #:flat is given. By using #:flat, you can fix your program:

#lang racket

(struct range-arrow (range)
  #:guard (λ (range name)
            (coerce-chaperone-contract 'range-arrow range))
  #:property prop:chaperone-contract
  (build-chaperone-contract-property
   #:late-neg-projection
   (λ (arr)
     (let* ([range-ctc (get/build-late-neg-projection (range-arrow-range arr))])
       (λ (blame)
         (λ (f neg-party)
           (chaperone-procedure f
                                (λ (arg)
                                  (values
                                         (λ (answer)
                                           ((range-ctc blame) answer neg-party))
                                         arg)))))))))

(define seq/c (or/c null? (cons/c any/c (recursive-contract seq/c #:flat))))

(define (run-plain f) (f 'yay))

(define/contract run-good1 (-> (-> any/c (-> seq/c)) any/c) run-plain)
(define/contract run-good2 (-> (-> any/c (-> (listof any/c))) any/c) run-plain)
(define/contract run-good3 (-> (-> any/c (-> list?)) any/c) run-plain)

(define/contract run-bad (-> (range-arrow (-> seq/c)) any/c) run-plain)

((run-plain (λ (a) (λ () (list a))))) ; => '(yay)

((run-good1 (λ (a) (λ () (list a))))) ; => '(yay)
((run-good2 (λ (a) (λ () (list a))))) ; => '(yay)
((run-good3 (λ (a) (λ () (list a))))) ; => '(yay)

((run-bad (λ (a) (λ () (list a))))) ; => '(yay)

[dented42]

@LiberalArtist Thank you for your suggestions, unfortunately neither of them are applicable for my actual contract combinator but posting ~450 lines of code (including tests) seemed like a bad idea so I simplified it as much as possible while still generating the same error. Specifically seq/c also has a promise/c in it which prevents it from being flat, and the instantiations of my combinator are guarded by coerce-contract.

It turns out that telling recursive-contract to be a #:chaperone fixes the issue in my project, but my bug is more that following the steps in the Racket Guide (https://docs.racket-lang.org/guide/Building_New_Contracts.html) combined with another chaperone contract lead to a seemingly nonsensical error message. I think there should be a less confusing error message (or removed completely if the error is itself erroneous), and possibly that the guide should mention this kind of trouble so that future Racketeers are less confused than I was.

[LiberalArtist]

my bug is more that following the steps in the Racket Guide … combined with another chaperone contract lead to a seemingly nonsensical error message

The problem was that in your example, (define seq/c (or/c null? (cons/c any/c (recursive-contract seq/c)))) (without #:flat or #:chaperone) wasn't "another chaperone contract", so (-> seq/c) also was not a chaperone contract, so ((range-ctc blame) answer neg-party) produced an impersonator of answer that was not a chaperone of answer. Thus, the result-wrapping procedure returned from the wrapper supplied to chaperone-procedure was faulty, so chaperone-procedure reported the error.

Admittedly,

procedure-result chaperone: non-chaperone result; received an argument that is not a chaperone of the original argument
  original: #<procedure:.../μrackanren/tmp.rkt:34:17>
  received: #<procedure:.../μrackanren/tmp.rkt:34:17>

is a very cryptic error message (and the ; should be followed by "\n " to follow the formatting guidelines). It is particularly difficult to report a good error because the printed representations are identical. One improvement would for the error message to detect and report when received is a non-chaperone impersonator of original.

That error message is constructed for BC at

racket/racket/src/bc/src/error.c

Lines 2264 to 2278 in 901a313

	void scheme_wrong_chaperoned(const char *who, const char *what, Scheme_Object *orig, Scheme_Object *naya)
	{
	char buf[128];
	sprintf(buf,
	"non-chaperone result;\n"
	" received a %s that is not a chaperone of the original %s",
	what, what);
	scheme_contract_error(who,
	buf,
	"original", 1, orig,
	"received", 1, naya,
	NULL);
	}

and for CS (specifically for procedure chaperones) at

racket/racket/src/cs/rumble/impersonator.ss

Lines 17 to 25 in 901a313

	;; different arg order: (chaperone-of? new orig)
	;; vs. (raise-chaperone-error who what orig new)
	(define (raise-chaperone-error who what orig naya)
	(raise-arguments-error
	who
	(string-append "non-chaperone result; received a" (if (equal? what "argument") "n" "") " " what
	" that is not a chaperone of the original " what)
	"original" orig
	"received" naya))

(For CS, vector-ref, vector-set!, box-ref, box-set!, and the "thread" layer should probably also be changed for consistency, maybe by adding a helper function analogous to scheme_wrong_chaperoned.)

the instantiations of my combinator are guarded by coerce-contract

If your combinator is supposed to create chaperone contracts, it needs to use coerce-chaperone-contract, not coerce-contract.

That leads us to the bug in The Racket Guide. While the prose here correctly says to use coerce-chaperone-contract, the code examples wrongly use coerce-contract:

racket/pkgs/racket-doc/scribblings/guide/contracts/new-combinators.scrbl

Lines 291 to 299 in 901a313

	To do the automatic coercion of values like @racket[integer?] and @racket[#f]
	into contracts, we need to call @racket[coerce-chaperone-contract]
	(note that this rejects impersonator contracts and does not insist
	on flat contracts; to do either of those things, call @racket[coerce-contract]
	or @racket[coerce-flat-contract] instead).
	@interaction/no-prompt[#:eval ex-eval
	(define (simple-arrow-contract dom rng)
	(simple-arrow (coerce-contract 'simple-arrow-contract dom)
	(coerce-contract 'simple-arrow-contract rng)))]

racket/pkgs/racket-doc/scribblings/guide/contracts/new-combinators.scrbl

Lines 472 to 474 in 901a313

	(define (simple-arrow-contract dom rng)
	(simple-arrow (coerce-contract 'simple-arrow-contract dom)
	(coerce-contract 'simple-arrow-contract rng)))]