further improvements following python3 spec

[software/python-on-guile.git] / modules / language / python / dict.scm

(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 bool)
  #:use-module (language python exceptions)
  #:use-module (language python persist)
  #:use-module (ice-9 match)
  #:use-module (ice-9 control)
  #:use-module (oop goops)
  #:use-module (oop pf-objects)  
  #:export (make-py-hashtable <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 py-clear
            py-hash-ref dict pyhash-listing
            weak-key-dict weak-value-dict
            py-hash-ref py-hash-set!
            make-py-weak-key-hashtable
            make-py-weak-value-hashtable
            ))

(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))

(define (h x n) (modulo (py-hash x) n))
(define (py-assoc k l)
  (if (pair? l)
      (if (equal? (caar l) k)
          (car l)
          (py-assoc k (cdr l)))
      #f))

(define (py-hash-ref . l)
  (apply hashx-ref h py-assoc l))
(define (py-hash-set! . l)
  (apply hashx-set! h py-assoc l))
(define (py-hash-remove! . l)
  (apply hashx-remove! h py-assoc l))

(set! (@@ (language python def) hset!) py-hash-set!)

(define H (hash 1333674836 complexity))

(define-class <py-hashtable> () t hash n)

(name-object <py-hashtable>)

(cpit <py-hashtable>
      (o (lambda (o h n a)
           (slot-set! o 'hash h)
           (slot-set! o 'n n)
           (slot-set! o 't
                      (let ((t (make-hash-table)))
                        (let lp ((a a))
                          (if (pair? a)
                              (begin
                                (py-hash-set! t (caar a) (cdar a))
                                (lp (cdr a)))))
                        t)))
         (let ((t (slot-ref o 't)))
           (list
            (slot-ref o 'hash)
            (slot-ref o 'n)
            (hash-fold (lambda (k v s) (cons (cons k v) s)) '() t)))))

(define (make-py-hashtable)
  (let* ((o (make <py-hashtable>))
         (t (make-hash-table))
         (h H))
    (slot-set! o 't    t)
    (slot-set! o 'hash h)
    (slot-set! o 'n    0)
    o))

(define (make-py-weak-key-hashtable)
  (let* ((o (make <py-hashtable>))
         (t (make-weak-key-hash-table))
         (h H))
    (slot-set! o 't    t)
    (slot-set! o 'hash h)
    (slot-set! o 'n    0)
    o))

(define (make-py-weak-value-hashtable)
  (let* ((o (make <py-hashtable>))
         (t (make-weak-value-hash-table))
         (h H))
    (slot-set! o 't    t)
    (slot-set! o 'hash 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)
        (aif it (ref o '__missing__)
             (it x)
             (raise KeyError x))
        r)))

(define-method (pylist-delete! (o <hashtable>) k)
  (pyhash-rem! o k))

(define-method (pylist-delete! (o <py-hashtable>) k)
  (pyhash-rem! o k))

(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 'hash)))
    (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 'hash (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 'hash)))
    (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 'hash (logxor (xy (py-hash key) (py-hash val)) h)))
          (begin
            (py-hash-set! t key val)
            (slot-set! o 'hash
                       (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 ...)
         (aif it (ref o 'n)
              (it l ...)
              (next-method)))))
    ((_ (nm n o l ... . u) (class code ...) ...)
     (begin
       (define-method (nm (o class) l ... . u) code ...)
       ...
       (define-method (nm (o   <p>) l ... . u)
         (aif it (ref o 'n) 
              (apply it l ... u)
              (next-method)))))))


(define-method (bool (o <hashtable>))
  (for ((k v : o)) ()
       (break #t)
       #:final #f))

(define-method (bool (o <py-hashtable>))
  (not (= (len o) 0)))

(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 'hash (slot-ref o 'hash))
     (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 (ref o k miss)))
       (if (eq? ret miss)
           elseval
           ret))))

  (<py-hashtable>
   (let ((elseval (match l
                    (()  None)
                    ((v) v))))
     (let ((ret (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)))

(define-py (py-clear clear o)
  (<hashtable>
   (hash-clear! o))
  (<py-hashtable>
   (let ((t (slot-ref o 't)))
     (hash-clear! t)
     (slot-set! o 'n 0)
     (slot-set! o 'hash H)
     (values))))

#|        
'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 (py-equal? (o1 <py-hashtable>) (o2 <py-hashtable>))
  (and
   (equal? (slot-ref o1 'n)    (slot-ref o2 'n))
   (equal? (slot-ref o1 'hash) (slot-ref o2 'hash))
   (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)
(name-object <hashiter>)
(cpit <hashiter> (o (lambda (o l) (slot-set! o 'l l))
                    (list (slot-ref o '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))))
           

(define-method (in key (o <hashtable>))
  (py-has_key o key))

(define-method (in key (o <py-hashtable>))
  (py-has_key o key))

(define-python-class dict (<py-hashtable>)
  (define __init__
    (letrec ((__init__
              (case-lambda
                ((self)
                 (let ((r (make-hash-table)))
                   (slot-set! self 't    r)
                   (slot-set! self 'hash H)
                   (slot-set! self 'n    0)))
                ((self x)
                 (__init__ self)           
                 (catch #t
                   (lambda ()
                     (for ((k v : x)) ()
                          (pylist-set! self k v)))
                   (lambda y
                     (for ((k : x)) ()
                          (if (pair? k)
                              (pylist-set! self (car k) (cdr k))
                              (raise TypeError
                                     "wrong type of argument to dict" k)))))))))

      __init__)))

(define-python-class weak-key-dict (<py-hashtable>)
  (define __init__
    (letrec ((__init__
              (case-lambda
                ((self)
                 (let ((r (make-hash-table)))
                   (slot-set! self 't    r)
                   (slot-set! self 'hash H)
                   (slot-set! self 'n    0)))
                
                ((self x)
                 (__init__ self)
                 (if (is-a? x <py-hashtable>)
                     (hash-for-each
                      (lambda (k v)
                        (pylist-set! self k v))
                      (slot-ref x 't)))))))
      __init__)))

(define-python-class weak-value-dict (<py-hashtable>)
  (define __init__
    (letrec ((__init__
              (case-lambda
                ((self)
                 (let ((r (make-hash-table)))
                   (slot-set! self 't    r)
                   (slot-set! self 'hash H)
                   (slot-set! self 'n    0)))

                ((self x)
                 (__init__ self)
                 (if (is-a? x <py-hashtable>)
                     (hash-for-each
                      (lambda (k v)
                        (pylist-set! self k v))
                      (slot-ref x 't)))))))
      __init__)))

(define (pyhash-listing)
  (let ((l (to-pylist
            (map symbol->string
                 '(__class__ __cmp__ __contains__ __delattr__
                             __delitem__ __doc__ __eq__ __format__
                             __ge__ __getattribute__ __getitem__
                             __gt__ __hash__ __init__ __iter__
                             __le__ __len__ __lt__ __ne__ __new__
                             __reduce__ __reduce_ex__ __repr__
                             __setattr__ __setitem__ __sizeof__
                             __str__ __subclasshook__
                             clear copy fromkeys get has_key
                             items iteritems iterkeys itervalues
                             keys pop popitem setdefault update
                             values viewitems viewkeys viewvalues)))))
    (pylist-sort! l)
    l))
       
  
(define-method (py-class (o <hashtable>))    dict)
(define-method (py-class (o <py-hashtable>)) dict)