fix listof error reporting

closes PR 13685

please merge to the release branch
(cherry picked from commit e6122d5fbd)
This commit is contained in:
Robby Findler 2013-04-11 18:42:49 -05:00 committed by Ryan Culpepper
parent 77142df5e8
commit c19fbbce45

View File

@ -594,7 +594,7 @@
(define-syntax (*-listof stx) (define-syntax (*-listof stx)
(syntax-case stx () (syntax-case stx ()
[(_ predicate? type-name name generate) [(_ predicate? name generate)
(identifier? (syntax predicate?)) (identifier? (syntax predicate?))
(syntax (syntax
(λ (input) (λ (input)
@ -610,8 +610,8 @@
(λ (val) (λ (val)
(unless (predicate? val) (unless (predicate? val)
(raise-blame-error blame val (raise-blame-error blame val
'(expected: "~s" given "~e") '(expected: "~s" given: "~e")
'type-name 'predicate?
val)) val))
(check-all p-app val)))) (check-all p-app val))))
(cond (cond
@ -633,11 +633,11 @@
#:first-order fo-check #:first-order fo-check
#:projection (ho-check (λ (p v) (map p v))))]))))])) #:projection (ho-check (λ (p v) (map p v))))]))))]))
(define listof-func (*-listof list? list listof listof-generate)) (define listof-func (*-listof list? listof listof-generate))
(define/subexpression-pos-prop (listof x) (listof-func x)) (define/subexpression-pos-prop (listof x) (listof-func x))
(define (non-empty-list? x) (and (pair? x) (list? (cdr x)))) (define (non-empty-list? x) (and (pair? x) (list? (cdr x))))
(define non-empty-listof-func (*-listof non-empty-list? non-empty-list non-empty-listof (λ (ctc) (make-generate-ctc-fail)))) (define non-empty-listof-func (*-listof non-empty-list? non-empty-listof (λ (ctc) (make-generate-ctc-fail))))
(define/subexpression-pos-prop (non-empty-listof a) (non-empty-listof-func a)) (define/subexpression-pos-prop (non-empty-listof a) (non-empty-listof-func a))
(define cons/c-main-function (define cons/c-main-function