summaryrefslogtreecommitdiff
path: root/modules
diff options
context:
space:
mode:
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>2018-03-21 20:27:34 +0100
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>2018-03-21 20:27:34 +0100
commitdc9f37567dae95b4eedcb967fa1b2add3fad86c2 (patch)
tree2309ea04c319749dae4f476c5bba058194650d10 /modules
parentebd4217a508490554aa0419de3720be6156be5df (diff)
parent083cdb005f11b69ce5642960e724ddf281f41032 (diff)
Merge branch 'master' of gitlab.com:python-on-guile/python-on-guile
Diffstat (limited to 'modules')
-rw-r--r--modules/language/python/compile.scm32
-rw-r--r--modules/language/python/dict.scm4
-rw-r--r--modules/language/python/exceptions.scm32
-rw-r--r--modules/language/python/module.scm42
-rw-r--r--modules/language/python/module/collections.scm622
-rw-r--r--modules/language/python/module/keyword.scm46
-rw-r--r--modules/language/python/module/operator.scm15
-rw-r--r--modules/language/python/module/python.scm8
-rw-r--r--modules/language/python/string.scm27
-rw-r--r--modules/oop/pf-objects.scm4
10 files changed, 648 insertions, 184 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index 8fe13cf..b00f304 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -14,6 +14,7 @@
#:use-module (language python bytes)
#:use-module (language python number)
#:use-module (language python def)
+ #:use-module (language python module)
#:use-module ((language python with) #:select ())
#:use-module (ice-9 pretty-print)
#:export (comp))
@@ -27,7 +28,6 @@
(define-inlinable (F x) `(@@ (language python for) ,x))
(define-inlinable (E x) `(@@ (language python exceptions) ,x))
(define-inlinable (L x) `(@@ (language python list) ,x))
-(define-inlinable (A x) `(@@ (language python array) ,x))
(define-inlinable (S x) `(@@ (language python string) ,x))
(define-inlinable (B x) `(@@ (language python bytes) ,x))
(define-inlinable (Se x) `(@@ (language python set) ,x))
@@ -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 ))
@@ -822,9 +823,19 @@
((_ (#:from (() . nm) . #f))
`(use-modules (language python module ,@(map (lambda (nm) (exp vs nm))
nm))))
+ ((_ (#:from (() . nm) . l))
+ `(use-modules ((language python module ,@(map (lambda (nm) (exp vs nm))
+ nm))
+ #:select ,(map (lambda (x)
+ (match x
+ ((a . #f)
+ (exp vs a))
+ ((a . b)
+ (cons (exp vs a) (exp vs b)))))
+ l))))
+
((_ (#:name ((ids ...) . as)) ...)
- (pk x)
`(begin
,@(map
(lambda (ids as)
@@ -836,20 +847,21 @@
((#:test (#:power #f ,as ())))
(#:assign
((#:verb
- ((@ (language python module) Module)
- ',(reverse (append '(language python module) path))
- ',(reverse path)))))))
-
+ ((@ (language python module) import)
+ ((@ (language python module) Module)
+ ',(reverse (append '(language python module) path))
+ ',(reverse path))
+ ,(exp vs as)))))))
(exp
vs
`(#:expr-stmt
((#:test (#:power #f ,(car ids) ())))
(#:assign
((#:verb
- (((@ (language python module) import)
- ((@ (language python module) Module)
- ',(append '(language python module) path))
- ,(exp vs (car ids))))))))))))
+ ((@ (language python module) import)
+ ((@ (language python module) Module)
+ ',(append '(language python module) path))
+ ,(exp vs (car ids)))))))))))
ids as))))
(#:for
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/exceptions.scm b/modules/language/python/exceptions.scm
index 9c75658..0b91293 100644
--- a/modules/language/python/exceptions.scm
+++ b/modules/language/python/exceptions.scm
@@ -6,24 +6,25 @@
IndexError KeyError AttributeError
SyntaxError SystemException
OSError ProcessLookupError PermissionError
- None))
+ None NotImplemented NotImplementedError))
(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
-(define StopIteration 'StopIteration)
-(define GeneratorExit 'GeneratorExit)
-(define SystemException 'SystemException)
-(define RuntimeError 'RuntimeError)
-(define IndexError 'IndexError)
-(define ValueError 'ValueError)
-(define None 'None)
-(define KeyError 'KeyError)
-(define TypeError 'TypeError)
-(define AttributeError 'AttributeError)
-(define SyntaxError 'SyntaxError)
-(define OSError 'OSError)
-(define ProcessLookupError 'ProcessLookupError)
-(define PermissionError 'PermissionError)
+(define StopIteration 'StopIteration)
+(define GeneratorExit 'GeneratorExit)
+(define SystemException 'SystemException)
+(define RuntimeError 'RuntimeError)
+(define IndexError 'IndexError)
+(define ValueError 'ValueError)
+(define None 'None)
+(define KeyError 'KeyError)
+(define TypeError 'TypeError)
+(define AttributeError 'AttributeError)
+(define SyntaxError 'SyntaxError)
+(define OSError 'OSError)
+(define ProcessLookupError 'ProcessLookupError)
+(define PermissionError 'PermissionError)
+(define NotImplementedError 'NotImplementedError)
(define-python-class Exception ()
(define __init__
@@ -42,6 +43,7 @@
(ref self '__name__))))))
+(define NotImplemented (list 'NotImplemented))
diff --git a/modules/language/python/module.scm b/modules/language/python/module.scm
index 55120e0..9884c2b 100644
--- a/modules/language/python/module.scm
+++ b/modules/language/python/module.scm
@@ -11,6 +11,13 @@
(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
+(define-syntax-rule (in-scheme x)
+ (let ((lan (current-language)))
+ (dynamic-wind
+ (lambda () (current-language 'scheme))
+ (lambda () x)
+ (lambda () (current-language lan)))))
+
(define (private mod)
((ref mod '__setprivate__) #t))
(define (public mod)
@@ -57,7 +64,6 @@
(define __init__
(case-lambda
((self pre l nm)
- (pk 2 l)
(match l
((name)
(set self '_path (reverse (cons name pre)))
@@ -72,7 +78,6 @@
(_cont self #f l #f nm))
((self l)
- (pk 1)
(if (pair? l)
(if (and (> (length l) 3)
(equal? (list (list-ref l 0)
@@ -105,7 +110,7 @@
(list-ref l 1)
(list-ref l 2))
'(language python module)))
- (__uppdate__ self (reverse '(language python module))
+ (__update__ self (reverse '(language python module))
(cdddr l) '()))
(__update__ self
(map string->symbol
@@ -113,19 +118,15 @@
(define _make
(lambda (self l nm)
- (pk 'make)
(rawset self '_private #f)
(if (not (rawref self '_module))
(begin
- (pk 'a)
(set self '__dict__ self)
(set self '__name__ (string-join
(map symbol->string (reverse nm)) "."))
- (pk 'b)
- (let ((_module (resolve-module (reverse l))))
+ (let ((_module (in-scheme (resolve-module (reverse l)))))
(set self '_export (module-public-interface _module))
(set self '_module _module)
- (pk 'c)
(hash-set! _modules l self))))))
(define __getattribute__
@@ -154,7 +155,7 @@
(if (module-defined? m k)
(module-set! m k v)
(module-define! m k v)))
- (lambda x (pk 'fail x)))
+ (lambda x (fail x)))
(fail))))))
(define __delattr__
@@ -177,7 +178,7 @@
(define __iter__
(lambda (self)
- (define m (_m obj))
+ (define m (_m self))
((make-generator ()
(lambda (yield)
(define l '())
@@ -187,22 +188,20 @@
(if (pair? l)
(begin
(apply yield (car l))
- (lp (cdr l)))))
- (hash-for-each yield (slot-ref self 'h))))))))
+ (lp (cdr l)))))))))))
(define-syntax import
(lambda (x)
- (pk (syntax->datum x))
(syntax-case x ()
((_ (a ...) var)
- #`(import-f #,(case (pk (syntax-local-binding #'var))
+ #`(import-f #,(case (syntax-local-binding #'var)
((lexical)
#'var)
((global)
- #'(if (pk (module-defined? (current-module)
- (syntax->datum #'var)))
+ #'(if (module-defined? (current-module)
+ (syntax->datum #'var))
var
#f))
(else
@@ -210,9 +209,8 @@
(define (m? x) ((@ (language python module python) isinstance) x Module))
(define (import-f x f . l)
- (pk 'import-f f x)
- (pk (if x
- (if (m? x)
- (apply (rawref x '__update__) l)
- (apply f l))
- (apply (pk f) l))))
+ (if x
+ (if (m? x)
+ (begin (apply (rawref x '__update__) l) x)
+ (apply f l))
+ (apply f l)))
diff --git a/modules/language/python/module/collections.scm b/modules/language/python/module/collections.scm
index 601ce7e..9f40220 100644
--- a/modules/language/python/module/collections.scm
+++ b/modules/language/python/module/collections.scm
@@ -1,35 +1,61 @@
(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)))
-
- #:export (abc OrderedDict ChainMap Counter UserDict UserString UserList))
-
-(define-python-class class-from-dict ()
- (define __init__
- (lambda (self d)
- (set self '__dict__ d))))
+ #:select ((map . pymap) isinstance reversed classmethod iter
+ any repr property super sorted
+ enumerate (map . py-map)))
-(define abc
- (class-from-dict
- (resolve-module (module-public-interface
- '(language python module collections abc)))))
+ #: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 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__
(lambda (self)
((make-generator ()
(lambda (yield)
- (for ((k v : (reversed (reg self '_mapping))))
+ (for ((k v : (reversed (ref self '_mapping)))) ()
(yield k))))))))
(define-python-class _OrderedDictValuesView (ValuesView)
@@ -37,7 +63,7 @@
(lambda (self)
((make-generator ()
(lambda (yield)
- (for ((k v : (reversed (reg self '_mapping))))
+ (for ((k v : (reversed (ref self '_mapping)))) ()
(yield v))))))))
(define-python-class _OrderedDictItemsView (ItemsView)
@@ -45,25 +71,25 @@
(lambda (self)
((make-generator ()
(lambda (yield)
- (for ((k v : (reversed (reg self '_mapping))))
+ (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-next l) (vector-ref l 1))
-(define-inlinable (get-key l) (vector-ref l 2))
+(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 proxy (list 'mu))
-
-(define <dict> (cons <py-hashtable> '_))
-(define dict-set! (resolve-method-c pylist-set! <dict>))
-(define dict-ref (resolve-method-c pylist-ref <dict>))
-(define dict-del! (resolve-method-c pylist-delete! <dict>))
-(define dict-pop! (resolve-method-c pylist-pop! <dict>))
-(define dict-clear! (resolve-method-c pylist-clear! <dict>))
+(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__
@@ -71,7 +97,7 @@
(if (> (len args) 1)
(raise TypeError
(format #f
- "expected at most 1 arguments, got %d"
+ "expected at most 1 arguments, got ~a"
(len args))))
(try
@@ -87,10 +113,10 @@
(py-apply py-update self (* args) (** kwds))))
(define __setitem__
- (lambda* (self key value #:key
- (dict_setitem dict-set!)
- (proxy #f)
- (link link))
+ (lam (self key value
+ (= dict_setitem dict-set!)
+ (= proxy #f)
+ (= link link))
(if (in key self)
(let* ((link (link))
(root (ref self '__root))
@@ -104,9 +130,7 @@
(dict_setitem self key value)))))
(define __delitem__
- (lambda* (self key #:key
- (dict_delitem dict-set!)
- (dict_delitem dict-del!))
+ (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)))
@@ -116,7 +140,7 @@
(set-prev! link None))))
(define __iter__
- (lambda* (self #:key (get-next get-next))
+ (lam (self (= get-next get-next))
((make-generator ()
(lambda (yield)
(let ((root (ref self '__root)))
@@ -140,7 +164,7 @@
(dict-clear! self))))
(define popitem
- (lambda* (self #:key (last #t))
+ (lam (self (= last #t))
(if (= (len self) 0)
(raise KeyError "dictionary is empty"))
(let ((root (ref self '__root)))
@@ -162,7 +186,7 @@
(dict-pop! self key))))))
(define move_to_end
- (lambda* (self key #:key (last #t))
+ (lam (self key (= last #t))
(let* ((link (pylist-ref (ref self '__map) key))
(prev (get-prev link))
(next (get-next link)))
@@ -196,7 +220,7 @@
(define __marker (object))
(define pop
- (lambda* (self key #:key (default __marker))
+ (lam (self key (= default __marker))
(if (in key self)
(let ((result (dict-ref self key)))
(__delitem__ self key)
@@ -206,7 +230,7 @@
default))))
(define setdefault
- (lambda* (self key #:key (default None))
+ (lam (self key (= default None))
(if (in key self)
(dict-ref self key)
(begin
@@ -219,24 +243,29 @@
(define fromkeys
(classmethod
- (lambda* (cls iterable #key (value None))
- (let ((self (cls)))
- (for ((key : iterable)) ()
- (__setitem__ self key value))
- self))))
+ (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 ((dict-equal? self other)
- (all (map _equal self other)))
- ((ref dict '__eq__) self other))))
+ (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 (set)))
- (apply (ref s 'union) (ref self 'maps)))
- s)
+ (let ((s (py-set)))
+ (apply (ref s 'union) (ref self 'maps))
+ s))
(define-python-class ChainMap (MutableMapping)
(define __init__
@@ -267,15 +296,15 @@
(define __len__
(lambda (self)
(len (u self))))
-
+
(define __iter__
(lambda (self)
(iter (u self))))
(define __contains__
- (lambda (self, key)
- (for ((m : (ref self 'maps)))
+ (lambda (self key)
+ (for ((m : (ref self 'maps))) ()
(if (in key m)
(break #t))
#:final #f)))
@@ -286,9 +315,11 @@
(define __repr__
(lambda (self)
- (format #f "~a(~a,~{,~a~})"
- (ref (ref self '__class__) '__name__)
- (map (lambda (x) (repr x)) (ref self 'maps)))))
+ (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
@@ -323,30 +354,30 @@
(define __delitem__
- (lambda (self, key)
+ (lambda (self key)
(try
- (lambda () (pylist-del! (car (ref self 'maps))))
- #:except KeyError =>
- (lambda x
- (raise KeyError
- (format #f "Key not found in the first mapping: ~a" key))))))
+ (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")))))
+ (#:except KeyError =>
+ (lambda x
+ (raise KeyError "No keys found in the first mapping"))))))
(define pop
(lambda (self key . args)
(try
- (lambda () (apply py-pop (car (ref self 'maps)) args))
- #:except KeyError =>
- (lambda ()
+ (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))))))
+ (format #f "Key not found in the first mapping: ~ a" key)))))))
(define clear
(lambda (self)
@@ -359,7 +390,7 @@
(raise TypeError
(format
#f
- "expected at most 1 arguments, got ~ a"
+ "expected at most 1 arguments, got ~a"
(length args))))
((ref (super Counter self) '__init__))
(py-apply py-update self (* args) (** kwds))))
@@ -368,17 +399,17 @@
(lambda (self key) 0))
(define most_common
- (lambda* (self #:key (n None)):
+ (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)))))
+ (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))) ()
+ (for ((i : (range v))) ()
(yield k))))))))
(define fromkeys
@@ -390,42 +421,43 @@
(lam (self (* args) (** kwds))
(if (> (len args) 1)
(raise TypeError
- (format #f "expected at most 1 arguments, got %d"
+ (format #f "expected at most 1 arguments, got ~a"
(len args))))
-
- (let ((iterable (pylist-get args o None)))
- (if (not (eq? iterable None))
- (if (is-a? iterable <py-dict>)
- (for ((elem count : iterable)) ()
- (pylist-set! self elem
- (+ count (pylist-get self elem 0))))
- (for ((k : iterable)) ()
- (pylist-set! self elem
- (+ 1 (pylist-get self elem 0)))))))
+
+ (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 v : kwds)) ()
- (pylist-set! self k
- (+ count (pylist-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 %d"
+ (format #f "expected at most 1 arguments, got ~a"
(len args))))
- (let ((iterable (pylist-get args 0 None)))
+ (let ((iterable (py-get args 0 None)))
(if (not (eq? iterable None))
- (if (is-a? iterable <py-dict>)
+ (if (isinstance iterable <py-hashtable>)
(for ((elem count : iterable)) ()
(pylist-set! self elem
- (- (pylist-get self elem 0) count)))
+ (- (py-get self elem 0) count)))
(for ((elem : iterable)) ()
(pylist-set! self elem
- (- (pylist-get self elem 0) 1))))))
+ (- (py-get self elem 0) 1))))))
(for ((k v : kwds)) ()
(pylist-set! self k
- (- (pylist-get self k 0) v)))))
+ (- (py-get self k 0) v)))))
(define __delitem__
(lambda (self k)
@@ -443,12 +475,12 @@
(if (> newcount 0)
(pylist-set! result elem newcount))))
- (for ((elem count : other))
+ (for ((elem count : other)) ()
(if (and (not (in elem self))
(> count 0))
(pylist-set! result elem count)))
- return))))
+ result))))
(define __sub__
(lambda (self other)
@@ -460,12 +492,12 @@
(if (> newcount 0)
(pylist-set! result elem newcount))))
- (for ((elem count : other))
+ (for ((elem count : other)) ()
(if (and (not (in elem self))
(> count 0))
(pylist-set! result elem (- count))))
- return))))
+ result))))
(define __or__
(lambda (self other)
@@ -482,7 +514,7 @@
(> count 0))
(pylist-set! result elem count)))
- return))))
+ result))))
(define __and__
(lambda (self other)
@@ -493,12 +525,12 @@
(let ((newcount (min count (pylist-ref other elem))))
(if (> newcount 0)
(pylist-set! result elem newcount))))
- return))))
+ result))))
(define __pos__
(lambda (self)
(let ((result (Counter)))
- (for ((elem count : self))
+ (for ((elem count : self)) ()
(if (> count 0)
(pylist-set! result elem count)))
result)))
@@ -515,7 +547,7 @@
(define _keep_positive
(lambda (self)
(define ks
- (for ((k v : self)) (l '())
+ (for ((k v : self)) ((l '()))
(if (<= v 0)
(cons k l)
l)))
@@ -527,37 +559,393 @@
self))
(define __iadd__
- (lambda (self, other)
- (for ((elem count : other))
+ (lambda (self other)
+ (for ((elem count : other)) ()
(pylist-set! self elem
- (+ (pylist-get self elem 0) count)))
+ (+ (py-get self elem 0) count)))
((ref self '_keep_positive))))
(define __isub__
- (lambda (self, other)
- (for ((elem count : other))
+ (lambda (self other)
+ (for ((elem count : other)) ()
(pylist-set! self elem
- (- (pylist-get self elem 0) count)))
+ (- (py-get self elem 0) count)))
((ref self '_keep_positive))))
(define __ior__
- (lambda (self, other)
- (for ((elem count : other))
+ (lambda (self other)
+ (for ((elem count : other)) ()
(pylist-set! self elem
- (max (pylist-get self elem 0) count)))
+ (max (py-get self elem 0) count)))
((ref self '_keep_positive))))
(define __iand__
- (lambda (self, other)
- (for ((elem count : other))
+ (lambda (self other)
+ (for ((elem count : other)) ()
(pylist-set! self elem
- (min (pylist-get self elem 0) count)))
+ (min (py-get self elem 0) count)))
((ref self '_keep_positive)))))
-(define-python-class UserDict (dict))
-(define-python-class UserString (py-string))
-(define-python-class UserList (py-list))
+(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__
+ (lambda (self i)
+ (if (number? i)
+ (ref self (list-ref field_names i))
+ (ref self (scm-sym i)))))
+
+ (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)))
+ (if (string? (scm-str module))
+ (set! module
+ (+ '(language python module)
+ (map scm-sym
+ (string-split module #\.))))))
+
+ (pylist-set! dict '__module__ 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 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/operator.scm b/modules/language/python/module/operator.scm
index a22fde4..e506817 100644
--- a/modules/language/python/module/operator.scm
+++ b/modules/language/python/module/operator.scm
@@ -34,7 +34,7 @@
(cons (cons k v) l)
#:final (reverse l)))
-(define (asssoc->hash a)
+(define (assoc->hash a)
(let ((h (make-hash-table)))
(let lp ((a a))
(if (pair? a)
@@ -182,8 +182,6 @@
(car as)
(cdr as))))))
-(name-object attrgetter)
-
(define-python-class itemgetter ()
(define __init__
(lambda (self item . items)
@@ -217,10 +215,6 @@
(ref (ref self '__class__) '__name__)
(car args) (cdr args))))))
-(name-object itemgetter)
-
-
-
(define-python-class methodcaller ()
(define __init__
(lam (self (* args) (** kwargs))
@@ -240,12 +234,12 @@
(lambda (self)
(list
(lambda (o name args a)
- (let ((kwargs (assoc->hash kwargs)))
+ (let ((kwargs (assoc->hash a)))
(py-apply (ref methodcaller '__init__) o name (* args) (** kwargs))))
(list
(ref self '_name)
(ref self '_args)
- (hash->assoc (ref self '_kwargs)))))))
+ (hash->assoc (ref self '_kwargs))))))
(define __call__
(lambda (self obj)
@@ -267,9 +261,6 @@
#:final (reverse l)))
(format #f "~a(~a~{,~a~})" cln (car v2) (cdr v2)))))
-(name-object methodcaller)
-
-
;; In-place Operations
(define iadd py-iadd)
(define iand py-ilogand)
diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm
index 093d03e..8cb47fb 100644
--- a/modules/language/python/module/python.scm
+++ b/modules/language/python/module/python.scm
@@ -127,7 +127,7 @@
(or
(isinstance o (car cl))
(isinstance o (cdr cl)))
- (is-a? (ref (ref o '__class__) '__goops__) cl))))
+ (is-a? o (ref cl '__goops__)))))
(define iter
(case-lambda
@@ -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))
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index d0ba6e4..0418a5f 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -16,7 +16,7 @@
py-super-mac py-super py-equal?
*class* *self* pyobject? pytype?
type object pylist-set! pylist-ref tr
- resolve-method rawref rawset
+ resolve-method-g rawref rawset
))
#|
@@ -75,7 +75,7 @@ explicitly tell it to not update etc.
(((p . ps) . (pp . pps))
(if (eq? pp '_)
(mmatch ps pps)
- (if (is-a? p pp)
+ (if (or (eq? p pp) (is-a? p pp))
(cons p (mmatch ps pps))
#f)))
((() . ())