Hash-table patterns
This commit is contained in:
parent
507f137c25
commit
12df86ee74
|
@ -84,6 +84,11 @@
|
|||
(and (identifier? stx)
|
||||
(free-identifier=? #'list stx)))
|
||||
|
||||
(define (hash-or-hasheqv-id? stx)
|
||||
(and (identifier? stx)
|
||||
(or (free-identifier=? #'hash stx)
|
||||
(free-identifier=? #'hasheqv stx))))
|
||||
|
||||
(define (constructor-registered? stx)
|
||||
(free-id-table-ref preserves-pattern-registry stx #f))
|
||||
|
||||
|
@ -106,6 +111,12 @@
|
|||
(values (syntax-e ctor-stx)
|
||||
expected-count))
|
||||
|
||||
(define (append-map-pairs f xs)
|
||||
(match xs
|
||||
['() '()]
|
||||
[(list _) (raise-syntax-error #f "Odd number of elements in hash-like pattern")]
|
||||
[(list* k v more) (append (f k v) (append-map-pairs f more))]))
|
||||
|
||||
(define (analyse-pattern stx)
|
||||
(define disarmed-stx (syntax-disarm stx orig-insp))
|
||||
(syntax-case disarmed-stx ($ quasiquote unquote quote)
|
||||
|
@ -144,6 +155,12 @@
|
|||
(piece (in-list (syntax->list #'(piece ...))))]
|
||||
(member-entry n piece))))))]
|
||||
|
||||
[(hash-stx piece ...)
|
||||
(hash-or-hasheqv-id? #'hash-stx)
|
||||
#`(Pattern-DCompound
|
||||
(DCompound-dict (CDict)
|
||||
(hash #,@(append-map-pairs member-entry (syntax->list #'(piece ...))))))]
|
||||
|
||||
[id
|
||||
(dollar-id? #'id)
|
||||
#`(Pattern-DBind (DBind '#,(undollar #'id) (Pattern-DDiscard (DDiscard))))]
|
||||
|
@ -185,6 +202,10 @@
|
|||
(list-id? #'list-stx)
|
||||
(append-map analyse-pattern-bindings (syntax->list #'(piece ...)))]
|
||||
|
||||
[(hash-stx piece ...)
|
||||
(hash-or-hasheqv-id? #'hash-stx)
|
||||
(append-map-pairs (lambda (_k v) (analyse-pattern-bindings v)) (syntax->list #'(piece ...)))]
|
||||
|
||||
[id
|
||||
(dollar-id? #'id)
|
||||
(list (undollar #'id))]
|
||||
|
@ -219,6 +240,11 @@
|
|||
(list-id? #'list-stx)
|
||||
#`(list-stx #,@(map analyse-template (syntax->list #'(piece ...))))]
|
||||
|
||||
[(hash-stx piece ...)
|
||||
(hash-or-hasheqv-id? #'hash-stx)
|
||||
#`(hash-stx #,@(append-map-pairs (lambda (k v) (list k (analyse-template v)))
|
||||
(syntax->list #'(piece ...))))]
|
||||
|
||||
[other #'other])))
|
||||
|
||||
(define-syntax (:pattern stx)
|
||||
|
|
Loading…
Reference in New Issue