diff options
Diffstat (limited to 'modules/language')
-rw-r--r-- | modules/language/python/compile.scm | 1 | ||||
-rw-r--r-- | modules/language/python/dict.scm | 4 | ||||
-rw-r--r-- | modules/language/python/module/collections.scm | 354 | ||||
-rw-r--r-- | modules/language/python/module/keyword.scm | 46 | ||||
-rw-r--r-- | modules/language/python/module/python.scm | 6 | ||||
-rw-r--r-- | modules/language/python/string.scm | 27 |
6 files changed, 400 insertions, 38 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index dad7656..b3cbf67 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -338,6 +338,7 @@ ((isspace) (S 'py-isspace)) ((isupper) (S 'py-isupper)) ((istitle) (S 'py-istitle)) + ((isidentifier) (S 'py-identifier)) ((join) (S 'py-join )) ((ljust) (S 'py-join )) ((rljust) (S 'py-rljust )) diff --git a/modules/language/python/dict.scm b/modules/language/python/dict.scm index b9f6dd3..58d7cb7 100644 --- a/modules/language/python/dict.scm +++ b/modules/language/python/dict.scm @@ -99,7 +99,9 @@ (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) + (aif it (ref o '__missing__) + (it x) + (raise KeyError x)) r))) (define-method (pylist-delete! (o <hashtable>) k) diff --git a/modules/language/python/module/collections.scm b/modules/language/python/module/collections.scm index 65c9159..9f40220 100644 --- a/modules/language/python/module/collections.scm +++ b/modules/language/python/module/collections.scm @@ -1,5 +1,6 @@ (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) @@ -14,10 +15,13 @@ #: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)) + any repr property super sorted + enumerate (map . py-map))) #:use-module ((language python module operator) #:select (itemgetter)) @@ -27,7 +31,24 @@ ByteString Set MutableSet Mapping MutableMapping MappingView ItemsView KeysView ValuesView) - #:export (OrderedDict ChainMap Counter UserDict UserString UserList)) + #:export (OrderedDict ChainMap Counter UserDict UserString UserList + namedtuple defaultdict dequeue)) + +#| +* 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__ @@ -565,6 +586,8 @@ (min (py-get self elem 0) count))) ((ref self '_keep_positive))))) +(define mod (current-module)) + (def (namedtuple typename field_names (= verbose #f) (= rename #f) @@ -577,25 +600,27 @@ (set! verbose xx) xx) xx))) - + (let ((seen (py-set))) (if (string? field_names) - (set! field_names = (string-split 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)) - (py-set! field_names index (format #f "_~a"index))) - (py-add seen name))) + (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-isidentifier name)) + (if (not (py-identifier? name)) (raise ValueError (+ "Type names and field names must be valid " (format #f "identifiers: ~a" name)))) @@ -614,33 +639,47 @@ (raise ValueError (+ "Encountered duplicate field name: " name))) - (py-add seen name)) + (py-add! seen name)) - (set! field_names (map string->symbol (to-list field-names))) + (set! field_names (map string->symbol (to-list field_names))) - (make-p-class (string->symbol typename) (list) + (make-p-class (string->symbol typename) '(()) (lambda (dict) - (py-add! 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 '__init__ + (eval (v `(lam + (self + ,@(map (lambda (key) `(= ,key #f)) + field_names)) + + ,@(map (lambda (key) `(set self ',key ,key)) + field_names))) + mod)) - (py_add! dict '__getitem__ - (lambda (self i) - (if (number? i) - (ref self (list-ref field_names i)) - (ref self (scm-sym i))))) + (pylist-set! dict '__getitem__ + (lambda (self i) + (if (number? i) + (ref self (list-ref field_names i)) + (ref self (scm-sym i))))) - (py_add! dict '__setitem__ - (lambda (self i val) - (if (number? i) - (set self (list-ref field_names i) val) - (set self (scm-sym i) val)))) + (pylist-set! dict '__setitem__ + (lambda (self i val) + (if (number? i) + (set self (list-ref field_names i) val) + (set self (scm-sym i) val)))) + + (pylist-set! dict '__repr__ + (lambda (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))) @@ -650,14 +689,263 @@ (map scm-sym (string-split module #\.)))))) - (py-add! dict '__module__ module) + (pylist-set! dict '__module__ module) (if verbose (pretty-print verbose)))))) -(define-python-class UserDict (dict)) -(define-python-class UserString (pystring)) -(define-python-class UserList (py-list)) +(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 dequeue () + (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)))))))))))) + + + + diff --git a/modules/language/python/module/keyword.scm b/modules/language/python/module/keyword.scm new file mode 100644 index 0000000..c749ff5 --- /dev/null +++ b/modules/language/python/module/keyword.scm @@ -0,0 +1,46 @@ +(define-module (language python module keyword) + #:use-module (language python string) + #:use-module (language python set) + #:use-module (oop pf-objects) + + #:export (kwlist iskeyword)) + +(define kwlist + '("False" + "None" + "True" + "and" + "as" + "assert" + "break" + "class" + "continue" + "def" + "del" + "elif" + "else" + "except" + "finally" + "for" + "from" + "global" + "if" + "import" + "in" + "is" + "lambda" + "nonlocal" + "not" + "or" + "pass" + "raise" + "return" + "try" + "while" + "with" + "yield")) + + +(define iskeyword (ref (py-set kwlist) '__contains__)) + + diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm index cfa0f3e..8cb47fb 100644 --- a/modules/language/python/module/python.scm +++ b/modules/language/python/module/python.scm @@ -156,9 +156,9 @@ (syntax-case x () ((map f a ...) (with-syntax (((x ...) (generate-temporaries #'(a ...)))) - #'(make-generator map - (lambda (yield) - (for ((x : a) ...) () (yield (f x ...)))))))))) + #'(for ((x : a) ...) ((l '())) + (cons (f x ...) l) + #:final (py-list (reverse l)))))))) (define* (sum i #:optional (start 0)) (for ((x : i)) ((s start)) diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm index d4cb74b..91a78db 100644 --- a/modules/language/python/string.scm +++ b/modules/language/python/string.scm @@ -17,10 +17,17 @@ py-partition py-replace py-strip py-title py-rpartitio py-rindex py-split py-rsplit py-splitlines py-startswith py-swapcase py-translate py-zfill - pystring-listing <py-string> pystring py-string?)) + pystring-listing <py-string> pystring py-string? + scm-str scm-sym py-identifier?)) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) +(define (scm-str x) (slot-ref (pystring x) 'str)) +(define (scm-sym x) + (if (symbol? x) + x + (string->symbol (scm-str x)))) + (define (py-string? x) (or (string? x) (is-a? x <py-string>))) @@ -169,6 +176,24 @@ (mk-is py-isspace isspace char-whitespace?) (mk-is py-isupper isupper char-upper-case?) +(define-py (py-identifier? isidentifier s) + (let lp ((l (string->list s)) (first? #t)) + (if (pair? l) + (let ((x (car l))) + (if first? + (if (or (char-alphabetic? x) + (eq? x #\_)) + (lp (cdr l) #f) + #f) + (if (or (char-alphabetic? x) + (char-numeric? x) + (eq? x #\_)) + (lp (cdr l) #f) + #f))) + (if ((@ (language python module keyword) iskeyword) s) + #f + #t)))) + (define-py (py-istitle istitle s) (let ((n (len s))) (if ((> n 0)) |