From 3bc59a2460a099d02c43394f31e5bc65dc5a36da Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 3 Feb 2015 17:57:27 -0800 Subject: [PATCH] quad-attr-remove and remove* --- quad/tests-typed.rkt | 6 ++++++ quad/utils-typed.rkt | 17 ++++++++++++++++- 2 files changed, 22 insertions(+), 1 deletion(-) diff --git a/quad/tests-typed.rkt b/quad/tests-typed.rkt index bd3d1f67..39b778b8 100644 --- a/quad/tests-typed.rkt +++ b/quad/tests-typed.rkt @@ -45,4 +45,10 @@ (check-equal? (quad-attr-set* (box '()) 'foo 'zam 'bar 'boo) (box '(foo zam bar boo))) (check-equal? (quad-attr-set* (box '(foo bar)) 'foo 'zam 'bar 'boo) (box '(foo zam bar boo))) +(check-equal? (quad-attr-remove (box '(foo bar zim zam)) 'foo) (box '(zim zam))) +(check-equal? (quad-attr-remove (box #f) 'zim) (box)) +(check-equal? (quad-attr-remove* (box '(foo bar zim zam ding dong)) 'foo 'ding) (box '(zim zam))) +(check-equal? (quad-attr-remove* (box #f) 'zim) (box)) + + diff --git a/quad/utils-typed.rkt b/quad/utils-typed.rkt index ae11626d..8dbf271a 100644 --- a/quad/utils-typed.rkt +++ b/quad/utils-typed.rkt @@ -133,4 +133,19 @@ (: quad-attr-set* (Quad (U QuadAttrKey QuadAttrValue) * . -> . Quad)) (define (quad-attr-set* q . kvs) (for/fold ([current-q q])([kv-list (in-list (slice-at kvs 2))]) - (apply quad-attr-set current-q kv-list))) \ No newline at end of file + (apply quad-attr-set current-q kv-list))) + +;; functionally remove a quad attr. Similar to hash-remove +(provide quad-attr-remove) +(: quad-attr-remove (Quad QuadAttrKey . -> . Quad)) +(define (quad-attr-remove q k) + (if (quad-attrs q) + (quad (quad-name q) (hash-remove (quad-attrs q) k) (quad-list q)) + q)) + +;; functionally remove multiple quad attrs. Similar to hash-remove* +(provide quad-attr-remove*) +(: quad-attr-remove* (Quad QuadAttrKey * . -> . Quad)) +(define (quad-attr-remove* q . ks) + (for/fold ([current-q q])([k (in-list ks)]) + (quad-attr-remove current-q k))) \ No newline at end of file