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