fix listof error reporting
closes PR 13685
please merge to the release branch
(cherry picked from commit e6122d5fbd
)
This commit is contained in:
parent
77142df5e8
commit
c19fbbce45
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user