syntax/parse: add nullability analysis and check ellipsis-head patterns
Currently logs a warning and continues, but eventually this should be a compile-time error.
This commit is contained in:
parent
fb5c1310d8
commit
3da626d483
|
@ -42,7 +42,7 @@ A ListPattern is a subtype of SinglePattern; one of
|
|||
(pat:action ActionPattern ListPattern)
|
||||
(pat:head HeadPattern ListPattern)
|
||||
(pat:pair #t SinglePattern ListPattern)
|
||||
(pat:dots EllipsisHeadPattern SinglePattern)
|
||||
(pat:dots EllipsisHeadPattern ListPattern)
|
||||
|#
|
||||
|
||||
(define-struct pat:any () #:prefab)
|
||||
|
@ -442,6 +442,47 @@ A RepConstraint is one of
|
|||
(define afp (pattern-AF p))
|
||||
(and af (AF<? af afp) (bitwise-ior af afp))))
|
||||
|
||||
;; ----
|
||||
|
||||
;; An AbsNullable is 'yes | 'no | 'unknown (3-valued logic)
|
||||
|
||||
(define (3and a b)
|
||||
(case a
|
||||
[(yes) b]
|
||||
[(no) 'no]
|
||||
[(unknown) (case b [(yes unknown) 'unknown] [(no) 'no])]))
|
||||
|
||||
(define (3or a b)
|
||||
(case a
|
||||
[(yes) 'yes]
|
||||
[(no) b]
|
||||
[(unknown) (case b [(yes) 'yes] [(no unknown) 'unknown])]))
|
||||
|
||||
;; lpat-nullable : ListPattern -> AbsNullable
|
||||
(define/memo (lpat-nullable lp)
|
||||
(match lp
|
||||
[(pat:datum '()) 'yes]
|
||||
[(pat:action ap lp) (lpat-nullable lp)]
|
||||
[(pat:head hp lp) (3and (hpat-nullable hp) (lpat-nullable lp))]
|
||||
[(pat:pair '#t sp lp) 'no]
|
||||
[(pat:dots ehp lp) (lpat-nullable lp)]))
|
||||
|
||||
;; hpat-nullable : HeadPattern -> AbsNullable
|
||||
(define/memo (hpat-nullable hp)
|
||||
(match hp
|
||||
[(hpat:seq lp) (lpat-nullable lp)]
|
||||
[(hpat:action ap hp) (hpat-nullable hp)]
|
||||
[(hpat:and hp sp) (hpat-nullable hp)]
|
||||
[(hpat:or _attrs hps _attrss) (foldl 3or 'no (map hpat-nullable hps))]
|
||||
[(hpat:describe hp _ _ _) (hpat-nullable hp)]
|
||||
[(hpat:delimit hp) (hpat-nullable hp)]
|
||||
[(hpat:commit hp) (hpat-nullable hp)]
|
||||
[(hpat:ord hp _ _) (hpat-nullable hp)]
|
||||
[(hpat:post hp) (hpat-nullable hp)]
|
||||
[_ 'unknown]))
|
||||
|
||||
;; ----
|
||||
|
||||
;; create-post-pattern : *Pattern -> *Pattern
|
||||
(define (create-post-pattern p)
|
||||
(cond [(pattern-cannot-fail? p)
|
||||
|
|
|
@ -21,6 +21,8 @@
|
|||
"kws.rkt"
|
||||
"pattern-expander-prop.rkt")
|
||||
|
||||
(define-logger syntax-parse)
|
||||
|
||||
;; Error reporting
|
||||
;; All entry points should have explicit, mandatory #:context arg
|
||||
;; (mandatory from outside, at least)
|
||||
|
@ -654,6 +656,10 @@
|
|||
(list (parse*-ehpat/bounds stx decls))]
|
||||
[_
|
||||
(let ([head (parse-head-pattern stx decls)])
|
||||
;; FIXME: if 'no, can omit null-eh-match check in parse.rkt
|
||||
(when (eq? (hpat-nullable head) 'yes)
|
||||
(when #f (wrong-syntax stx "nullable ellipsis-head pattern"))
|
||||
(when #t (log-syntax-parse-error "nullable ellipsis-head pattern: ~e" stx)))
|
||||
(list (list (create-ehpat head #f) stx)))]))
|
||||
|
||||
(define (replace-eh-alternative-attrs alt sattrs)
|
||||
|
|
Loading…
Reference in New Issue
Block a user