eomap.rkt (3901B)
1 #lang racket/base 2 (require racket/contract/base 3 racket/dict 4 racket/match) 5 6 #| 7 eomap = "extend-only" mapping 8 9 Used to represent persistent mappings that are typically extended only once, 10 where both lookup and extend must be fast, but no other operations are needed. 11 12 Like association list (sharing, fast extend), but lookup is fast too. 13 Like immutable hash (fast lookup), but extend (hopefully) involves less allocation. 14 15 ---- 16 17 An eomap[K,V] is (eomap store[K,V] timestamp (box timestamp)). 18 A store[K,V] is mutable-dict[K, (listof (cons timestamp V))]. 19 20 A timestamp is either 21 - nat 22 - (cons nat (cons symbol timestamp)) 23 24 Timestamps are arranged into Branches. The main Branch goes 1, 2, 3 .... 25 A box stores the latest timestamp in a Branch. 26 If another eomap is branched off of 2, that Branch is tagged (g0 . 2) and 27 its successor for 2 is (1 g0 . 2). 28 29 Timestamps and branches are compared using eqv?. 30 31 Comparison: 32 t1 < nat2 if 33 - t1 = nat1 < nat2 34 t1 < (nat2 sym2 . bt2) if 35 - t1 = (nat1 sym2 . bt2) ;; same branch 36 and nat1 < nat2 37 - t1 < bt2, or ;; less than branch point 38 39 ==== 40 41 The data structure works best, of course, when a mapping is extended only once, 42 so we can stick to simple numbered timestamps. 43 44 An alternative is to make eomaps enforce the extend-once property; so 45 instead of branching a second extension just errors. 46 47 TODO: check if macro stepper strictly follows extend-once discipline. 48 49 |# 50 51 (struct eomap (store ts latest)) 52 53 (define (empty-eomap [store (make-hasheq)]) 54 (eomap store 1 (box 1))) 55 56 (define (eomap-bump eom) 57 (match eom 58 [(eomap store ts latest) 59 (let-values ([(ts* latest*) (successor ts latest)]) 60 (eomap store ts* latest*))])) 61 62 (define (eomap-add eom to-add) 63 (let ([eom* (eomap-bump eom)]) 64 (match eom* 65 [(eomap store ts latest) 66 (for ([(key value) (in-dict to-add)]) 67 (dict-set! store key 68 (cons (cons ts value) (dict-ref store key null))))]) 69 eom*)) 70 71 (define (eomap-set* eom keys value) 72 (let ([eom* (eomap-bump eom)]) 73 (match eom* 74 [(eomap store ts latest) 75 (for ([key (in-list keys)]) 76 (dict-set! store key 77 (cons (cons ts value) (dict-ref store key null))))]) 78 eom*)) 79 80 (define (eomap-ref eom key [default not-given]) 81 (match eom 82 [(eomap store ts _latest) 83 (let loop ([ts+value-list (dict-ref store key null)]) 84 (cond [(pair? ts+value-list) 85 (let ([entry-ts (car (car ts+value-list))] 86 [entry-value (cdr (car ts+value-list))]) 87 (cond [(t<=? entry-ts ts) 88 entry-value] 89 [else (loop (cdr ts+value-list))]))] 90 [else 91 (cond [(eq? default not-given) 92 (error 'eomap-ref "key not found: ~e" key)] 93 [(procedure? default) (default)] 94 [else default])]))])) 95 96 (define not-given (gensym 'not-given)) 97 98 ;; Timestamps 99 100 (define (successor ts latest) 101 (define (tadd1 ts) 102 (cond [(pair? ts) (cons (add1 (car ts)) (cdr ts))] 103 [else (add1 ts)])) 104 (cond [(eqv? ts (unbox latest)) 105 (let ([ts+1 (tadd1 ts)]) 106 (set-box! latest ts+1) 107 (values ts+1 latest))] 108 [else 109 (let* ([tag (cons (gensym) ts)] 110 [next (cons 1 tag)]) 111 (values next (box next)))])) 112 113 (define (t<=? x y) 114 (or (eqv? x y) (t<? x y))) 115 116 (define (t<? x y) 117 (match y 118 [(cons yn ytag) 119 (match x 120 [(cons xn (? (lambda (v) (eqv? v ytag)))) 121 (< xn yn)] 122 [x 123 (t<? x (cdr ytag))])] 124 [yn 125 (and (number? x) 126 (< x yn))])) 127 128 ;; ---- 129 130 (provide/contract 131 [eomap? 132 (-> any/c boolean?)] 133 [empty-eomap 134 (->* () (dict?) eomap?)] 135 [eomap-add 136 (-> eomap? dict? eomap?)] 137 [eomap-set* 138 (-> eomap? list? any/c eomap?)] 139 [eomap-ref 140 (->* (eomap? any/c) (any/c) any)])