Hash-table patterns
This commit is contained in:
parent
507f137c25
commit
12df86ee74
|
@ -84,6 +84,11 @@
|
||||||
(and (identifier? stx)
|
(and (identifier? stx)
|
||||||
(free-identifier=? #'list 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)
|
(define (constructor-registered? stx)
|
||||||
(free-id-table-ref preserves-pattern-registry stx #f))
|
(free-id-table-ref preserves-pattern-registry stx #f))
|
||||||
|
|
||||||
|
@ -106,6 +111,12 @@
|
||||||
(values (syntax-e ctor-stx)
|
(values (syntax-e ctor-stx)
|
||||||
expected-count))
|
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 (analyse-pattern stx)
|
||||||
(define disarmed-stx (syntax-disarm stx orig-insp))
|
(define disarmed-stx (syntax-disarm stx orig-insp))
|
||||||
(syntax-case disarmed-stx ($ quasiquote unquote quote)
|
(syntax-case disarmed-stx ($ quasiquote unquote quote)
|
||||||
|
@ -144,6 +155,12 @@
|
||||||
(piece (in-list (syntax->list #'(piece ...))))]
|
(piece (in-list (syntax->list #'(piece ...))))]
|
||||||
(member-entry n 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
|
[id
|
||||||
(dollar-id? #'id)
|
(dollar-id? #'id)
|
||||||
#`(Pattern-DBind (DBind '#,(undollar #'id) (Pattern-DDiscard (DDiscard))))]
|
#`(Pattern-DBind (DBind '#,(undollar #'id) (Pattern-DDiscard (DDiscard))))]
|
||||||
|
@ -185,6 +202,10 @@
|
||||||
(list-id? #'list-stx)
|
(list-id? #'list-stx)
|
||||||
(append-map analyse-pattern-bindings (syntax->list #'(piece ...)))]
|
(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
|
[id
|
||||||
(dollar-id? #'id)
|
(dollar-id? #'id)
|
||||||
(list (undollar #'id))]
|
(list (undollar #'id))]
|
||||||
|
@ -219,6 +240,11 @@
|
||||||
(list-id? #'list-stx)
|
(list-id? #'list-stx)
|
||||||
#`(list-stx #,@(map analyse-template (syntax->list #'(piece ...))))]
|
#`(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])))
|
[other #'other])))
|
||||||
|
|
||||||
(define-syntax (:pattern stx)
|
(define-syntax (:pattern stx)
|
||||||
|
|
Loading…
Reference in New Issue