still more degeneracy

pull/13/merge
Matthew Butterick 7 years ago
parent 587f5ef946
commit d4585d825a

@ -1,5 +1,5 @@
#lang racket/base #lang racket/base
(require "syntax-flatten.rkt" racket/list) (require "syntax-flatten.rkt" racket/list racket/match)
(provide ellipses-follow-wildcards-or-subpatterns? generate-literals generate-bound-and-unbound-literals) (provide ellipses-follow-wildcards-or-subpatterns? generate-literals generate-bound-and-unbound-literals)
(define (literal-identifier? pat-datum) (define (literal-identifier? pat-datum)
@ -34,15 +34,15 @@
(define (ellipses-follow-wildcards-or-subpatterns? pat) (define (ellipses-follow-wildcards-or-subpatterns? pat)
(let loop ([datum (syntax->datum pat)]) (let loop ([datum (syntax->datum pat)])
(cond (match datum
[(null? datum) #t] [(? null?) #t]
[(equal? datum '(...)) #f] [(cons '... _) #f]
[(list? datum) (and (andmap loop datum) [(cons _ '...) #f]
(for/and ([datum-left (in-list datum)] [(list head '... tail ...) (and (or (wildcard? head) (pair? head))
[datum-right (in-list (cdr datum))] (loop head)
#:when (eq? datum-right '...)) (loop tail))]
(or (wildcard? datum-left) (pair? datum-left))))] [(list head tail ...) (and (loop head) (loop tail))]
[(pair? datum) (loop (flatten datum))] [(cons x y) (loop (list x y))]
[else #t]))) [else #t])))
@ -76,4 +76,9 @@
(check-false (ellipses-follow-wildcards-or-subpatterns? (datum->syntax #f '(((a ...) ...) ...)))) (check-false (ellipses-follow-wildcards-or-subpatterns? (datum->syntax #f '(((a ...) ...) ...))))
(check-false (ellipses-follow-wildcards-or-subpatterns? (datum->syntax #f '(((B ...) a ...) ...)))) (check-false (ellipses-follow-wildcards-or-subpatterns? (datum->syntax #f '(((B ...) a ...) ...))))
(check-false (ellipses-follow-wildcards-or-subpatterns? (datum->syntax #f '((...) B ...)))) (check-false (ellipses-follow-wildcards-or-subpatterns? (datum->syntax #f '((...) B ...))))
(check-false (ellipses-follow-wildcards-or-subpatterns? (datum->syntax #f '(((((...)))))))))) (check-false (ellipses-follow-wildcards-or-subpatterns? (datum->syntax #f '(((((...))))))))
(check-false (ellipses-follow-wildcards-or-subpatterns? (datum->syntax #f '(A . ...))))
(check-false (ellipses-follow-wildcards-or-subpatterns? (datum->syntax #f '(... A))))
(check-false (ellipses-follow-wildcards-or-subpatterns? (datum->syntax #f '(... . A))))
(check-false (ellipses-follow-wildcards-or-subpatterns? (datum->syntax #f '(... . ...))))
(check-false (ellipses-follow-wildcards-or-subpatterns? (datum->syntax #f '((... . A) ...))))))

Loading…
Cancel
Save