Remove name from DBind

This commit is contained in:
Tony Garnock-Jones 2021-08-11 15:52:01 -04:00
parent 6fec849b2f
commit 5ff75d05ab
2 changed files with 15 additions and 21 deletions

View File

@ -15,7 +15,6 @@
pattern->constant-values
pattern->constant-paths
pattern->capture-paths
pattern->capture-names
pattern->constant
;; quote-pattern
@ -174,13 +173,13 @@
[id
(dollar-id? #'id)
#`(Pattern-DBind (DBind '#,(undollar #'id) (Pattern-DDiscard (DDiscard))))]
#`(Pattern-DBind (DBind (Pattern-DDiscard (DDiscard))))]
[($ (unquote bp) p)
#`(Pattern-DBind (DBind bp #,(walk #'p)))]
#`(Pattern-DBind (DBind #,(walk #'p)))]
[($ id p)
#`(Pattern-DBind (DBind 'id #,(walk #'p)))]
#`(Pattern-DBind (DBind #,(walk #'p)))]
[id
(discard-id? #'id)
@ -348,8 +347,8 @@
(DCompound-dict _ members)))
(append* (for/list [((key subdesc) (in-hash members))]
(walk-node (cons key key-rev) subdesc)))]
[(Pattern-DBind (DBind name subdesc))
(append (capture-fn key-rev name) (walk-node key-rev subdesc))]
[(Pattern-DBind (DBind subdesc))
(append (capture-fn key-rev) (walk-node key-rev subdesc))]
[(Pattern-DDiscard (DDiscard))
'()]
[(Pattern-DLit (DLit value))
@ -357,31 +356,26 @@
(define (pattern->constant-values desc)
(select-pattern-leaves desc
(lambda (key-rev name-stx) (list))
(lambda (key-rev) (list))
(lambda (key-rev value) (list value))))
(define (pattern->constant-paths desc)
(select-pattern-leaves desc
(lambda (key-rev name-stx) (list))
(lambda (key-rev) (list))
(lambda (key-rev value) (list (reverse key-rev)))))
(define (pattern->capture-paths desc)
(select-pattern-leaves desc
(lambda (key-rev name-stx) (list (reverse key-rev)))
(lambda (key-rev) (list (reverse key-rev)))
(lambda (key-rev value) (list))))
(define (pattern->capture-names desc)
(select-pattern-leaves desc
(lambda (key-rev name-stx) (list name-stx))
(lambda (key-rev value) (list))))
(define (pattern->constant desc [env (lambda (name index) (void))])
(define (pattern->constant desc [env (lambda (index) (void))])
(define next-binding-index 0)
(define (walk p k)
(match p
[(Pattern-DDiscard (DDiscard)) (void)]
[(Pattern-DBind (DBind name pat))
(let ((v (env name next-binding-index)))
[(Pattern-DBind (DBind pat))
(let ((v (env next-binding-index)))
(set! next-binding-index (+ next-binding-index 1))
(let ((inner (walk pat values)))
(k (if (void? v) inner v))))]
@ -414,9 +408,9 @@
;; (match p
;; [(Pattern-DDiscard (DDiscard))
;; (Pattern-DCompound (DCompound-rec (CRec '_ 0) (hash)))]
;; [(Pattern-DBind (DBind name pat))
;; (Pattern-DCompound (DCompound-rec (CRec 'bind 2)
;; (hash 0 (Pattern-DLit (DLit name)) 1 (quote-pattern pat))))]
;; [(Pattern-DBind (DBind pat))
;; (Pattern-DCompound (DCompound-rec (CRec 'bind 1)
;; (hash 0 (quote-pattern pat))))]
;; [(Pattern-DLit value)
;; (Pattern-DCompound (DCompound-rec (CRec 'lit 1) (hash 0 (Pattern-DLit (DLit value)))))]
;; [(Pattern-DCompound (DCompound-rec (CRec label arity) members))

View File

@ -195,7 +195,7 @@
[((key subpat) (in-hash members))]
(walk-node! (cons key rev-path) sk pop-count key subpat))))
(values (+ pop-count 1) sk))]
[(Pattern-DBind (DBind _ pat))
[(Pattern-DBind (DBind pat))
(walk-node! rev-path sk pop-count key pat)]
[_
(values pop-count sk)]))