Move helper to a common file.
To avoid ->i depend on ->.
This commit is contained in:
parent
c735c88c2d
commit
5489fb937e
|
@ -7,7 +7,6 @@
|
|||
"misc.rkt"
|
||||
"blame.rkt"
|
||||
"generate.rkt"
|
||||
"arrow-higher-order.rkt"
|
||||
syntax/location
|
||||
racket/private/performance-hint
|
||||
(for-syntax racket/base
|
||||
|
|
|
@ -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
|
||||
|
||||
#;
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user