From 585c88ec19c58929f8f621b9a8522df7f31d1e68 Mon Sep 17 00:00:00 2001
From: Stefan Israelsson Tampe <stefan.itampe@gmail.com>
Date: Sat, 23 Sep 2017 22:18:40 +0200
Subject: dicts implementation

---
 modules/language/python/dict.scm | 451 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 451 insertions(+)
 create mode 100644 modules/language/python/dict.scm

(limited to 'modules/language/python/dict.scm')

diff --git a/modules/language/python/dict.scm b/modules/language/python/dict.scm
new file mode 100644
index 0000000..5442720
--- /dev/null
+++ b/modules/language/python/dict.scm
@@ -0,0 +1,451 @@
+(define-module (language python dict)
+  #:use-module (language python list)
+  #:use-module (language python try)
+  #:use-module (language python hash)
+  #:use-module (language python yield)
+  #:use-module (language python def)
+  #:use-module (language python for)
+  #:use-module (language python exceptions)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 control)
+  #:use-module (oop goops)
+  #:use-module (oop pf-objects)  
+  #:export (make-py-hashtable
+            py-copy py-fromkeys py-get py-has_key py-items py-iteritems
+            py-iterkeys py-itervalues py-keys py-values
+            py-popitem py-setdefault py-update
+            ))
+
+(define (h x n) (modulo (py-hash x) n))
+
+(define (py-hash-ref . l)
+  (apply hashx-ref h assoc l))
+(define (py-hash-set! . l)
+  (apply hashx-set! h assoc l))
+(define (py-hash-remove! . l)
+  (apply hashx-remove! h assoc l))
+
+(set! (@@ (language python def) hset!) py-hash-set!)
+
+(define H (hash 1333674836 complexity))
+
+(define-class <py-hashtable> () t h n)
+(define (make-py-hashtable)
+  (let* ((o (make <py-hashtable>))
+         (t (make-hash-table))
+         (h H))
+    (slot-set! o 't    t)
+    (slot-set! o 'h    h)
+    (slot-set! o 'n    0)
+    o))
+
+(define miss (list 'miss))
+(define-method (pylist-ref (o <hashtable>) x)
+  (let ((r (py-hash-ref o x miss)))
+    (if (eq? r miss)
+        (raise KeyError x)
+        r)))
+
+(define-method (pylist-ref (o <py-hashtable>) x)
+  (let ((r (py-hash-ref (slot-ref o 't) x miss)))
+    (if (eq? r miss)
+        (raise KeyError x)
+        r)))
+
+(define-method (py-hash (o <hashtable>))
+  (hash-fold
+   (lambda (k v s)
+     (logxor
+      (xy (py-hash k) (py-hash v))
+      s))
+   0 o))
+
+(define-method (py-hash (o <py-hashtable>))
+  (slot-ref o 'h))
+
+(define-method (len (o <hashtable>))
+  (hash-fold (lambda (k v s) (+ s 1)) 0 o))
+
+(define-method (len (o <py-hashtable>))
+  (slot-ref o 'n))
+
+(define-method (pylist-pop! (o <hashtable>) k . l)
+  (match l
+    ((v)
+     (let ((ret (py-hash-ref o k v)))
+       (py-hash-remove! o k)
+       ret))
+    (()
+     (let ((ret (hash-ref o k miss)))
+       (if (eq? ret miss)
+           (raise KeyError k)
+           (begin
+             (hash-remove! o k)
+             ret))))))
+
+(define-method (pyhash-rem! (o <hashtable>) k)
+  (py-hash-remove! o k)
+  (values))
+
+(define-method (pyhash-rem! (o <py-hashtable>) k)
+  (let ((t (slot-ref o 't))
+        (n (slot-ref o 'n))
+        (h (slot-ref o 'h)))
+    (let ((ret (py-hash-ref t k miss)))
+      (if (eq? ret miss)
+          (values)
+          (begin
+            (py-hash-remove! t k)
+            (slot-set! o 'n (- n 1))
+            (slot-set! o 'h (logxor h (xy (py-hash k) (py-hash ret))))
+            (values))))))
+
+(define-method (pylist-pop! (o <py-hashtable>) k . l)
+  (let ((t (slot-ref o 't)))
+    (match l
+      ((v)
+       (let ((ret (py-hash-ref t k miss)))
+         (if (eq? ret miss)
+             v
+             (begin
+               (pyhash-rem! o k)
+               ret))))
+      (()
+       (let ((ret (hash-ref o k miss)))
+         (if (eq? ret miss)
+             (raise KeyError k)
+             (begin
+               (pyhash-rem! o k)
+               ret)))))))
+
+(define-method (pylist-set! (o <hashtable>) key val)
+  (py-hash-set! o key val)
+  (values))
+
+(define-method (pylist-set! (o <py-hashtable>) key val)
+  (let ((t (slot-ref o 't))
+        (n (slot-ref o 'n))
+        (h (slot-ref o 'h)))
+    (let ((ret (py-hash-ref t key miss)))
+      (if (eq? ret miss)
+          (begin
+            (py-hash-set! t key val)            
+            (slot-set! o 'n (+ n 1))
+            (slot-set! o 'h (logxor (xy (py-hash key) (py-hash val)) h)))
+          (begin
+            (py-hash-set! t key val)
+            (slot-set! o 'h
+                       (logxor (xy (py-hash key) (py-hash val))
+                               (logxor
+                                (xy (py-hash key) (py-hash ret))
+                                h)))))))
+  (values))
+
+(define-syntax define-py
+  (syntax-rules ()
+    ((_ (nm n o l ...) (class code ...) ...)
+     (begin
+       (define-method (nm (o class) l ...) code ...)
+       ...
+       (define-method (nm (o   <p>) l ...)
+         ((ref o 'n) l ...))))
+    ((_ (nm n o l ... . u) (class code ...) ...)
+     (begin
+       (define-method (nm (o class) l ... . u) code ...)
+       ...
+       (define-method (nm (o   <p>) l ... . u)
+         (apply (ref o 'n) l ... u))))))
+                                      
+                      
+
+(define-py (py-copy copy o)
+  (<hashtable>
+   (hash-fold
+    (lambda (k v h)
+      (py-hash-set! h k v)
+      h)
+    (make-hash-table)
+    o))
+
+  (<py-hashtable>
+   (let ((r (make <py-hashtable>)))
+     (slot-set! r 'h (slot-ref o 'h))
+     (slot-set! r 'n (slot-ref o 'n))
+     (slot-set! r 't (py-copy (slot-ref o 't)))
+     r)))
+
+(define-py (py-fromkeys fromkeys o . l)
+  (<hashtable>
+   (let ((newval (match l
+                   (()  None)
+                   ((v) v))))
+     (hash-fold
+      (lambda (k v h)
+        (py-hash-set! h k newval)
+        h)
+      (make-hash-table)
+      o)))
+
+  (<py-hashtable>
+   (let ((newval (match l
+                   (()  None)
+                   ((v) v))))
+     (hash-fold
+      (lambda (k v h)
+        (pylist-set! h k newval)
+         h)
+      (make-py-hashtable)
+      (slot-ref o 't)))))
+
+(define-py (py-get get o k . l)
+  (<hashtable>
+   (let ((elseval (match l
+                    (()  None)
+                    ((v) v))))
+     (let ((ret (py-hash-ref o k miss)))
+       (if (eq? ret miss)
+           elseval
+           ret))))
+
+  (<py-hashtable>
+   (let ((elseval (match l
+                    (()  None)
+                    ((v) v))))
+     (let ((ret (py-hash-ref (slot-ref o 't) k miss)))
+       (if (eq? ret miss)
+           elseval
+           ret)))))
+
+(define-py (py-has_key has_key o k . l)
+  (<hashtable>
+   (let ((elseval (match l
+                    (()  None)
+                    ((v) v))))
+     (let ((ret (py-hash-ref o k miss)))
+       (if (eq? ret miss)
+           #f
+           #t))))
+
+  (<py-hashtable>
+   (let ((elseval (match l
+                   (()  None)
+                   ((v) v))))
+     (let ((ret (py-hash-ref (slot-ref o 't) k miss)))
+       (if (eq? ret miss)
+           #f
+           #t)))))
+
+(define-py (py-items items o)
+  (<hashtable>
+   (to-pylist
+    (hash-fold
+     (lambda (k v l)
+       (cons (list k v) l))
+     '() o)))
+   
+  (<py-hashtable>
+   (to-pylist
+    (hash-fold
+     (lambda (k v l)
+       (cons (list k v) l))
+     '() (slot-ref o 't)))))
+  
+(define-generator (hash-item-gen yield hash-table)
+  (let lp ((l (hash-fold cons* '() hash-table)))
+    (match l
+      ((k v . l)
+       (yield k v)
+       (lp l))
+      (()
+       #t))))
+
+(define-generator (hash-values-gen yield hash-table)
+  (let lp ((l (hash-fold cons* '() hash-table)))
+    (match l
+      ((k v . l)
+       (yield v)
+       (lp l))
+      (()
+       #t))))
+
+(define-generator (hash-keys-gen yield hash-table)
+  (let lp ((l (hash-fold cons* '() hash-table)))
+    (match l
+      ((k v . l)
+       (yield k)
+       (lp l))
+      (()
+       #t))))
+      
+(define-py (py-iteritems iteritems o)
+  (<hashtable>
+   (hash-item-gen o))
+  
+  (<py-hashtable>
+   (hash-item-gen (slot-ref o 't))))
+
+(define-py (py-iterkeys iterkeys o)
+  (<hashtable>
+   (hash-keys-gen o))
+  
+  (<py-hashtable>
+   (hash-keys-gen (slot-ref o 't))))
+
+(define-py (py-itervalues itervalues o)
+  (<hashtable>
+   (hash-values-gen o))
+  
+  (<py-hashtable>
+   (hash-values-gen (slot-ref o 't))))
+
+(define-py (py-keys keys o)
+  (<hashtable>
+   (to-pylist
+    (hash-fold
+     (lambda (k v l) (cons k l))
+     '()
+     o)))
+
+  (<py-hashtable>
+   (to-pylist
+    (hash-fold
+     (lambda (k v l) (cons k l))
+     '()
+     (slot-ref o 't)))))
+
+(define-py (py-values values o)
+  (<hashtable>
+   (to-pylist
+    (hash-fold
+     (lambda (k v l) (cons v l))
+     '()
+     o)))
+
+  (<py-hashtable>
+   (to-pylist
+    (hash-fold
+     (lambda (k v l) (cons v l))
+     '()
+     (slot-ref o 't)))))
+
+(define-py (py-popitem popitem o)
+  (<hashtable>
+   (let ((k.v (let/ec ret
+                (hash-for-each
+                 (lambda (k v)
+                   (ret (cons k v)))
+                 o)
+                #f)))
+     (if k.v
+         (begin (pyhash-rem! o (car k.v)) k.v)
+         (raise KeyError "No elements in hash"))))
+     
+  (<py-hashtable>
+      (let ((k.v (let/ec ret
+                   (hash-for-each
+                    (lambda (k v)
+                      (ret (cons k v)))
+                    (slot-ref o 't))
+                   #f)))
+        (if k.v
+            (begin (pyhash-rem! o (car k.v)) k.v)
+            (raise KeyError "No elements in hash")))))
+
+(define-py (py-setdefault setdefault o k . l)
+  (<hashtable>
+   (pylist-set! o k (apply py-get o k l)))
+  (<py-hashtable>
+   (pylist-set! o k (apply py-get o k l))))
+
+(define update
+  (lam (o (* L) (** K))
+       (match L
+         ((L)
+          (for ((k v : L)) ()
+               (pylist-set! o k v)))
+         (_ #f))
+       (for ((k v : K)) ()
+            (pylist-set! o k v))))
+
+(define-py (py-update update o . l)
+  (<hashtable>
+   (apply update o l))
+  (<py-hashtable>
+   (apply update o l)))
+
+#|        
+'viewitems'
+'viewkeys'
+'viewvalues'
+|#
+
+(define-syntax-rule (top <)
+  (begin
+    (define-method (< (o1 <hashtable>) (o2 <hashtable>))
+      (< (len o1) (len o2)))
+    (define-method (< (o1 <hashtable>) (o2 <py-hashtable>))
+      (< (len o1) (len o2)))
+    (define-method (< (o1 <py-hashtable>) (o2 <hashtable>))
+      (< (len o1) (len o2)))
+    (define-method (< (o1 <py-hashtable>) (o2 <py-hashtable>))
+      (< (len o1) (len o2)))))
+
+(top <)
+(top >)
+(top <=)
+(top >=)
+
+(define (fold f s l)
+  (if (pair? l)
+      (f (car l) (fold f s (cdr l)))
+      s))
+
+(define-method (write (o <py-hashtable>) . l)
+  (define port (match l (() #f) ((p) p)))
+  (define li (hash-fold cons* '() (slot-ref o 't)))              
+  (if (null? li)
+      (format port "{}") 
+      (format port "{~a: ~a~{, ~a: ~a~}}" (car li) (cadr li) (cddr li))))
+
+(define-method (equal? (o1 <py-hashtable>) (o2 <py-hashtable>))
+  (and
+   (equal? (slot-ref o1 'n) (slot-ref o2 'n))
+   (equal? (slot-ref o1 'h) (slot-ref o2 'h))
+   (e?     (slot-ref o1 't) (slot-ref o2 't))))
+
+(define (e? t1 t2)
+  (let/ec ret
+    (hash-fold
+     (lambda (k v s)
+       (let ((r (py-hash-ref t2 k miss)))
+         (if (eq? r miss)
+             (ret #f)
+             (if (equal? r v)
+                 #t
+                 (ret #f)))))
+     #t
+     t1)))
+
+
+(define-class <hashiter> () l)
+
+(define-method (wrap-in (t <hashtable>))
+  (let ((o (make <hashiter>)))
+    (slot-set! o 'l (to-list (py-items t)))
+    o))
+
+(define-method (wrap-in (t <py-hashtable>))
+  (let ((o (make <hashiter>)))
+    (slot-set! o 'l (to-list (py-items t)))
+    o))
+
+(define-method (next (o <hashiter>))
+  (let ((l (slot-ref o 'l)))
+    (if (pair? l)
+        (let ((k (caar  l))
+              (v (cadar l))
+              (l (cdr   l)))
+          (slot-set! o 'l l)
+          (values k v))
+        (throw StopIteration))))
+           
-- 
cgit v1.2.3