small steps
[software/python-on-guile.git] / modules / language / python / dict.scm
1 (define-module (language python dict)
2 #:use-module (language python list)
3 #:use-module (language python try)
4 #:use-module (language python hash)
5 #:use-module (language python yield)
6 #:use-module (language python def)
7 #:use-module (language python for)
8 #:use-module (language python bool)
9 #:use-module (language python exceptions)
10 #:use-module (language python persist)
11 #:use-module (ice-9 match)
12 #:use-module (ice-9 control)
13 #:use-module (oop goops)
14 #:use-module (oop pf-objects)
15 #:export (make-py-hashtable <py-hashtable>
16 py-copy py-fromkeys py-has_key py-items py-iteritems
17 py-iterkeys py-itervalues py-keys py-values
18 py-popitem py-setdefault py-update py-clear
19 py-hash-ref dict pyhash-listing
20 weak-key-dict weak-value-dict
21 py-hash-ref py-hash-set!
22 make-py-weak-key-hashtable
23 make-py-weak-value-hashtable
24 ))
25
26 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
27
28 (define (h x n) (modulo (py-hash x) n))
29 (define (py-assoc k l)
30 (if (pair? l)
31 (if (equal? (caar l) k)
32 (car l)
33 (py-assoc k (cdr l)))
34 #f))
35
36 (define (py-hash-ref . l)
37 (apply hashx-ref h py-assoc l))
38 (define (py-hash-set! . l)
39 (apply hashx-set! h py-assoc l))
40 (define (py-hash-remove! . l)
41 (apply hashx-remove! h py-assoc l))
42
43 (set! (@@ (language python def) hset!) py-hash-set!)
44
45 (define H (hash 1333674836 complexity))
46
47 (define-class <py-hashtable> () t hash n)
48
49 (name-object <py-hashtable>)
50
51 (cpit <py-hashtable>
52 (o (lambda (o h n a)
53 (slot-set! o 'hash h)
54 (slot-set! o 'n n)
55 (slot-set! o 't
56 (let ((t (make-hash-table)))
57 (let lp ((a a))
58 (if (pair? a)
59 (begin
60 (py-hash-set! t (caar a) (cdar a))
61 (lp (cdr a)))))
62 t)))
63 (let ((t (slot-ref o 't)))
64 (list
65 (slot-ref o 'hash)
66 (slot-ref o 'n)
67 (hash-fold (lambda (k v s) (cons (cons k v) s)) '() t)))))
68
69 (define (make-py-hashtable)
70 (let* ((o (make <py-hashtable>))
71 (t (make-hash-table))
72 (h H))
73 (slot-set! o 't t)
74 (slot-set! o 'hash h)
75 (slot-set! o 'n 0)
76 o))
77
78 (define (make-py-weak-key-hashtable)
79 (let* ((o (make <py-hashtable>))
80 (t (make-weak-key-hash-table))
81 (h H))
82 (slot-set! o 't t)
83 (slot-set! o 'hash h)
84 (slot-set! o 'n 0)
85 o))
86
87 (define (make-py-weak-value-hashtable)
88 (let* ((o (make <py-hashtable>))
89 (t (make-weak-value-hash-table))
90 (h H))
91 (slot-set! o 't t)
92 (slot-set! o 'hash h)
93 (slot-set! o 'n 0)
94 o))
95
96 (define miss (list 'miss))
97 (define-method (pylist-ref (o <hashtable>) x)
98 (let ((r (py-hash-ref o x miss)))
99 (if (eq? r miss)
100 (raise KeyError x)
101 r)))
102
103 (define-method (pylist-ref (o <py-hashtable>) x)
104 (let ((r (py-hash-ref (slot-ref o 't) x miss)))
105 (if (eq? r miss)
106 (aif it (ref o '__missing__)
107 (it x)
108 (raise KeyError x))
109 r)))
110
111 (define-method (pylist-delete! (o <hashtable>) k)
112 (pyhash-rem! o k))
113
114 (define-method (pylist-delete! (o <py-hashtable>) k)
115 (pyhash-rem! o k))
116
117 (define-method (py-hash (o <hashtable>))
118 (hash-fold
119 (lambda (k v s)
120 (logxor
121 (xy (py-hash k) (py-hash v))
122 s))
123 0 o))
124
125 (define-method (py-hash (o <py-hashtable>))
126 (slot-ref o 'h))
127
128 (define-method (len (o <hashtable>))
129 (hash-fold (lambda (k v s) (+ s 1)) 0 o))
130
131 (define-method (len (o <py-hashtable>))
132 (slot-ref o 'n))
133
134 (define-method (pylist-pop! (o <hashtable>) k . l)
135 (match l
136 ((v)
137 (let ((ret (py-hash-ref o k v)))
138 (py-hash-remove! o k)
139 ret))
140 (()
141 (let ((ret (hash-ref o k miss)))
142 (if (eq? ret miss)
143 (raise KeyError k)
144 (begin
145 (hash-remove! o k)
146 ret))))))
147
148 (define-method (pyhash-rem! (o <hashtable>) k)
149 (py-hash-remove! o k)
150 (values))
151
152 (define-method (pyhash-rem! (o <py-hashtable>) k)
153 (let ((t (slot-ref o 't))
154 (n (slot-ref o 'n))
155 (h (slot-ref o 'hash)))
156 (let ((ret (py-hash-ref t k miss)))
157 (if (eq? ret miss)
158 (values)
159 (begin
160 (py-hash-remove! t k)
161 (slot-set! o 'n (- n 1))
162 (slot-set! o 'hash (logxor h (xy (py-hash k) (py-hash ret))))
163 (values))))))
164
165 (define-method (pylist-pop! (o <py-hashtable>) k . l)
166 (let ((t (slot-ref o 't)))
167 (match l
168 ((v)
169 (let ((ret (py-hash-ref t k miss)))
170 (if (eq? ret miss)
171 v
172 (begin
173 (pyhash-rem! o k)
174 ret))))
175 (()
176 (let ((ret (hash-ref o k miss)))
177 (if (eq? ret miss)
178 (raise KeyError k)
179 (begin
180 (pyhash-rem! o k)
181 ret)))))))
182
183 (define-method (pylist-set! (o <hashtable>) key val)
184 (py-hash-set! o key val)
185 (values))
186
187 (define-method (pylist-set! (o <py-hashtable>) key val)
188 (let ((t (slot-ref o 't))
189 (n (slot-ref o 'n))
190 (h (slot-ref o 'hash)))
191 (let ((ret (py-hash-ref t key miss)))
192 (if (eq? ret miss)
193 (begin
194 (py-hash-set! t key val)
195 (slot-set! o 'n (+ n 1))
196 (slot-set! o 'hash (logxor (xy (py-hash key) (py-hash val)) h)))
197 (begin
198 (py-hash-set! t key val)
199 (slot-set! o 'hash
200 (logxor (xy (py-hash key) (py-hash val))
201 (logxor
202 (xy (py-hash key) (py-hash ret))
203 h)))))))
204 (values))
205
206 (define-syntax define-py
207 (syntax-rules ()
208 ((_ (nm n o l ...) (class code ...) ...)
209 (begin
210 (define-method (nm (o class) l ...) code ...)
211 ...
212 (define-method (nm (o <p>) l ...)
213 (aif it (ref o 'n)
214 (it l ...)
215 (next-method)))))
216 ((_ (nm n o l ... . u) (class code ...) ...)
217 (begin
218 (define-method (nm (o class) l ... . u) code ...)
219 ...
220 (define-method (nm (o <p>) l ... . u)
221 (aif it (ref o 'n)
222 (apply it l ... u)
223 (next-method)))))))
224
225
226 (define-method (bool (o <hashtable>))
227 (for ((k v : o)) ()
228 (break #t)
229 #:final #f))
230
231 (define-method (bool (o <py-hashtable>))
232 (not (= (len o) 0)))
233
234 (define-py (py-copy copy o)
235 (<hashtable>
236 (hash-fold
237 (lambda (k v h)
238 (py-hash-set! h k v)
239 h)
240 (make-hash-table)
241 o))
242
243 (<py-hashtable>
244 (let ((r (make <py-hashtable>)))
245 (slot-set! r 'hash (slot-ref o 'hash))
246 (slot-set! r 'n (slot-ref o 'n))
247 (slot-set! r 't (py-copy (slot-ref o 't)))
248 r)))
249
250 (define-py (py-fromkeys fromkeys o . l)
251 (<hashtable>
252 (let ((newval (match l
253 (() None)
254 ((v) v))))
255 (hash-fold
256 (lambda (k v h)
257 (py-hash-set! h k newval)
258 h)
259 (make-hash-table)
260 o)))
261
262 (<py-hashtable>
263 (let ((newval (match l
264 (() None)
265 ((v) v))))
266 (hash-fold
267 (lambda (k v h)
268 (pylist-set! h k newval)
269 h)
270 (make-py-hashtable)
271 (slot-ref o 't)))))
272
273 (define-py (py-get get o k . l)
274 (<hashtable>
275 (let ((elseval (match l
276 (() None)
277 ((v) v))))
278 (let ((ret (ref o k miss)))
279 (if (eq? ret miss)
280 elseval
281 ret))))
282
283 (<py-hashtable>
284 (let ((elseval (match l
285 (() None)
286 ((v) v))))
287 (let ((ret (ref (slot-ref o 't) k miss)))
288 (if (eq? ret miss)
289 elseval
290 ret)))))
291
292 (define-py (py-has_key has_key o k . l)
293 (<hashtable>
294 (let ((elseval (match l
295 (() None)
296 ((v) v))))
297 (let ((ret (py-hash-ref o k miss)))
298 (if (eq? ret miss)
299 #f
300 #t))))
301
302 (<py-hashtable>
303 (let ((elseval (match l
304 (() None)
305 ((v) v))))
306 (let ((ret (py-hash-ref (slot-ref o 't) k miss)))
307 (if (eq? ret miss)
308 #f
309 #t)))))
310
311 (define-py (py-items items o)
312 (<hashtable>
313 (to-pylist
314 (hash-fold
315 (lambda (k v l)
316 (cons (list k v) l))
317 '() o)))
318
319 (<py-hashtable>
320 (to-pylist
321 (hash-fold
322 (lambda (k v l)
323 (cons (list k v) l))
324 '() (slot-ref o 't)))))
325
326 (define-generator (hash-item-gen yield hash-table)
327 (let lp ((l (hash-fold cons* '() hash-table)))
328 (match l
329 ((k v . l)
330 (yield k v)
331 (lp l))
332 (()
333 #t))))
334
335 (define-generator (hash-values-gen yield hash-table)
336 (let lp ((l (hash-fold cons* '() hash-table)))
337 (match l
338 ((k v . l)
339 (yield v)
340 (lp l))
341 (()
342 #t))))
343
344 (define-generator (hash-keys-gen yield hash-table)
345 (let lp ((l (hash-fold cons* '() hash-table)))
346 (match l
347 ((k v . l)
348 (yield k)
349 (lp l))
350 (()
351 #t))))
352
353 (define-py (py-iteritems iteritems o)
354 (<hashtable>
355 (hash-item-gen o))
356
357 (<py-hashtable>
358 (hash-item-gen (slot-ref o 't))))
359
360 (define-py (py-iterkeys iterkeys o)
361 (<hashtable>
362 (hash-keys-gen o))
363
364 (<py-hashtable>
365 (hash-keys-gen (slot-ref o 't))))
366
367 (define-py (py-itervalues itervalues o)
368 (<hashtable>
369 (hash-values-gen o))
370
371 (<py-hashtable>
372 (hash-values-gen (slot-ref o 't))))
373
374 (define-py (py-keys keys o)
375 (<hashtable>
376 (to-pylist
377 (hash-fold
378 (lambda (k v l) (cons k l))
379 '()
380 o)))
381
382 (<py-hashtable>
383 (to-pylist
384 (hash-fold
385 (lambda (k v l) (cons k l))
386 '()
387 (slot-ref o 't)))))
388
389 (define-py (py-values values o)
390 (<hashtable>
391 (to-pylist
392 (hash-fold
393 (lambda (k v l) (cons v l))
394 '()
395 o)))
396
397 (<py-hashtable>
398 (to-pylist
399 (hash-fold
400 (lambda (k v l) (cons v l))
401 '()
402 (slot-ref o 't)))))
403
404 (define-py (py-popitem popitem o)
405 (<hashtable>
406 (let ((k.v (let/ec ret
407 (hash-for-each
408 (lambda (k v)
409 (ret (cons k v)))
410 o)
411 #f)))
412 (if k.v
413 (begin (pyhash-rem! o (car k.v)) k.v)
414 (raise KeyError "No elements in hash"))))
415
416 (<py-hashtable>
417 (let ((k.v (let/ec ret
418 (hash-for-each
419 (lambda (k v)
420 (ret (cons k v)))
421 (slot-ref o 't))
422 #f)))
423 (if k.v
424 (begin (pyhash-rem! o (car k.v)) k.v)
425 (raise KeyError "No elements in hash")))))
426
427 (define-py (py-setdefault setdefault o k . l)
428 (<hashtable>
429 (pylist-set! o k (apply py-get o k l)))
430 (<py-hashtable>
431 (pylist-set! o k (apply py-get o k l))))
432
433 (define update
434 (lam (o (* L) (** K))
435 (match L
436 ((L)
437 (for ((k v : L)) ()
438 (pylist-set! o k v)))
439 (_ #f))
440 (for ((k v : K)) ()
441 (pylist-set! o k v))))
442
443 (define-py (py-update update o . l)
444 (<hashtable>
445 (apply update o l))
446 (<py-hashtable>
447 (apply update o l)))
448
449 (define-py (py-clear clear o)
450 (<hashtable>
451 (hash-clear! o))
452 (<py-hashtable>
453 (let ((t (slot-ref o 't)))
454 (hash-clear! t)
455 (slot-set! o 'n 0)
456 (slot-set! o 'hash H)
457 (values))))
458
459 #|
460 'viewitems'
461 'viewkeys'
462 'viewvalues'
463 |#
464
465 (define-syntax-rule (top <)
466 (begin
467 (define-method (< (o1 <hashtable>) (o2 <hashtable>))
468 (< (len o1) (len o2)))
469 (define-method (< (o1 <hashtable>) (o2 <py-hashtable>))
470 (< (len o1) (len o2)))
471 (define-method (< (o1 <py-hashtable>) (o2 <hashtable>))
472 (< (len o1) (len o2)))
473 (define-method (< (o1 <py-hashtable>) (o2 <py-hashtable>))
474 (< (len o1) (len o2)))))
475
476 (top <)
477 (top >)
478 (top <=)
479 (top >=)
480
481 (define (fold f s l)
482 (if (pair? l)
483 (f (car l) (fold f s (cdr l)))
484 s))
485
486 (define-method (write (o <py-hashtable>) . l)
487 (define port (match l (() #f) ((p) p)))
488 (define li (hash-fold cons* '() (slot-ref o 't)))
489 (if (null? li)
490 (format port "{}")
491 (format port "{~a: ~a~{, ~a: ~a~}}" (car li) (cadr li) (cddr li))))
492
493 (define-method (py-equal? (o1 <py-hashtable>) (o2 <py-hashtable>))
494 (and
495 (equal? (slot-ref o1 'n) (slot-ref o2 'n))
496 (equal? (slot-ref o1 'hash) (slot-ref o2 'hash))
497 (e? (slot-ref o1 't) (slot-ref o2 't))))
498
499 (define (e? t1 t2)
500 (let/ec ret
501 (hash-fold
502 (lambda (k v s)
503 (let ((r (py-hash-ref t2 k miss)))
504 (if (eq? r miss)
505 (ret #f)
506 (if (equal? r v)
507 #t
508 (ret #f)))))
509 #t
510 t1)))
511
512
513 (define-class <hashiter> () l)
514 (name-object <hashiter>)
515 (cpit <hashiter> (o (lambda (o l) (slot-set! o 'l l))
516 (list (slot-ref o 'l))))
517
518
519 (define-method (wrap-in (t <hashtable>))
520 (let ((o (make <hashiter>)))
521 (slot-set! o 'l (to-list (py-items t)))
522 o))
523
524 (define-method (wrap-in (t <py-hashtable>))
525 (let ((o (make <hashiter>)))
526 (slot-set! o 'l (to-list (py-items t)))
527 o))
528
529 (define-method (next (o <hashiter>))
530 (let ((l (slot-ref o 'l)))
531 (if (pair? l)
532 (let ((k (caar l))
533 (v (cadar l))
534 (l (cdr l)))
535 (slot-set! o 'l l)
536 (values k v))
537 (throw StopIteration))))
538
539
540 (define-method (in key (o <hashtable>))
541 (py-has_key o key))
542
543 (define-method (in key (o <py-hashtable>))
544 (py-has_key o key))
545
546 (define-python-class dict (<py-hashtable>)
547 (define __init__
548 (letrec ((__init__
549 (case-lambda
550 ((self)
551 (let ((r (make-hash-table)))
552 (slot-set! self 't r)
553 (slot-set! self 'hash H)
554 (slot-set! self 'n 0)))
555 ((self x)
556 (__init__ self)
557 (catch #t
558 (lambda ()
559 (for ((k v : x)) ()
560 (pylist-set! self k v)))
561 (lambda y
562 (for ((k : x)) ()
563 (if (pair? k)
564 (pylist-set! self (car k) (cdr k))
565 (raise TypeError
566 "wrong type of argument to dict" k)))))))))
567
568 __init__)))
569
570 (define-python-class weak-key-dict (<py-hashtable>)
571 (define __init__
572 (letrec ((__init__
573 (case-lambda
574 ((self)
575 (let ((r (make-hash-table)))
576 (slot-set! self 't r)
577 (slot-set! self 'hash H)
578 (slot-set! self 'n 0)))
579
580 ((self x)
581 (__init__ self)
582 (if (is-a? x <py-hashtable>)
583 (hash-for-each
584 (lambda (k v)
585 (pylist-set! self k v))
586 (slot-ref x 't)))))))
587 __init__)))
588
589 (define-python-class weak-value-dict (<py-hashtable>)
590 (define __init__
591 (letrec ((__init__
592 (case-lambda
593 ((self)
594 (let ((r (make-hash-table)))
595 (slot-set! self 't r)
596 (slot-set! self 'hash H)
597 (slot-set! self 'n 0)))
598
599 ((self x)
600 (__init__ self)
601 (if (is-a? x <py-hashtable>)
602 (hash-for-each
603 (lambda (k v)
604 (pylist-set! self k v))
605 (slot-ref x 't)))))))
606 __init__)))
607
608 (define (pyhash-listing)
609 (let ((l (to-pylist
610 (map symbol->string
611 '(__class__ __cmp__ __contains__ __delattr__
612 __delitem__ __doc__ __eq__ __format__
613 __ge__ __getattribute__ __getitem__
614 __gt__ __hash__ __init__ __iter__
615 __le__ __len__ __lt__ __ne__ __new__
616 __reduce__ __reduce_ex__ __repr__
617 __setattr__ __setitem__ __sizeof__
618 __str__ __subclasshook__
619 clear copy fromkeys get has_key
620 items iteritems iterkeys itervalues
621 keys pop popitem setdefault update
622 values viewitems viewkeys viewvalues)))))
623 (pylist-sort! l)
624 l))
625
626
627 (define-method (py-class (o <hashtable>)) dict)
628 (define-method (py-class (o <py-hashtable>)) dict)