path: root/modules/language/python/module/collections.scm

(define-module (language python module collections)
  #:use-module (ice-9 control)
  #:use-module (ice-9 pretty-print)
  #:use-module (oop pf-objects)
  #:use-module (oop goops)
  #:use-module (language python module collections abc)
  #:use-module (language python module heapq)
  #:use-module (language python for)
  #:use-module (language python try)
  #:use-module (language python yield)
  #:use-module (language python def)
  #:use-module (language python list)
  #:use-module (language python string)
  #:use-module (language python dict)
  #:use-module (language python def)
  #:use-module (language python set)
  #:use-module (language python range)
  #:use-module (language python module)
  #:use-module (language python exceptions)
  #:use-module (language python module keyword)
  #:use-module ((language python module python)
		#:select ((map . pymap) isinstance reversed classmethod iter
			  any repr property super sorted
			  enumerate (map . py-map)))

  #:use-module ((language python module operator)
		#:select (itemgetter))
  
  #:re-export (Container Hashable Iterable Iterator Reversable Generator
			 Sized Callable Collection Sequence MutableSequence
			 ByteString Set MutableSet Mapping MutableMapping
			 MappingView ItemsView KeysView ValuesView)

  #:export (OrderedDict ChainMap Counter UserDict UserString UserList
			namedtuple defaultdict deque))

#|
* namedtuple   factory function for creating tuple subclasses with named fields
* deque        list-like container with fast appends and pops on either end
* ChainMap     dict-like class for creating a single view of multiple mappings
* Counter      dict subclass for counting hashable objects
* OrderedDict  dict subclass that remembers the order entries were added
* defaultdict  dict subclass that calls a factory function to supply missing values
* UserDict     wrapper around dictionary objects for easier dict subclassing
* UserList     wrapper around list objects for easier list subclassing
* UserString   wrapper around string objects for easier string subclassing
|#

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

