1#| doc 2Random access lists are a data structure similar to lists, 3but with very different efficiency characteristics. 4A regular list built out of cons cells is an optimal solution, 5 if one needs to work mainly with the initial elements or the whole list at a time. 6However, if you need to frequently find and maybe update values in the middle of the list, 7 you have to perform operations taking time proportional to the length of the list. 8In other words, those list operations are linear time, or have complexity O(n). 9Cons, car and cdr on the other hand are very efficient for regular lists. 10Regardless of the size of a list, it will always take a fixed amount of time to add, take or remove a value from it. 11In other words, these operations are constant time, or have complexity O(1). 12 13A random access list is a data structure, 14 which unsurprisingly attempts to make random access and update efficient. 15 16The performance characteristics of this random access list library are: 17``` 18 car → O(1) 19 cdr → O(log n) 20 cons → O(log n) 21 get → O(log n) 22 set → O(log n) 23 len → O(log n) 24 fold → O(n) 25 append → O(n) 26 list->rlist → O(n log n) 27 rlist->list → O(n) 28``` 29 30The operation is based on two ideas. 31Firstly, a random access list consists of a sequence of complete binary trees. 32The binary trees are built out of cons cells when needed. 33The first tree is always of height 1, meaning it just holds the value, much like a regular cons cell. 34The next node always holds a binary tree either of the same or next height. 35There can be at most two trees of the same height next to eachother. 36Therefore, tree heights `(1 1)`, `(1 2 4)` and `(1 1 2 4 4)` are valid, 37 whereas `(1 1 1)`, `(2 2 4)` and `(1 2 2 8)` are not. 38`(5)` is right out. 39 40Secondly, trees can be addressed directly with bits. 41It takes a n-bit number address each node of a complete binary tree of height n. 42Finding a value from a list works by first finding the tree in which the value is held, 43 and then using the remaining bits to find the correct leaf node in the tree. 44 45It is easy to see that it takes O(log n) steps to find the tree in which some particular value is held, 46 and then another O(log n) steps to walk the tree to a given position, 47Threfore we have a total complexity of O(log n) for access and update. 48 49``` 50 (rcar (rcons 11 rnull)) → 11 51 (rnull? (rcons 11 rnull)) → #false 52 (rlist->list (rcons 1 (rcons 2 rnull))) → (1 2)) 53 (rget (list->rlist (iota 0 1 1000)) 123 #f) → 123 54 (rget (list->rlist (iota 0 1 1000)) 1234 #f) → #false 55``` 56 57|# 58 59(define-library (owl lcd rlist) 60 61 (import 62 (owl core) 63 (only (owl syscall) error) 64 (owl sum) 65 (owl list)) 66 67 (export 68 rnull 69 rcons 70 rget 71 rcar 72 rcdr 73 rset 74 rlen 75 rlist 76 rfold 77 rfoldr 78 riter 79 riterr 80 rmap 81 rnull? 82 rpair? 83 list->rlist 84 rlist->list) 85 86 (begin 87 88 ;; note that for now the pattern match must come in the same order 89 ;; as the data type definition 90 (define-sum-type rl-case 91 (snd x t) 92 (fst x t) 93 (nil)) 94 95 (define rnull (nil)) 96 97 (define (nope op) 98 (error "invalid rlist arguments to " op)) 99 100 (define (rcons x as) 101 (rl-case as 102 ((snd a bs) (nope 'rcons)) 103 ((fst a bs) 104 (rl-case bs 105 ((snd b cs) 106 (rl-case cs 107 ((snd v d) (nope 'rcons)) 108 ((fst v d) 109 (fst x (rcons (cons a b) cs))) 110 ((nil) (fst x (fst (cons a b) rnull))))) 111 ((fst b cs) (fst x (snd a bs))) 112 ((nil) (fst x (snd a rnull))))) 113 ((nil) (fst x rnull)))) 114 115 (define (rcar rl . def) 116 (rl-case rl 117 ((snd a bs) (error 'rcar rl)) 118 ((fst a bs) a) 119 ((nil) 120 (if (null? def) 121 (error 'rcar 'null) 122 (car def))))) 123 124 (define (tof) #f) 125 126 (define rnull? 127 (let ((y (λ () #t)) 128 (n (λ (a b) #f))) 129 (λ (rl) (rl n n y)))) 130 131 (define rpair? 132 (let ((y (λ (a b) #t)) 133 (n (λ () #f))) 134 (λ (rl) (rl y y n)))) 135 136 (define (drop as) 137 (rl-case as 138 ((snd a bs) 139 (fst a bs)) 140 ((fst ab cs) 141 (fst (car ab) 142 (snd (cdr ab) 143 (drop cs)))) 144 ((nil) 145 rnull))) 146 147 (define (rcdr as) 148 (rl-case as 149 ((snd a as) (nope 'rcdr)) 150 ((fst a as) (drop as)) 151 ((nil) rnull))) 152 153 (define (pick tree path depth) 154 (if (eq? depth 1) 155 tree 156 (lets ((depth _ (fx>> depth 1))) 157 (if (eq? (fxand path depth) 0) 158 (pick (car tree) path depth) 159 (pick (cdr tree) path depth))))) 160 161 (define (rlen rl) 162 (let loop ((rl rl) (d 0) (dp 1) (n 0)) 163 (rl-case rl 164 ((snd tree rl) 165 (lets ((n _ (fx+ n d))) 166 (loop rl d dp n))) 167 ((fst tree rl) 168 (lets 169 ((d dp) 170 (dp _ (fx+ dp dp)) 171 (n _ (fx+ n d))) 172 (loop rl d dp n))) 173 ((nil) n)))) 174 175 (define (rget rl pos def) 176 (let loop ((rl rl) (d 0) (dp 1) (pos pos)) 177 (rl-case rl 178 ((snd tree rl) 179 (lets ((posp u (fx- pos d))) 180 (if (eq? u 0) 181 (loop rl d dp posp) 182 (pick tree pos d)))) 183 ((fst tree rl) 184 (lets 185 ((d dp) 186 (dp _ (fx+ dp dp)) 187 (posp u (fx- pos d))) 188 (if (eq? u 0) 189 (loop rl d dp posp) 190 (pick tree pos d)))) 191 ((nil) def)))) 192 193 ;; rset is rget + path copying 194 195 (define (set tree path depth val) 196 (if (eq? depth 1) 197 val 198 (lets ((depth _ (fx>> depth 1))) 199 (if (eq? (fxand path depth) 0) 200 (cons (set (car tree) path depth val) (cdr tree)) 201 (cons (car tree) (set (cdr tree) path depth val)))))) 202 203 (define (rset rl pos val) 204 (let loop ((rl rl) (d 0) (dp 1) (pos pos)) 205 (rl-case rl 206 ((snd tree rl) 207 (lets ((posp u (fx- pos d))) 208 (if (eq? u 0) 209 (snd tree (loop rl d dp posp)) 210 (snd (set tree pos d val) rl)))) 211 ((fst tree rl) 212 (lets 213 ((d dp) 214 (dp _ (fx+ dp dp)) 215 (posp u (fx- pos d))) 216 (if (eq? u 0) 217 (fst tree (loop rl d dp posp)) 218 (fst (set tree pos d val) rl)))) 219 ((nil) rl)))) 220 221 ;;; fold from left 222 223 (define (rfold-node op st n d) 224 (if (eq? d 1) 225 (op st n) 226 (lets ((d _ (fx>> d 1))) 227 (rfold-node op (rfold-node op st (car n) d) (cdr n) d)))) 228 229 (define (rfold op st rl) 230 (let loop ((rl rl) (st st) (depth 0)) 231 (rl-case rl 232 ((snd a rl) 233 (loop rl (rfold-node op st a depth) depth)) 234 ((fst a rl) 235 (if (eq? depth 0) 236 (loop rl (op st a) 1) 237 (lets ((depth _ (fx+ depth depth))) 238 (loop rl 239 (rfold-node op st a depth) 240 depth)))) 241 ((nil) st)))) 242 243 (define (list->rlist x) 244 (foldr rcons rnull x)) 245 246 (define (rlist->list rl) 247 (reverse (rfold (λ (pre val) (cons val pre)) '() rl))) 248 249 (define (rlist . args) 250 (list->rlist args)) 251 252 (define rmap #f) 253 (define rfoldr #f) 254 (define riter #f) 255 (define riterr #f) 256 257)) 258