From 944fc50b8b36455b9749ad6b60f3020d466f901c Mon Sep 17 00:00:00 2001 From: Stefan Israelsson Tampe Date: Tue, 27 Mar 2018 16:19:00 +0200 Subject: large part of functools compiles --- modules/language/python/bool.scm | 20 +++++ modules/language/python/bytes.scm | 3 + modules/language/python/def.scm | 18 ++-- modules/language/python/dict.scm | 9 ++ modules/language/python/list.scm | 8 ++ modules/language/python/module/collections.scm | 18 ++-- modules/language/python/module/functools.scm | 117 ++++++++++++------------- modules/language/python/module/python.scm | 13 +-- modules/language/python/module/threading.scm | 11 ++- modules/language/python/procedure.scm | 7 -- modules/language/python/property.scm | 16 ++-- modules/language/python/set.scm | 16 ++-- modules/language/python/string.scm | 4 + modules/language/python/tuple.scm | 2 + 14 files changed, 154 insertions(+), 108 deletions(-) create mode 100644 modules/language/python/bool.scm (limited to 'modules/language/python') diff --git a/modules/language/python/bool.scm b/modules/language/python/bool.scm new file mode 100644 index 0000000..3eb6bc8 --- /dev/null +++ b/modules/language/python/bool.scm @@ -0,0 +1,20 @@ +(define-module (language python bool) + #:use-module (oop goops) + #:use-module (oop pf-objects) + #:export (bool)) + +(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) + +(define-method (bool x) + (cond + ((null? x) + #f) + (else x))) + +(define-method (bool (x )) (not (= x 0))) +(define-method (bool (x

)) + (aif it (ref x '__bool__) + (it) + (next-method))) + + diff --git a/modules/language/python/bytes.scm b/modules/language/python/bytes.scm index 1a0a8af..bd590b8 100644 --- a/modules/language/python/bytes.scm +++ b/modules/language/python/bytes.scm @@ -10,6 +10,7 @@ #:use-module (language python exceptions) #:use-module (language python list) #:use-module (language python hash) + #:use-module (language python bool) #:use-module (language python persist) #:export ( pybytes-listing bytes bytearray bytes->bytevector pybytesarray-listing)) @@ -189,6 +190,8 @@ (n (slot-ref o 'n))) (apply g bytearray b n l))))) +(define-py* -bool (bool m o nn) (not (= (len o) 0))) + (define-method (write (b ) . l) (define port (if (pair? l) (car l) #t)) (format port "b'") diff --git a/modules/language/python/def.scm b/modules/language/python/def.scm index 389e89e..7045cec 100644 --- a/modules/language/python/def.scm +++ b/modules/language/python/def.scm @@ -81,7 +81,7 @@ (ww- (fold get-ww '() #'(arg ...))) (kv (fold get-kv '() #'(arg ...)))) (if (and-map null? (list kw ww- kv)) - #`(lambda #,as code ...) + #`(object-method (lambda #,as code ...)) (with-syntax ((kw (if (null? kw) (datum->syntax x (gensym "kw")) (car kw))) @@ -91,15 +91,15 @@ ((k ...) (map car kv)) ((s ...) (map ->kw (map car kv))) ((v ...) (map cdr kv))) - #`(object-method - (lambda* (#,@as . l) - (call-with-values (lambda () (get-akw l)) - (lambda (ww* kw) - (let*-values (((ww* k) (take-1 #,(null? ww-) ww* kw s v)) + #`(object-method + (lambda* (#,@as . l) + (call-with-values (lambda () (get-akw l)) + (lambda (ww* kw) + (let*-values (((ww* k) (take-1 #,(null? ww-) ww* kw s v)) ...) - (let ((ww ww*) - (kw (pytonize kw))) - code ...))))))))))))) + (let ((ww ww*) + (kw (pytonize kw))) + code ...))))))))))))) (define-syntax-rule (def (f . args) code ...) (define f (lam args code ...))) diff --git a/modules/language/python/dict.scm b/modules/language/python/dict.scm index 5c7eb4a..6f5e381 100644 --- a/modules/language/python/dict.scm +++ b/modules/language/python/dict.scm @@ -5,6 +5,7 @@ #:use-module (language python yield) #:use-module (language python def) #:use-module (language python for) + #:use-module (language python bool) #:use-module (language python exceptions) #:use-module (language python persist) #:use-module (ice-9 match) @@ -17,6 +18,7 @@ py-popitem py-setdefault py-update py-clear py-hash-ref dict pyhash-listing weak-key-dict weak-value-dict + py-hash-ref py-hash-set! )) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) @@ -219,6 +221,13 @@ (next-method))))))) +(define-method (bool (o )) + (for ((k v : o)) () + (break #t) + #:final #f)) + +(define-method (bool (o )) + (not (= (len o) 0))) (define-py (py-copy copy o) ( diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm index 782b5a9..ddb4be5 100644 --- a/modules/language/python/list.scm +++ b/modules/language/python/list.scm @@ -9,6 +9,7 @@ #:use-module (language python yield) #:use-module (language python for) #:use-module (language python try) + #:use-module (language python bool) #:use-module (language python exceptions) #:use-module (language python persist) #:export (to-list to-pylist py-list @@ -114,6 +115,13 @@ (define-method (to-pylist (o )) (to-pylist (string->list o))) +(define-method (bool (o )) + (not (= (len o) 0))) +(define-method (bool (o )) + (not (= (len o) 0))) +(define-method (bool (o )) + (not (= (len o) 0))) + (define-method (to-pylist l) (if (null? l) (let ((o (make ))) diff --git a/modules/language/python/module/collections.scm b/modules/language/python/module/collections.scm index 393877b..1a158c9 100644 --- a/modules/language/python/module/collections.scm +++ b/modules/language/python/module/collections.scm @@ -604,10 +604,10 @@ (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)) @@ -628,7 +628,7 @@ (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)) @@ -655,20 +655,20 @@ field_names))) mod)) - (pylist-set! dict '__getitem__ - (lambda (self i) + (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__ - (lambda (self i val) + (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__ - (lambda (self) + (lam (self) (let ((l (map (lambda (x) (format #f "~a=~a" x @@ -689,8 +689,6 @@ (map scm-sym (string-split module #\.)))))) - (pylist-set! dict '__module__ module) - (if verbose (pretty-print verbose)))))) (define UserDict dict) @@ -1017,7 +1015,7 @@ (define __mul__ (lambda (self n) - (let ((o (dequeue))) + (let ((o (deque))) (let ((f (ref o 'append))) (let lp ((i 0)) (if (< i n) diff --git a/modules/language/python/module/functools.scm b/modules/language/python/module/functools.scm index 484411b..5f2bd5e 100644 --- a/modules/language/python/module/functools.scm +++ b/modules/language/python/module/functools.scm @@ -1,16 +1,30 @@ (define-module (language python module functools) + #:use-module (ice-9 control) #:use-module (oop pf-objects) #:use-module (language python for) #:use-module (language python try) #:use-module (language python def) #:use-module (language python module threading) #:use-module (language python module weakref) + #:use-module (language python module collections) + #:use-module ((language python module python) + #:select (iter getattr setattr repr isinstance callable + bool str int)) + #:use-module (language python list) + #:use-module (language python dict) + #:use-module (language python set) + #:use-module (language python tuple) + #:use-module (language python property) + #:use-module (language python exceptions) #:export (WRAPPER_ASSIGNMENTS WRAPPER_UPDATES update_wrapper wraps total_ordering cmp_to_key partial partialmethod lru_cache reduce singledispatch)) - +(define-syntax aif + (syntax-rules () + ((_ it p x ) (aif it p x (values))) + ((_ it p x y) (let ((it p)) (if it x y))))) (def (reduce f it (= initializer None)) (let ((it (iter it)) @@ -45,12 +59,12 @@ (for ((attr : assigned)) () (try (lambda () - (let ((value (getatt wrapped attr))) + (let ((value (getattr wrapped attr))) (setattr wrapper attr value))) (#:except AttributeError => values))) (for ((attr : updated)) () - (py-uppdate (getattr wrapper attr) (getattr wrapped attr (dict)))) + (py-update (getattr wrapper attr) (getattr wrapped attr (dict)))) (set wrapper '__wrapped__ wrapped) @@ -174,50 +188,31 @@ cls))) - -def cmp_to_key(mycmp): - """Convert a cmp= function into a key= function""" - class K(object): - __slots__ = ['obj'] - def __init__(self, obj): - self.obj = obj - def __lt__(self, other): - return mycmp(self.obj, other.obj) < 0 - def __gt__(self, other): - return mycmp(self.obj, other.obj) > 0 - def __eq__(self, other): - return mycmp(self.obj, other.obj) == 0 - def __le__(self, other): - return mycmp(self.obj, other.obj) <= 0 - def __ge__(self, other): - return mycmp(self.obj, other.obj) >= 0 - __hash__ = None - return K (define (cmp_to_key mycmp) - (define-python-class-unamed K + (define-python-class-noname K () (define __init__ - (lambda (self, obj) + (lambda (self obj) (set self 'obj obj))) (define __lt__ - (lambda (self, other) - (< (mycmp (ref self 'obj) (ref other obj)) 0))) + (lambda (self other) + (< (mycmp (ref self 'obj) (ref other 'obj)) 0))) (define __gt__ - (lambda (self, other) - (> (mycmp (ref self 'obj) (ref other obj)) 0))) + (lambda (self other) + (> (mycmp (ref self 'obj) (ref other 'obj)) 0))) (define __eq__ - (lambda (self, other) - (= (mycmp (ref self 'obj) (ref other obj)) 0))) + (lambda (self other) + (= (mycmp (ref self 'obj) (ref other 'obj)) 0))) - (define __lt__ - (lambda (self, other) - (<= (mycmp (ref self 'obj) (ref other obj)) 0))) + (define __le__ + (lambda (self other) + (<= (mycmp (ref self 'obj) (ref other 'obj)) 0))) - (define __gt__ - (lambda (self, other) - (>= (mycmp (ref self 'obj) (ref other obj)) 0)))) + (define __ge__ + (lambda (self other) + (>= (mycmp (ref self 'obj) (ref other 'obj)) 0)))) K) @@ -228,12 +223,12 @@ def cmp_to_key(mycmp): (raise TypeError "the first argument must be callable")) (aif it (ref func 'func) - (begin - (set! args (+ (ref func 'args) args)) - (let ((tmpkw (py-copy (ref func 'keywords)))) - (py-update mpkw keywords) - (set! keywords tmpkw) - (set func it)))) + (begin + (set! args (+ (ref func 'args) args)) + (let ((tmpkw (py-copy (ref func 'keywords)))) + (py-update tmpkw keywords) + (set! keywords tmpkw) + (set func it)))) (set self 'func func ) (set self 'args args ) @@ -244,8 +239,8 @@ def cmp_to_key(mycmp): (lam (self (* args) (** keywords)) (let ((newkeywords (py-copy (ref self 'keywords)))) (py-update newkeywords 'keywords) - (py-apply (ref self 'func) (* (ref self 'args) (* args) - (** newkeywords)))))) + (py-apply (ref self 'func) (* (ref self 'args)) (* args) + (** newkeywords))))) (define __repr__ @@ -302,7 +297,7 @@ def cmp_to_key(mycmp): (lambda (self) (def (_method self (* args) (** keywords)) (let ((call_keywords (py-copy (ref self 'keywords))) - (call_args (+ (cls_or_self) (ref self 'args) args))) + (call_args (+ (list self) (ref self 'args) args))) (py-update call_keywords keywords) (py-apply (ref self 'func) (* call_args) (** call_keywords)))) @@ -323,7 +318,7 @@ def cmp_to_key(mycmp): (* (ref self 'args )) (** (ref self 'keywords)))) (aif it (ref new_func '__self__) - (set! result '__self__ it)))))) + (set result '__self__ it)))))) (if (not result) ((ref ((ref self '_make_unbound_method)) '__get__) obj cls) result)))) @@ -335,7 +330,7 @@ def cmp_to_key(mycmp): (define _CacheInfo (namedtuple "CacheInfo" - '("hits", "misses", "maxsize", "currsize"))) + '("hits" "misses" "maxsize" "currsize"))) (define-python-class _HashedSeq (py-list) (define __init__ @@ -345,7 +340,7 @@ def cmp_to_key(mycmp): (define __hash__ (lambda (self) - (ref self 'hashvalue))) + (ref self 'hashvalue)))) (def (_make_key args kwds typed (= kwd_mark (list (object))) @@ -365,7 +360,7 @@ def cmp_to_key(mycmp): (begin (set! key (+ key - (for ((a : args)) (l '()) + (for ((a : args)) ((l '())) (cons (type a) l) #:final (reverse l)))) (if (bool kwds) @@ -408,6 +403,8 @@ def cmp_to_key(mycmp): user_function maxsize typed _CacheInfo))) (update_wrapper wrapper user_function)))) +(define `(, . _)) + (define (_lru_cache_wrapper user_function maxsize typed _CacheInfo) (define sentinel (object)) (define make_key _make_key) @@ -416,14 +413,14 @@ def cmp_to_key(mycmp): (define cache (dict)) (define-values (hits misses) (values 0 0)) (define full #f) - (define cache_get cache.get) - (define cache_len cache.__len__) + (define cache_get (resolve-method-g py-get )) + (define cache_len (resolve-method-g len )) (define lock (RLock)) (define root (list 0 0 0 0)) (list-set! root 0 root) (list-set! root 1 root) - (list-set! root 2 none) - (list-set! root 3 none) + (list-set! root 2 None) + (list-set! root 3 None) (let ((wrapper (cond @@ -482,11 +479,11 @@ def cmp_to_key(mycmp): (oldresult (list-ref root RESULT))) (list-set! root KEY None) (list-set! root RESULT None) - (pylist-delte! cache oldkey) + (pylist-delete! cache oldkey) (pylist-set! cache key oldroot)))) (else - (let ((last (list-ref root PREV)) - (link (list last root key result))) + (let* ((last (list-ref root PREV)) + (link (list last root key result))) (list-set! last NEXT link) (list-set! root PREV link) (pylist-set! cache key link) @@ -500,7 +497,7 @@ def cmp_to_key(mycmp): (define (cache_clear) (with lock - (pylist-clear! cache) + (py-clear cache) (set! root (list #f #f None None)) (list-set! root 0 root) (list-set! root 1 root) @@ -508,10 +505,11 @@ def cmp_to_key(mycmp): (set! misses 0) (set! full #f))) - (set wrapper 'cache_info cache_info) - (set! wrapper 'cache_clear cache_clear) + (set wrapper 'cache_info cache_info) + (set wrapper 'cache_clear cache_clear) wrapper)) +#| ;; single dispatch (define (_c3_merge sequences) (let lp ((result '())) @@ -759,3 +757,4 @@ def cmp_to_key(mycmp): (update_wrapper wrapper func) wrapper) +|# diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm index 8cb47fb..2b1e368 100644 --- a/modules/language/python/module/python.scm +++ b/modules/language/python/module/python.scm @@ -25,6 +25,7 @@ #:use-module (language python range ) #:use-module (language python tuple ) #:use-module (language python eval ) + #:use-module (language python bool ) #:replace (list abs min max hash round format) @@ -33,7 +34,7 @@ IndexError KeyError AttributeError send sendException next GeneratorExit sendClose RuntimeError - SyntaxError + SyntaxError bool len dir next dict None property range tuple bytes bytearray eval locals globals compile exec type object @@ -43,7 +44,7 @@ set all any bin callable reversed chr classmethod staticmethod divmod enumerate filter open - getattr hasattr hex isinstance issubclass + getattr hasattr setattr hex isinstance issubclass iter map sum id input oct ord pow super sorted zip)) @@ -106,11 +107,14 @@ (define miss ((@ (guile) list) 'miss)) (define* (getattr a b #:optional (k miss)) - (let ((r (ref a (symbol->string b) k))) + (let ((r (ref a (if (string? b) (string->symbol b) b) k))) (if (eq? r miss) (raise AttributeError "object/class ~a is missing attribute ~a" a b) r))) +(define (setattr a k v) + (set a (if (string? k) (string->symbol k) k) v)) + (define (hasattr a b) (let ((r (ref a (symbol->string b) miss))) (not (eq? r miss)))) @@ -296,9 +300,6 @@ (setvbuf port 'block buffering))) port)) - - - diff --git a/modules/language/python/module/threading.scm b/modules/language/python/module/threading.scm index b4d43c2..c2dd77c 100644 --- a/modules/language/python/module/threading.scm +++ b/modules/language/python/module/threading.scm @@ -4,11 +4,11 @@ #:use-module (language python def) #:export (RLock)) -(define-python-class RLock +(define-python-class RLock () (define __init__ (lambda (self) (set self '_lock (make-mutex 'recursive)))) - + (define __enter__ (lambda (self) (lock-mutex (ref self '_lock)))) @@ -17,9 +17,8 @@ (lambda (self) (unlock-mutex (ref self '_lock)))) - (define acquire - (lam (self (= blocking #t) (timeout -1)) + (lam (self (= blocking #t) (= timeout -1)) (if blocking (if (< timeout 0) (lock-mutex (ref self '_lock)) @@ -29,8 +28,8 @@ (s (floor y)) (us (floor (* (- y s) 1000000)))) (lock-mutex (ref self '_lock) (cons s us)))) - (try-lock (ref self '_lock))))) - + (try-mutex (ref self '_lock))))) + (define release __leave__)) diff --git a/modules/language/python/procedure.scm b/modules/language/python/procedure.scm index 51b21d4..1289aae 100644 --- a/modules/language/python/procedure.scm +++ b/modules/language/python/procedure.scm @@ -107,8 +107,6 @@ (cons (cons k v) l) #:final (reverse l)))) - ((member tag fixed) - (raise KeyError (format #f "key ~a is unmutable" tag))) (else (set-procedure-property! f tag val)))) @@ -124,8 +122,3 @@ (pylist-sort! ret) ret)) -(define (mk-getter-object f) - (lambda (obj cls) - (if (eq? obj cls) - (lambda x (apply f x)) - (lambda x (apply f obj x))))) diff --git a/modules/language/python/property.scm b/modules/language/python/property.scm index aeb802c..78f6f32 100644 --- a/modules/language/python/property.scm +++ b/modules/language/python/property.scm @@ -18,11 +18,17 @@ (define-python-class property () (define __init__ (lam (o (= getx None) (= setx None) (= delx None)) - (slot-set! o 'get getx) - (slot-set! o 'set setx) - (slot-set! o 'del delx) - o)) - + (slot-set! o 'get getx) + (slot-set! o 'set setx) + (slot-set! o 'del delx) + o)) + + (define __get__ + (lambda (obj class) + (if (eq? obj class) + obj + ((slot-ref obj 'get) obj)))) + (define setter (lambda (self f) (slot-set! self 'set f) diff --git a/modules/language/python/set.scm b/modules/language/python/set.scm index 6931956..d5d36f6 100644 --- a/modules/language/python/set.scm +++ b/modules/language/python/set.scm @@ -8,7 +8,8 @@ #:use-module (language python list) #:use-module (language python yield) #:use-module (language python persist) - #:export (py-set)) + #:use-module (language python bool) + #:export (py-set frozenset)) (define-class () dict) (name-object ) @@ -20,7 +21,7 @@ (let lp ((a a)) (if (pair? a) (begin - (h-set! h (caar a) (cdar a)) + (py-hash-set! h (caar a) (cdar a)) (lp (cdr a)))))))) (list (hash-fold (lambda (k v s) (cons (cons k v) s)) @@ -40,9 +41,13 @@ (slot-set! self 'dict d) (if (eq? x '()) (values) - (for ((y : x)) () - (pylist-set! d y #t))))))) + (for ((y : x)) () + (pylist-set! d y #t))))))) + (define __bool__ + (lambda (self) + (bool (slot-ref self 'dict)))) + (define pop (lambda (self) (call-with-values (lambda () (pylist-pop! (slot-ref self 'dict))) @@ -232,6 +237,5 @@ (yield k) (values)))))) -(name-object set) - (define py-set set) +(define-python-class frozenset (set)) diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm index 9563ad0..11a9737 100644 --- a/modules/language/python/string.scm +++ b/modules/language/python/string.scm @@ -7,6 +7,7 @@ #:use-module (language python list) #:use-module (language python exceptions) #:use-module (language python for) + #:use-module (language python bool) #:use-module (language python persist) #:export (py-format py-capitalize py-center py-endswith py-expandtabs py-find py-rfind @@ -55,6 +56,9 @@ (define-py0 (pylist-ref s i) (list->string (list (string-ref s i)))) +(define-py0 (bool s) + (not (= (len s) 0))) + (define-py (py-capitalize capitalize s) (let* ((n (len s)) (w (make-string n))) diff --git a/modules/language/python/tuple.scm b/modules/language/python/tuple.scm index 3ca4281..4ba83b1 100644 --- a/modules/language/python/tuple.scm +++ b/modules/language/python/tuple.scm @@ -3,6 +3,7 @@ #:use-module (oop pf-objects) #:use-module (language python hash) #:use-module (language python for) + #:use-module (language python bool) #:use-module (language python persist) #:export (tuple defpair)) @@ -19,6 +20,7 @@ (define-method (py-class (o ) tuple)) (define-method (py-equal? (o1 ) o2) (equal? (slot-ref o1 'l) o2)) (define-method (py-equal? o1 (o2 )) (equal? o1 (slot-ref o2 'l))) +(define-method (bool (o )) (pair? (slot-ref o 'l))) (define-method (wrap-in (o )) (wrap-in (slot-ref o 'l))) -- cgit v1.2.3