(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 `(, . _)) (define dict-set! (resolve-method-g pylist-set! )) (define dict-ref (resolve-method-g pylist-ref )) (define dict-del! (resolve-method-g pylist-delete! )) (define dict-pop! (resolve-method-g pylist-pop! )) (define dict-clear! (resolve-method-g py-clear )) (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 ) (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 ) (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))))))))