(define (py-add! o k) ((ref o 'add) k))

(define-python-class _OrderedDictKeysView (KeysView)
  (define __reversed__
    (lambda (self)
      ((make-generator ()
         (lambda (yield)
	   (for ((k v : (reversed (ref self '_mapping)))) ()
		(yield k))))))))

(define-python-class _OrderedDictValuesView (ValuesView)
  (define __reversed__
    (lambda (self)
      ((make-generator ()
         (lambda (yield)
	   (for ((k v : (reversed (ref self '_mapping)))) ()
		(yield v))))))))

(define-python-class _OrderedDictItemsView (ItemsView)
  (define __reversed__
    (lambda (self)
      ((make-generator ()
         (lambda (yield)
	   (for ((k v : (reversed (ref self '_mapping)))) ()
		(yield (list k v)))))))))

(define-inlinable (link) (vector 0 0 0))
(define-inlinable (get-prev  l  ) (vector-ref  l 0))
(define-inlinable (get-last  l  ) (vector-ref  l 0))
(define-inlinable (get-first l  ) (vector-ref  l 1))
(define-inlinable (get-next  l  ) (vector-ref  l 1))
(define-inlinable (get-key   l  ) (vector-ref  l 2))
(define-inlinable (set-prev! l v) (vector-set! l 0 v))
(define-inlinable (set-next! l v) (vector-set! l 1 v))
(define-inlinable (set-key!  l v) (vector-set! l 2 v))

(define <dict> `(,<py-hashtable> . _))
(define dict-set!   (resolve-method-g pylist-set!    <dict>))
(define dict-ref    (resolve-method-g pylist-ref     <dict>))
(define dict-del!   (resolve-method-g pylist-delete! <dict>))
(define dict-pop!   (resolve-method-g pylist-pop!    <dict>))
(define dict-clear! (resolve-method-g py-clear       <dict>))

(define-python-class OrderedDict (dict)
  (define __init__
    (lam (self (* args) (** kwds))
	 (if (> (len args)  1)
	     (raise TypeError
		    (format #f
			    "expected at most 1 arguments, got ~a"
			    (len args))))
	
	 (try
	  (lambda () (ref self '__root))
	  (#:except AttributeError =>
		    (lambda x
		      (let* ((l (link)))
			(set self '__root l)
			(set-next! l l)
			(set-prev! l l)))))
	
	 (set self '__map (dict))
	 (py-apply py-update self (* args) (** kwds))))

  (define __setitem__
    (lam (self key value
	       (= dict_setitem dict-set!)
	       (= proxy        #f)
	       (= link         link))	 
     (if (in key self)
	 (let* ((link (link))
		(root (ref self '__root))
		(last (get-last root)))
	   (pylist-set! (ref self '__map) key link)
	   (set-prev! link last)
	   (set-next! link root)
	   (set-key!  link key)
           (set-next! last link)
           (set-prev! root link)
	   (dict_setitem self key value)))))

  (define __delitem__
    (lam (self key (= dict_delitem dict-del!))
      (let ((link (pylist-pop! (ref self '__map) key))
	    (link_prev (get-prev link))
	    (link_next (get-next link)))
	(set-next! link_prev link_next)
	(set-prev! link_next link_prev)
	(set-next! link None)
	(set-prev! link None))))
  
  (define __iter__
    (lam (self (= get-next get-next))
      ((make-generator ()
        (lambda (yield)
	  (let ((root (ref self '__root)))
	    (let lp ((curr (get-next root)))
	      (if ((not (eq? curr root)))
		  (let ((key (get-key curr)))
		    (yield key (pylist-ref self key))
		    (lp (get-next curr)))))))))))

  (define __reversed__
    (lambda (self)
      (__iter__ self #:get-next get-prev)))
  
  (define clear
    (lambda (self)
      (let ((root (ref self '__root)))
	(set-prev! root root)
	(set-next! root root)
	
        (py-clear (ref self '__map))
        (dict-clear! self))))

  (define popitem
    (lam (self (= last #t))
      (if (= (len self) 0)
	  (raise KeyError "dictionary is empty"))
      (let ((root (ref self '__root)))	
        (let* ((link
		(if last
		    (let* ((link (get-prev root))
			   (prev (get-prev link)))	      
		      (set-next! prev root)
		      (set-prev! root prev)
		      link)
		    (let* ((link (get-next root))
			   (prev (get-next link)))	      
		      (set-prev! prev root)
		      (set-next! root prev)
		      link)))
	       (key (get-key link)))
	  (dict-del! (ref self '__map) key)
	  (values key
		  (dict-pop! self key))))))
  
  (define move_to_end
    (lam (self key (= last #t))
      (let* ((link (pylist-ref (ref self '__map) key))
	     (prev (get-prev link))
	     (next (get-next link)))
        (set-next! prev next)
        (set-prev! next prev)
        (let ((root (ref self '__root)))
	  (if last
	      (let ((last (get-prev root)))
		(set-prev! link last)
		(set-next! link root)
		(set-prev! root link)
		(set-next! last link))
	      (let ((first (get-next root)))
		(set-prev! link  root)
		(set-next! link  first)
		(set-prev! first link)
		(set-next! root  link)))))))

  (define update   (ref MutableMapping 'update))
  (define __update update)

  (define keys
    (lambda (self) _OrderedDictKeysView(self)))
  (define items
    (lambda (self) _OrderedDictItemsView(self)))
  (define values
    (lambda (self) _OrderedDictValuesView(self)))

  (define __ne__ (ref MutableMapping '__ne__))

  (define __marker (object))

  (define pop
    (lam (self key (= default __marker))
      (if (in key self)
	  (let ((result (dict-ref self key)))
	    (__delitem__ self key)
	    result)  
	  (if (eq? default __marker)
	      (raise KeyError key)
	      default))))

  (define setdefault
    (lam (self key (= default None))
       (if (in key self)
	   (dict-ref self key)
	   (begin
	     (__setitem__ self key default)
	     default))))
  
  (define copy
    (lambda (self)
      ((ref self '__class__) self)))

  (define fromkeys
    (classmethod 
     (lam (cls iterable (= value None))
	  (let ((self (cls)))
	    (for ((key : iterable)) ()
		 (__setitem__ self key value))
	    self))))
  
  (define __eq__
    (lambda (self other)
      (if (isinstance other OrderedDict)
	  (and (for ((k1 v1 : self) (k2 v2 : other)) ()
		    (if (not (equal? k1 k2))
			(break #f))
		    #:final #t)
	       (equal? (ref self '_mapping) (ref other '_mapping)))
	  (equal? (ref self '_mapping) other)))))
	       



(define (u self)
  (let ((s (py-set)))
    (apply (ref s 'union) (ref self 'maps))
    s))

(define-python-class ChainMap (MutableMapping)
  (define __init__
    (lambda (self . l)
      (set self 'maps
	   (if (null? l)
	       (list (dict))
	       l))))

  (define __getitem__
    (lambda (self key)
      (let/ec ret
	 (let lp ((l (ref self 'maps)))
	   (if (pair? l)
	       (let ((m (car l)))
		 (if (in key m)
		     (pylist-ref m key)
		     (lp (cdr l))))
	       (raise (KeyError key)))))))
  

  (define get
    (lambda* (self key #:key (default None))
      (if (in key self)
	  (pylist-ref self key)
	  default)))

  (define __len__
    (lambda (self)
      (len (u self))))
  

  (define __iter__
    (lambda (self)
      (iter (u self))))

  (define __contains__
    (lambda (self key)
      (for ((m : (ref self 'maps))) ()
	   (if (in key m)
	       (break #t))
	   #:final #f)))
  
  (define __bool__
    (lambda (self)
      (any (ref self 'maps))))

  (define __repr__
    (lambda (self)
      (let ((l (map (lambda (x) (repr x)) (ref self 'maps))))
	(format #f "~a(~a,~{,~a~})"
		(ref (ref self '__class__) '__name__)
		(car l)
		(cdr l)))))

  (define fromkeys
    (class-method
     (lambda (cls iter . args)
       (apply cls (for ((x : iter)) ((l '()))
		       (cons (apply py-fromkeys x args) l)
		       
		       #:final
		       (reverse l))))))

  (define copy
    (lambda (self)
      (let ((maps (ref self 'maps)))
	(apply (ref self '__class__) (copy (car maps)) (cdr maps)))))

  (define __copy__
    (lambda (self)
      ((ref self 'copy))))

  (define new_child
    (lambda* (self #:optional (r #f))
	     (apply (ref self '__class__) (if r r (set)) (ref self 'maps))))

  (define parents
    (property
     (lambda (self)
       (apply (ref self '__class__) (cdr (ref self 'maps))))))
  
  (define __setitem__
    (lambda (self key value)
      (pylist-set! (car (ref self 'maps)) key value)))
    

  (define __delitem__
    (lambda (self key)
      (try
       (lambda () (pylist-delete! (car (ref self 'maps))))
       (#:except KeyError =>
	 (lambda x
	   (raise KeyError
		  (format #f "Key not found in the first mapping: ~a" key)))))))

  (define popitem
    (lambda (self)
      (try
       (lambda () (popitem (car (ref self 'maps))))	 
       (#:except KeyError =>
        (lambda x
	  (raise KeyError "No keys found in the first mapping"))))))

  (define pop
    (lambda (self key . args)
      (try
       (lambda () (apply pylist-pop! (car (ref self 'maps)) args))
       (#:except KeyError =>
	(lambda x
	 (raise KeyError
		(format #f "Key not found in the first mapping: ~ a" key)))))))

  (define clear
    (lambda (self)
      (py-clear (car (ref self 'maps))))))

(define-python-class Counter (dict)
  (define __init__
    (lam (self (* args) (** kwds))
        (if (> (length args) 1)
            (raise TypeError
		   (format
		    #f
		    "expected at most 1 arguments, got ~a"
		    (length  args))))
        ((ref (super Counter self) '__init__))
        (py-apply py-update self (* args) (** kwds))))

  (define __missing__
    (lambda (self key) 0))

  (define most_common
    (lambda* (self #:key (n None))
       (if (eq? n None)
            (sorted ((ref self 'items) #:key (itemgetter 1) #:reverse #t))
	    (nlargest n (py-items self) #:key (itemgetter 1)))))

  (define elements
    (lambda (self)
      ((make-generator ()
	 (for ((k v : self)) ()
	      (if (and (number? v) (integer? v) (> v 0))
		  (for ((i : (range v))) ()
		       (yield k))))))))

  (define fromkeys
    (lambda x
      (raise NotImplementedError)))
    
  
  (define update
    (lam (self (* args) (** kwds))
	 (if (> (len args) 1)
	     (raise TypeError
		    (format #f "expected at most 1 arguments, got ~a"
			    (len args))))

	 (if (= (len args) 1)
	     (let ((iterable (iter (car args))))
	       (if (not (eq? iterable None))
		   (if (isinstance iterable <py-hashtable>)
		       (for ((elem count : iterable)) ()
			    (pylist-set! self elem
					 (+ count (py-get self elem 0))))
		       (for ((k : iterable)) ()
			    (pylist-set! self k
					 (+ 1 (py-get self k 0))))))))
        
	 (for ((k count : kwds)) ()
	      (pylist-set! self k
			   (+ count (py-get self k 0))))))
  (define subtracts
    (lam (self (* args) (** kwds))
	 (if (> (len args) 1)
	     (raise TypeError
		    (format #f "expected at most 1 arguments, got ~a"
			    (len args))))

	 (let ((iterable (py-get args 0 None)))
	   (if (not (eq? iterable None))
	       (if (isinstance iterable <py-hashtable>)
		   (for ((elem count : iterable)) ()
			(pylist-set! self elem
				     (- (py-get self elem 0) count)))
		   (for ((elem : iterable)) ()
			(pylist-set! self elem
				     (- (py-get self elem 0) 1))))))
	        
	(for ((k v : kwds)) ()
	     (pylist-set! self k
			  (- (py-get self k 0) v)))))

  (define __delitem__
    (lambda (self k)
      (if (in k self)
	  ((ref dict '__delitem__) k))))


  (define __add__
    (lambda (self other)
      (if (not (isinstance other Counter))
	  NotImplemented
	  (let ((result (Counter)))	    
	    (for ((elem count : self)) ()
		 (let ((newcount (+ count (pylist-ref other elem))))
		   (if (> newcount 0)
		       (pylist-set! result elem newcount))))
	    
	    (for ((elem count : other)) ()
		 (if (and (not (in elem self))
			  (> count 0))
		     (pylist-set! result elem count)))
	    
	    result))))

  (define __sub__
    (lambda (self other)
      (if (not (isinstance other Counter))
	  NotImplemented
	  (let ((result (Counter)))	    
	    (for ((elem count : self)) ()
		 (let ((newcount (- count (pylist-ref other elem))))
		   (if (> newcount 0)
		       (pylist-set! result elem newcount))))
	    
	    (for ((elem count : other)) ()
		 (if (and (not (in elem self))
			  (> count 0))
		     (pylist-set! result elem (- count))))
	    
	    result))))

  (define __or__
    (lambda (self other)
      (if (not (isinstance other Counter))
	  NotImplemented
	  (let ((result (Counter)))	    
	    (for ((elem count : self)) ()
		 (let ((newcount (max count (pylist-ref other elem))))
		   (if (> newcount 0)
		       (pylist-set! result elem newcount))))
	    
	    (for ((elem count : other)) ()
		 (if (and (not (in elem self))
			  (> count 0))
		     (pylist-set! result elem count)))
	    
	    result))))

  (define __and__
    (lambda (self other)
      (if (not (isinstance other Counter))
	  NotImplemented
	  (let ((result (Counter)))	    
	    (for ((elem count : self)) ()
		 (let ((newcount (min count (pylist-ref other elem))))
		   (if (> newcount 0)
		       (pylist-set! result elem newcount))))	    
	    result))))

  (define __pos__
    (lambda (self)
      (let ((result (Counter)))       
        (for ((elem count : self)) ()
	     (if (> count 0)
                (pylist-set! result elem count)))
        result)))


  (define __neg__
    (lambda (self)
      (let ((result (Counter)))
        (for ((elem count : self)) ()
	     (if (< count 0)
		 (pylist-set! result elem (- count))))
        result)))

  (define _keep_positive
    (lambda (self)
      (define ks
	(for ((k v : self)) ((l '()))
	     (if (<= v 0)
		 (cons k l)
		 l)))
      (let lp ((ks ks))
	(if (pair? ks)
	    (begin
	      (pylist-remove! self (car ks))
	      (lp (cdr ks)))))
      self))

  (define __iadd__
    (lambda (self other)
      (for ((elem count : other)) ()
	   (pylist-set! self elem
			(+ (py-get self elem 0) count)))
        ((ref self '_keep_positive))))

  (define __isub__
    (lambda (self other)
      (for ((elem count : other)) ()
	   (pylist-set! self elem
			(- (py-get self elem 0) count)))
      ((ref self '_keep_positive))))

  (define __ior__
    (lambda (self other)
      (for ((elem count : other)) ()
	   (pylist-set! self elem
			(max (py-get self elem 0) count)))
      ((ref self '_keep_positive))))

  (define __iand__
    (lambda (self other)
      (for ((elem count : other)) ()
	   (pylist-set! self elem
			(min (py-get self elem 0) count)))
      ((ref self '_keep_positive)))))

(define mod (current-module))

(def (namedtuple typename field_names
		 (= verbose #f)
		 (= rename  #f)
		 (= module  None))

     (define-syntax-rule (v x)
       (let ((xx x))
	 (if verbose
	     (begin
	       (set! verbose xx)
	       xx)
	     xx)))

     (let ((seen (py-set)))
       (if (string? field_names)
	   (set! field_names (string-split field_names #\,)))

       (set! field_names (py-list (py-map scm-str field_names)))
       (set! typename (scm-str typename))

       (if rename
	   (for ((index name : (enumerate field_names))) ()
		(if (or (not (py-identifier? name))
			(iskeyword name)
			(py-startswith name "_")
			(in name seen))
		    (pylist-set! field_names index (format #f "_~a"index)))
		(py-add! seen name)))

       (for ((name : (+ (pylist (list typename)) field_names))) ()
	    (if (not (string? name))
		(raise TypeError "Type names and field names must be strings"))
	    (if (not (py-identifier? name))
		(raise ValueError
		       (+ "Type names and field names must be valid "
			  (format #f "identifiers: ~a" name))))
	    (if (iskeyword name)
		(raise ValueError
		       (+ "Type names and field names cannot be a "
			  (format #f "keyword: ~a" name)))))

       (set! seen (py-set))
       (for ((name : field_names)) ()
	    (if (and (py-startswith name "_") (not rename))
		(raise ValueError
		       (+ "Field names cannot start with an underscore: "
			  name)))
	    (if (in name seen)
		(raise ValueError
		       (+ "Encountered duplicate field name: "
			  name)))
	    (py-add! seen name))

       (set! field_names (map string->symbol (to-list field_names)))
       
       (make-p-class (string->symbol typename) '(())
	 (lambda (dict)
	    (pylist-set! dict '__init__
	      (eval (v `(lam
			 (self
			  ,@(map (lambda (key) `(= ,key #f))
				 field_names))
			 
			 ,@(map (lambda (key) `(set self ',key ,key))
				field_names)))
		    mod))
	    
	    (pylist-set! dict '__getitem__	      
	      (lam (self i)
		(if (number? i)
		    (ref self (list-ref field_names i))
		    (ref self (scm-sym i)))))
	    
	    (pylist-set! dict '__setitem__
	      (lam (self i val)
		(if (number? i)
		    (set self (list-ref field_names i) val)
		    (set self (scm-sym i) val))))

	    (pylist-set! dict '__repr__			 
	       (lam (self)
		 (let ((l (map (lambda (x)
				 (format #f "~a=~a"
					 x
					 (ref self x)))
			       field_names)))

		  (format #f "~a(~a~{,~a~})"
			  typename
			  (car l)
			  (cdr l)))))
	       
	    
	    (if (eq? module None)
		(set! module (module-name (current-module)))
		(if (string? (scm-str module))
		    (set! module
			  (+ '(language python module)
			     (map scm-sym
				  (string-split module #\.))))))	    
	    
	    (if verbose (pretty-print verbose))))))

(define UserDict   dict)
(define UserString pystring)
(define UserList   py-list)

(define-python-class defaultdict (dict)
  (define __init__
    (lambda (self default_factory . l)
      (apply (ref dict '__init__) self l)
      (set self 'default_factory default_factory)))

  (define __missing__
    (lambda (self key)
      (let ((d (ref self 'default_factory)))
	(if (eq? d None)
	    (raise KeyError (format #f "key ~a is missing" key))
	    (pylist-ref d key))))))

(define-python-class deque ()
  (define __init__
    (lambda* (self #:optional (iterable '()) (maxlen None))
      (let ((head (link)))
	(set-prev! head    head)
	(set-next! head    head)
	(set self '_head   head)
	(set self 'maxlen maxlen)	
	(for ((x : iterable)) ((i 0))
	     (if (eq? i maxlen)
		 (begin
		   (set self '_i i)		   
		   (break))
		 (begin
		   (pylist-append! self x)
		   (+ i 1)))
	     #:final
	     (set self '_i i)))))

  (define append
    (lambda (self x)
      (let ((m (ref self 'maxlen))
	    (i (ref self '_i)))
	(if (= m (+ i 1))
	    (raise ValueError "deque reached its limit"))
	(let ((head (ref self '_head))
	      (link (link)))
	  (set-key!  link x)
	  (set-prev! link (get-last head))
	  (set-next! link head)
	  (set-prev! head link)
	  (set self '_i (+ i 1))))))

  (define appendleft
    (lambda (self x)
      (let ((m (ref self 'maxlen))
	    (i (ref self '_i)))
	(if (= m (+ i 1))
	    (raise ValueError "deque reached its limit"))
	(let ((head (ref self '_head))
	      (link (link)))
	  (set-key!  link x)
	  (set-next! link (get-first head))
	  (set-prev! link head)
	  (set-next! head link)
	  (set self '_i (+ i 1))))))

  (define clear
    (lambda (self)
      (let ((head (ref self '_head)))
	(set-prev! head head)
	(set-next! head head)
	(set self '_i 0))))

  (define copy
    (lambda (self)
      (defaultdict self (ref self 'maxlen))))

  (define count
    (lambda (self x)
      (for ((y : self)) ((i 0))
	 (if (equal? x y)
	     (+ i 1)
	     i)
	 #:final i)))

  (define extend
    (lambda (self iterable)
      (let ((f (ref self 'append)))
	(for ((x : iterable)) ()
	   (f x)))))

  (define extendleft
    (lambda (self iterable)
      (let ((f (ref self 'appendleft)))
	(for ((x : iterable)) ()
	   (f x)))))

  (define index
    (lambda* (self x #:optional (start 0) (stop -1))
      (for ((y : self)) ((i 0))
	   (if (< i start)
	       (+ i 1)
	       (if (= i stop)
		   (raise ValueError "index is not found")
		   (if (equal? x y)
		       (break i)
		       (+ i 1))))
	   #:final
	   (raise ValueError "index is not found"))))

  (define insert
    (lambda (self n x)
      (let ((m (ref self 'maxlen))
	    (j (ref self '_i)))
	
	(if (= m (+ j 1))
	    (raise IndexError "deque reached its limit"))

	(if (or (< n 0) (> n j))
	    (raise IndexError "index in insert out of bound"))
	
	(let lp ((p (ref self '_head)) (i 0))
	  (if (<= i j)
	      (if (= i n)
		  (let ((link (link))
			(pp   (get-next p)))
		    (set-key!  link x)
		    (set-next! p    link)
		    (set-prev! pp   link)
		    (set-prev! link p   )
		    (set-next! link pp)
		    (set self '_i (+ j 1)))
		  (lp (get-next p) (+ i 1))))))))

  (define pop
    (lambda (self)
      (let* ((i (ref self '_i))
	     (h (ref self '_head))
	     (n (get-prev h))
	     (p (get-prev n)))
	
	(if (eq? i 0)
	    (raise IndexError "pop of empty dequeue"))

	(set-prev! h p)
	(set-next! p h)
	(set self '_i (- i 1))
	(get-key n))))

  (define popleft
    (lambda (self)
      (let* ((i (ref self '_i))
	     (h (ref self '_head))
	     (n (get-next h))
	     (p (get-next n)))
	
	(if (eq? i 0)
	    (raise IndexError "pop of empty dequeue"))

	(set-next! h p)
	(set-prev! p h)
	(set self '_i (- i 1))
	(get-key n))))
	
 (define remove
    (lambda (self value)
      (let ((j (ref self '_i)))
	
	(if (= j 0)
	    (raise ValueError "can'r remove deque which is empty"))
	
	(let lp ((p (get-next (ref self '_head))) (i 0))
	  (if (< i j)
	      (if (equal? value (get-key p))
		  (let ((prev (get-prev p))
			(next (get-next p)))
		    (set-next! prev next)
		    (set-prev! next prev)
		    (set self '_i (- j 1)))
		  (lp (get-next p) (+ i 1)))
	      (raise ValueError "remove: element is not in deque"))))))
  
  (define reverse
    (lambda (self)
      (let ((h (ref self '_head))
	    (n (ref self '_i)))
	(let lp ((h h) (i 0))
	  (if (<= i n)
	      (let ((n (get-next h))
		    (l (get-prev h))
		    (r (get-next h)))
		(set-next! h l)
		(set-prev! h r)
		(lp n (+ i 1))))))))
  
  (define rotate
    (lambda (self n)
      (define h (ref self '_head))
      
      (define (rotate+)
	(let* ((n  (get-next h))
	       (nn (get-next h))
	       (p  (get-prev h)))
	  (set-next! p n)
	  (set-prev! n p)
	  (set-next! h nn)
	  (set-prev! h n)
	  (set-prev! nn h)
	  (set-next! n  h)))
      
      (define (rotate-)
	(let* ((n  (get-prev h))
	       (nn (get-prev h))
	       (p  (get-next h)))
	  (set-prev! p n)
	  (set-next! n p)
	  (set-prev! h nn)
	  (set-next! h n)
	  (set-next! nn h)
	  (set-prev! n  h)))
      
      (define rotate (if (> n 0) rotate+ rotate-))
      (define d      (if (> n 0) 1       -1     ))

      (let lp ((i 0))
	(if (not (= i n))
	    (begin
	      (rotate)
	      (lp (+ i d)))))))

      (define __inter__
	(lambda (self)
	  (let ((h (ref self '_head)))
	  ((make-generator ()
	     (lambda (yield)
	       (let lp ((p (get-next h)))
		 (if (not (eq? p h))
		     (begin
		       (yield (get-key p))
		       (lp (get-next p)))))))))))

      (define __reversed__
	(lambda (self)
	  (let ((h (ref self '_head)))
	  ((make-generator ()
	     (lambda (yield)
	       (let lp ((p (get-prev h)))
		 (if (not (eq? p h))
		     (begin
		       (yield (get-key p))
		       (lp (get-prev p)))))))))))

      (define __contains__
	(lambda (self x)
	  (try
	   (lambda ()
	     (if ((ref self 'index) x)
		 #t
		 #f))
	   (#:except IndexError =>
	     (lambda x #f)))))


      (define __len__
	(lambda (self)
	  (ref self '_i)))

      (define __getitem__
	(lambda (self i)
	  (let ((n (ref self '_i)))
	    (if (or (>= i n) (< i 0))
		(raise IndexError i))
	    (let lp ((p (get-next (ref self '_head))) (j 0))
	      (if (= i j)
		  (get-key p)
		  (lp (get-next p) (+ j 1)))))))

      (define __setitem__
	(lambda (self i v)
	  (let ((n (ref self '_i)))
	    (if (or (>= i n) (< i 0))
		(raise IndexError i))
	    (let lp ((p (get-next (ref self '_head))) (j 0))
	      (if (= i j)
		  (set-key! p v)
		  (lp (get-next p) (+ j 1)))))))

      (define __delitem__
	(lambda (self i)
	  (let ((n (ref self '_i)))
	    (if (or (>= i n) (< i 0))
		(raise IndexError i))
	    (let lp ((p (get-next (ref self '_head))) (j 0))
	      (if (= i j)
		  (let ((prev (get-prev p))
			(next (get-next p)))
		    (set-next! prev next)
		    (set-prev! next prev)
		    (set self '_i (- n 1)))
		  (lp (get-next p) (+ j 1)))))))

      (define __repr__
	(lambda (self)
	  (let ((l (to-list self)))
	    (if (pair? l)
		(format #f "deque([~a~{, ~a~}])" (car l) (cdr l))
		"deque([])"))))
      
      (define __add__
	(lambda (self iter)
	  (let ((o ((ref self 'copy))))
	    (let ((f (ref o 'append)))
	      (for ((x : iter)) ()
		   (f x)))
	    o)))

      (define __iadd__
	(lambda (self iter)
	  (let ((o self))
	    (let ((f (ref o 'append)))
	      (for ((x : iter)) ()
		   (f x)))
	    o)))

      (define __mul__
	(lambda (self n)
	  (let ((o (deque)))
	    (let ((f (ref o 'append)))
	      (let lp ((i 0))
		(if (< i n)
		    (begin		   
		      (for ((x : self)) ()
			   (f x))
		      (lp (+ i 1)))
		    o))))))

      (define __imul__
	(lambda (self n)
	  (if (= n 0)
	      ((ref self 'clear))
	      (let ((o self))
		(let ((f (ref o 'append)))	      
		  (let lp ((i 1))
		    (if (< i n)
			(begin		   
			  (for ((x : self)) ()
			       (f x))
			  (lp (+ i 1)))
			o))))))))