|
|
|
|
@ -12,6 +12,9 @@
|
|
|
|
|
"param.rkt")
|
|
|
|
|
(provide (all-defined-out))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(require rackunit))
|
|
|
|
|
|
|
|
|
|
(define (for-each-attrs xs proc)
|
|
|
|
|
;; apply `proc` to each set of attrs in `xs`.
|
|
|
|
|
;; recursively descend from top to bottom.
|
|
|
|
|
@ -41,9 +44,15 @@
|
|
|
|
|
[other (raise-argument-error 'do-attr-iteration "key predicate" other)]))
|
|
|
|
|
(for-each-attrs qs
|
|
|
|
|
(λ (attrs parent-attrs)
|
|
|
|
|
(for ([(ak av) (in-hash attrs)]
|
|
|
|
|
;; we don't iterate with `in-hash` (or `in-hash-keys`) because
|
|
|
|
|
;; `attrs` might get mutated during the loop,
|
|
|
|
|
;; which invalidates the reference `in-hash` is using
|
|
|
|
|
(for* ([ak (in-list (hash-keys attrs))]
|
|
|
|
|
[av (in-value (hash-ref attrs ak))]
|
|
|
|
|
#:when (attr-predicate ak av))
|
|
|
|
|
(match (if wants-parent-attrs? (attr-proc ak av attrs parent-attrs) (attr-proc ak av attrs))
|
|
|
|
|
(match (if wants-parent-attrs?
|
|
|
|
|
(attr-proc ak av attrs parent-attrs)
|
|
|
|
|
(attr-proc ak av attrs))
|
|
|
|
|
;; void value: do nothing
|
|
|
|
|
[(? void?) (void)]
|
|
|
|
|
;; otherwise treat return value as new attr value
|
|
|
|
|
@ -62,8 +71,7 @@
|
|
|
|
|
[(attr-key? ak) av]
|
|
|
|
|
[(symbol? ak)
|
|
|
|
|
(match (hash-ref attr-lookup-table ak :unknown-key)
|
|
|
|
|
[(== :unknown-key eq?)
|
|
|
|
|
#:when strict-attrs?
|
|
|
|
|
[(== :unknown-key eq?) #:when strict-attrs?
|
|
|
|
|
(raise-argument-error 'upgrade-attr-keys "known attr" ak)]
|
|
|
|
|
[attr-key
|
|
|
|
|
(hash-remove! attrs ak)
|
|
|
|
|
@ -150,7 +158,6 @@
|
|
|
|
|
#:attr-proc (λ (ak av attrs) (parse-dimension av))))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(require rackunit)
|
|
|
|
|
(define-attr-list debug-attrs
|
|
|
|
|
[:foo (make-attr-cased-string-key 'foo)]
|
|
|
|
|
[:ps (make-attr-path-key 'ps)]
|
|
|
|
|
|
