From b84adeb6bedd58afdf1e5ca267305b93e1153e4e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 1 Mar 2022 11:26:18 -0800 Subject: [PATCH] hash union --- quad2/linearize.rkt | 4 +--- quad2/quad.rkt | 11 ++++++++++- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/quad2/linearize.rkt b/quad2/linearize.rkt index 6c2eeced..03886cf0 100644 --- a/quad2/linearize.rkt +++ b/quad2/linearize.rkt @@ -15,9 +15,7 @@ #:pre quad? #:post (list-of simple-quad?) (let loop ([q q][attrs-context (make-quad-attrs)]) ;; returns (list-of quad?) - (define current-attrs (let ([qas (make-quad-attrs)]) - (hash-union! #:combine (λ (v1 v2) v2) qas attrs-context (quad-attrs q)) - qas)) + (define current-attrs (quad-attrs-union attrs-context (quad-attrs q))) (define (mq es) (make-quad #:tag (quad-tag q) #:attrs current-attrs #:elems es)) (match (quad-elems q) [(? null?) (list (mq null))] diff --git a/quad2/quad.rkt b/quad2/quad.rkt index fa3deeae..63c5534c 100644 --- a/quad2/quad.rkt +++ b/quad2/quad.rkt @@ -1,5 +1,8 @@ #lang debug racket/base -(require racket/contract racket/match (for-syntax racket/base racket/syntax)) +(require racket/contract + racket/match + racket/hash + (for-syntax racket/base racket/syntax)) (provide (all-defined-out)) (struct $point (x y) #:transparent #:mutable) @@ -26,6 +29,12 @@ [(or (? symbol?) #false) #true] [_ #false])) (define (make-quad-attrs [alist null]) (make-hasheq alist)) + +(define (quad-attrs-union . attrss) + (define qas (make-quad-attrs)) + (apply hash-union! #:combine (λ (v1 v2) v2) qas attrss) + qas) + (define (quad-attrs? x) (hash-eq? x)) (define (quad-elems? x) (list? x))