Move helper to a common file.

To avoid ->i depend on ->.
This commit is contained in:
Vincent St-Amour 2016-06-08 14:43:36 -05:00
parent c735c88c2d
commit 5489fb937e
3 changed files with 29 additions and 30 deletions

View File

@ -7,7 +7,6 @@
"misc.rkt"
"blame.rkt"
"generate.rkt"
"arrow-higher-order.rkt"
syntax/location
racket/private/performance-hint
(for-syntax racket/base

View File

@ -24,7 +24,8 @@
the-unsupplied-arg unsupplied-arg?
values/drop
(struct-out base->)
raise-wrong-number-of-args-error)
raise-wrong-number-of-args-error
pre-post/desc-result->string)
;; min-arity : nat
;; doms : (listof contract?)[len >= min-arity]
@ -379,6 +380,32 @@
'(received: "~a argument~a" expected: "~a")
args-len (if (= args-len 1) "" "s") arity-string))
(define (pre-post/desc-result->string condition-result pre? who)
(cond
[(equal? condition-result #f)
(if pre?
"#:pre condition"
"#:post condition")]
[(string? condition-result)
condition-result]
[(and (list? condition-result)
(andmap string? condition-result))
(apply
string-append
(let loop ([s condition-result])
(cond
[(null? s) '()]
[(null? (cdr s)) s]
[else (list* (car s)
"\n "
(loop (cdr s)))])))]
[else
(error
who
"expected #:~a/desc to produce (or/c boolean? string? (listof string?)), got ~e"
(if pre? "pre" "post")
condition-result)]))
;; timing & size tests
#;

View File

@ -18,7 +18,6 @@
->-proj
check-pre-cond
check-post-cond
pre-post/desc-result->string
arity-checking-wrapper)
(define-for-syntax (build-chaperone-constructor/real ;; (listof (or/c #f stx))
@ -94,37 +93,11 @@
(void)]
[else
(define msg
(pre-post/desc-result->string condition-result pre? '->*))
(arrow:pre-post/desc-result->string condition-result pre? '->*))
(raise-blame-error (if pre? (blame-swap blame) blame)
#:missing-party neg-party
val "~a" msg)]))
(define (pre-post/desc-result->string condition-result pre? who)
(cond
[(equal? condition-result #f)
(if pre?
"#:pre condition"
"#:post condition")]
[(string? condition-result)
condition-result]
[(and (list? condition-result)
(andmap string? condition-result))
(apply
string-append
(let loop ([s condition-result])
(cond
[(null? s) '()]
[(null? (cdr s)) s]
[else (list* (car s)
"\n "
(loop (cdr s)))])))]
[else
(error
who
"expected #:~a/desc to produce (or/c boolean? string? (listof string?)), got ~e"
(if pre? "pre" "post")
condition-result)]))
(define-for-syntax (create-chaperone blame neg-party blame+neg-party blame-party-info
val rng-ctcs
doms opt-doms