From d1233df71b24f843e3c23da8b446226e9b139310 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 18 Jun 2016 17:21:38 -0700 Subject: [PATCH] get hashy --- quad/quad/atomize.rkt | 10 +++++----- quad/quad/quads.rkt | 34 ++++++++++++++++------------------ 2 files changed, 21 insertions(+), 23 deletions(-) diff --git a/quad/quad/atomize.rkt b/quad/quad/atomize.rkt index 33527f5f..abe2dcd5 100644 --- a/quad/quad/atomize.rkt +++ b/quad/quad/atomize.rkt @@ -6,17 +6,17 @@ (flatten (let loop ([x x][loop-attrs default-attrs]) (cond - [(symbol? x) ($shim (attrs #:posn 0) x)] + [(symbol? x) ($shim (make-attrs) 0 x)] [(string? x) (for/list ([c (in-string x)]) - (cons ($shim (attrs #:posn 0) 0) + (cons ($shim (make-attrs) 0 0) (case c - [(#\space #\newline #\return) ($white (vector-copy loop-attrs) c)] - [else ($black (vector-copy loop-attrs) c)])))] + [(#\space #\newline #\return) ($white loop-attrs 0 c)] + [else ($black loop-attrs 0 c)])))] [else (map (λ(xi) (loop xi ((quad-attrs x) . override-with . loop-attrs))) (quad-val x))])))) (module+ test (require rackunit) - (atomize (quad (attrs #:size 10 #:font "Eq") "ba" (line-break) "r" (quad (attrs #:size 8) "zam") "q\tux")) + (atomize (quad (make-attrs #:size 10 #:font "Eq") "ba" (line-break) "r" (quad (make-attrs #:size 8) "zam") "q\tux")) (atomize (quad #f "Meg is " (line-break) "\nan ally."))) diff --git a/quad/quad/quads.rkt b/quad/quad/quads.rkt index e7bcd4ff..6cfd8422 100644 --- a/quad/quad/quads.rkt +++ b/quad/quad/quads.rkt @@ -2,11 +2,11 @@ (provide (all-defined-out)) (require (for-syntax racket/string racket/base racket/syntax)) -(struct $quad (attrs val) #:transparent #:mutable) -(struct $black $quad () #:transparent #:mutable) -(struct $white $quad () #:transparent #:mutable) -(struct $skip $quad () #:transparent #:mutable) -(struct $shim $quad () #:transparent #:mutable) +(struct $quad (attrs posn val) #:transparent #:mutable) +(struct $black $quad () #:transparent) +(struct $white $quad () #:transparent) +(struct $skip $quad () #:transparent) +(struct $shim $quad () #:transparent) (define quad? $quad?) @@ -27,28 +27,26 @@ position measure (line width) |# -(define default-attrs (vector 12 "Courier" 0)) +(define default-attrs (hasheq 'size 12 'font "Courier")) (define (quad attr . xs) - ($quad (or attr (attrs)) xs)) + ($quad (or attr (make-attrs)) 0 xs)) -(define (attrs #:size [size #f] - #:font [font #f] - #:posn [posn #f]) - (vector size font posn)) +(struct $attrs (size font) #:transparent) +(define (make-attrs #:size [size #f] + #:font [font #f]) + (hasheq 'size size 'font font)) (define (quad-posn q) - (vector-ref ($quad-attrs q) 2)) + ($quad-posn q)) (define (quad-posn-set! q val) - (vector-set! ($quad-attrs q) 2 val)) + (set-$quad-posn! q val)) (define (override-with dest source) ;; replace missing values in dest with values from source - (for ([i (in-range (vector-length source))]) - (unless (vector-ref dest i) - (vector-set! dest i (vector-ref source i)))) - dest) + (for/hasheq ([k (in-hash-keys source)]) + (values k (or (hash-ref dest k) (hash-ref source k))))) (require (for-syntax sugar/debug)) (define-syntax (define-break stx) @@ -68,5 +66,5 @@ measure (line width) (define q (quad #f "bar")) (check-true (quad? q)) (check-false (quad? 42)) - (check-equal? (quad-attrs q) (attrs)) + (check-equal? (quad-attrs q) (make-attrs)) (check-equal? (quad-val q) '("bar"))) \ No newline at end of file