From 1b2144cfb35202c05f39f279198a6ad90748be23 Mon Sep 17 00:00:00 2001 From: Stefan Israelsson Tampe Date: Wed, 25 Apr 2018 20:00:41 +0200 Subject: improvements --- modules/language/python/compile.scm | 88 ++++++++----------------------- modules/language/python/dict.scm | 26 ++++++++- modules/language/python/for.scm | 3 ++ modules/language/python/list.scm | 8 +-- modules/language/python/module.scm | 17 +++--- modules/language/python/module/enum.py | 31 +++++++---- modules/language/python/module/python.scm | 12 +++-- 7 files changed, 89 insertions(+), 96 deletions(-) (limited to 'modules/language/python') diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index 93adc75..5df4f3c 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -68,32 +68,6 @@ (fluid-ref (@@ (system base message) %dont-warn-list))))) (lambda x (values)))) -(define *prefixes* (make-fluid '())) -(define (add-prefix id) - (catch #t - (lambda () - (if (fluid-ref (@@ (system base compile) %in-compile)) - (fluid-set! *prefixes* (cons id (fluid-ref *prefixes*))) - (begin - (when (not (module-defined? (current-module) '__prefixes__)) - (module-define! (current-module) - '__prefixes__ (make-fluid '()))) - - (let ((p (module-ref (current-module) '__prefixes__))) - (fluid-set! p (cons id (fluid-ref p))))))) - (lambda x (values)))) - -(define (is-prefix? id) - (catch #t - (lambda () - (if (fluid-ref (@@ (system base compile) %in-compile)) - (member id (fluid-ref *prefixes*)) - (if (not (module-defined? (current-module) '__prefixes__)) - #f - (let ((p (module-ref (current-module) '__prefixes__))) - (member id (fluid-ref p)))))) - (lambda x #f))) - (define-syntax call (syntax-rules () ((_ (f) . l) (f . l)))) @@ -317,9 +291,9 @@ (mkfast ;; General ((__init__) (O 'py-init)) - ((__getattr__) (O 'getattr)) - ((__setattr__) (O 'setattr)) - ((__delattr__) (O 'delattr)) + ((__getattr__) (O 'ref)) + ((__setattr__) (O 'set)) + ((__delattr__) (O 'del)) ((__ne__) (O 'ne)) ((__eq__) (O 'equal?)) ((__repr__) (O 'repr)) @@ -541,7 +515,7 @@ (lp (cdr l) (cons x r)))) (list (G 'cons) `(,(G 'list) ,@(reverse r)) ''())))) -(define (get-addings vs x) +(define (get-addings vs x fast?) (match x (() '()) ((x . l) @@ -558,16 +532,16 @@ (let* ((tag (exp vs x)) (xs (gensym "xs")) (fast (fastfkn tag)) - (is-fkn? (aif it (and is-fkn? fast) + (is-fkn? (aif it (and fast? is-fkn? fast) `(#:call-obj (lambda (e) (lambda ,xs (apply ,it e ,xs)))) #f))) (if is-fkn? is-fkn? - (if fast + (if (and fast? fast) `(#:fastfkn-ref ,fast ',tag) - (aif it (fast-ref tag) + (aif it (and fast? (fast-ref tag)) `(#:fast-id ,it ',tag) `(#:identifier ',tag)))))) @@ -595,7 +569,7 @@ n1 n2 n3)))) (_ (error "unhandled addings"))) - (get-addings vs l)))))) + (get-addings vs l fast?)))))) (define-syntax-rule (setwrap u) (call-with-values (lambda () u) @@ -623,25 +597,15 @@ ((#:verb x) x) ((#:test (#:power kind v addings . _) . _) (let* ((v (exp vs v)) - (v.add (if (is-prefix? v) - (let ((w (symbol->string (exp vs (car addings))))) - (cons (string-append (symbol->string v) "." w) - (cdr addings))) - (cons v addings))) - (v (car v.add)) - (addings (cdr v.add)) - (addings (get-addings vs addings)) + (fast? (not (eq? v 'super))) + (addings (get-addings vs addings fast?)) (p.a (match kind (#f (cons #f '())) ((v add) - (if (is-prefix? v) - (let ((w (symbol->string (exp vs (car add))))) - (cons (string-append (symbol->string v) "." w) - (cdr add))) - (cons (exp vs v) add))))) + (cons (exp vs v) add)))) (p (car p.a)) (pa (cdr p.a)) - (pa (get-addings vs pa))) + (pa (get-addings vs pa fast?))) (define q (lambda (x) `',x)) (if kind (if (not p) @@ -733,24 +697,14 @@ (exp vs x)) ((_ #f vf trailer . **) - (let* ((vf (exp vs vf)) - (vf.tr (if (is-prefix? vf) - (cons - (string->symbol - (string-append - (symbol->string vf) - "." - (symbol->string (exp vs (car trailer))))) - (cdr trailer)) - (cons vf trailer))) - (vf (car vf.tr)) - (trailer (cdr vf.tr))) + (let* ((vf (exp vs vf)) + (fast? (not (eq? vf 'super)))) (define (pw x) (if ** `(expt ,x ,(exp vs **)) x)) (pw - (let ((trailer (get-addings vs trailer))) + (let ((trailer (get-addings vs trailer fast?))) `(,(C 'ref-x) ,vf ,@trailer)))))) (#:identifier @@ -861,9 +815,11 @@ '(void)) ((_ (#:power #f base (l ... fin) . #f)) - (let ((add (get-addings vs l)) - (fin (get-addings vs (list fin))) - (f (exp vs base))) + (let* ((f (exp vs base)) + (fast? (not (eq? f 'super))) + (add (get-addings vs l fast?)) + (fin (get-addings vs (list fin) fast?))) + `(,(C 'del-x) (,(C 'ref-x) ,f ,@add) ,@fin)))) (#:with @@ -927,7 +883,7 @@ (() #f) (#f #f) ((#:arglist . _) - (get-addings vs (list parents)))))) + (get-addings vs (list parents) #f))))) `(set! ,class (,(C 'class-decor) ,decor (,(C 'with-class) ,class @@ -1518,7 +1474,7 @@ (x '()))) (if (fluid-ref (@@ (system base compile) %in-compile)) - (with-fluids ((*prefixes* '())) + (begin (if (fluid-ref (@@ (system base compile) %in-compile)) (set! s/d 'set!) (set! s/d (C 'define-))) diff --git a/modules/language/python/dict.scm b/modules/language/python/dict.scm index f76e2ad..0e130d0 100644 --- a/modules/language/python/dict.scm +++ b/modules/language/python/dict.scm @@ -123,7 +123,7 @@ 0 o)) (define-method (py-hash (o )) - (slot-ref o 'h)) + (slot-ref o 'hash)) (define-method (len (o )) (hash-fold (lambda (k v s) (+ s 1)) 0 o)) @@ -543,7 +543,31 @@ (define-method (in key (o )) (py-has_key o key)) + +(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 dict-get (resolve-method-g py-get )) +(define dict-len (resolve-method-g len )) +(define dict-bool (resolve-method-g bool )) + + (define-python-class dict () + (define __getitem__ dict-ref) + (define __setitem__ dict-set!) + (define __delitem__ dict-del!) + (define pop dict-pop!) + (define clear dict-clear!) + (define get dict-get) + (define __len__ dict-len) + (define __bool__ dict-bool) + (define __format___ (lambda x #f)) + (define __setattr__ (@@ (oop pf-objects) __setattr__)) + (define __getattribute__ (@@ (oop pf-objects) __getattribute__)) + (define __init__ (letrec ((__init__ (case-lambda diff --git a/modules/language/python/for.scm b/modules/language/python/for.scm index 7b8e57b..c618828 100644 --- a/modules/language/python/for.scm +++ b/modules/language/python/for.scm @@ -114,6 +114,9 @@ (slot-ref o 's) (slot-ref o 'i)))) +(define-method (next x) + (throw StopIteration)) + (define-method (next (l )) (let ((ll (slot-ref l 'l))) (if (pair? ll) diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm index ddb4be5..1a8374e 100644 --- a/modules/language/python/list.scm +++ b/modules/language/python/list.scm @@ -194,9 +194,9 @@ (define N (string-length o)) (define (f n) (if (< n 0) (+ N n) n)) - (let* ((n1 (f (if (eq? n1 None) 0 n1))) - (n2 (f (if (eq? n2 None) (slot-ref o 'n) n2))) - (n3 (f (if (eq? n3 None) 1 n3)))) + (let* ((n1 (f (if (eq? n1 None) 0 n1))) + (n2 (f (if (eq? n2 None) (string-length o) n2))) + (n3 (f (if (eq? n3 None) 1 n3)))) (list->string (to-list (pylist-slice (to-pylist o) n1 n2 n3))))) @@ -937,7 +937,7 @@ #:final #t)) -(define (py-any x) +(define (py-any . x) (for ((i : x)) () (if i (break #t)) diff --git a/modules/language/python/module.scm b/modules/language/python/module.scm index 5c5d630..6570452 100644 --- a/modules/language/python/module.scm +++ b/modules/language/python/module.scm @@ -67,11 +67,11 @@ ((self pre l nm) (match l ((name) - (set self '_path (reverse (cons name pre))) + (rawset self '_path (reverse (cons name pre))) (_cont self #f (cons name pre) #f (cons name nm) #f)) ((name . (and l (name2 . _))) - (set self '_path (reverse (cons name pre))) + (rawset self '_path (reverse (cons name pre))) (_cont self name2 (cons name pre) l (cons name nm) #t)))) @@ -122,8 +122,8 @@ (rawset self '_private #f) (if (not (rawref self '_module)) (begin - (set self '__name__ (string-join - (map symbol->string (reverse nm)) ".")) + (rawset self '__name__ (string-join + (map symbol->string (reverse nm)) ".")) (let* ((_module (in-scheme (resolve-module (reverse l)))) (public-i (and _module (module-public-interface _module)))) (if (and (not skip-error?) (not public-i)) @@ -131,8 +131,8 @@ (format #f "No module named ~a" (ref self '__name__))))) - (set self '_export (module-public-interface _module)) - (set self '_module _module) + (rawset self '_export (module-public-interface _module)) + (rawset self '_module _module) (hash-set! _modules l self)))))) (define __getattr__ @@ -177,11 +177,10 @@ (lambda (self) (let* ((h (slot-ref self 'h)) (l '()) + (m (_m self)) (add (lambda (k . u) (set! l (cons (symbol->string k) l))))) (hash-for-each add h) - (aif it (ref self '_module) - (module-for-each add it) - #f) + (module-for-each add m) (py-list l)))) diff --git a/modules/language/python/module/enum.py b/modules/language/python/module/enum.py index eefc1b5..0f623f0 100644 --- a/modules/language/python/module/enum.py +++ b/modules/language/python/module/enum.py @@ -83,7 +83,7 @@ class _EnumDict(dict): if key not in ( '_order_', '_create_pseudo_member_', '_generate_next_value_', '_missing_', - ): + ): raise ValueError('_names_ are reserved for future Enum use') if key == '_generate_next_value_': setattr(self, '_generate_next_value', value) @@ -118,7 +118,7 @@ class EnumMeta(type): def __prepare__(metacls, cls, bases): # create the namespace dict enum_dict = _EnumDict() - + # inherit previous flags and _generate_next_value_ function member_type, first_enum = metacls._get_mixins_(bases) @@ -157,14 +157,14 @@ class EnumMeta(type): # create our new Enum type enum_class = super().__new__(metacls, cls, bases, classdict) - + pk(enum_class) enum_class._member_names_ = [] # names in definition order enum_class._member_map_ = OrderedDict() # name->value map enum_class._member_type_ = member_type # save attributes from super classes so we know if we can take # the shortcut of storing members in the class dict - + base_attributes = {a for b in enum_class.mro() for a in b.__dict__} # Reverse value->name map for hashable values. @@ -261,7 +261,7 @@ class EnumMeta(type): _order_ = _order_.replace(',', ' ').split() if _order_ != enum_class._member_names_: raise TypeError('member order does not match _order_') - pk('enum class fom new',enum_class) + return enum_class def __bool__(self): @@ -364,11 +364,17 @@ class EnumMeta(type): resulting in an inconsistent Enumeration. """ + member_map = cls.__dict__.get('_member_map_', {}) + if name in member_map: raise AttributeError('Cannot reassign members.') + + pk('set',name) + super().__setattr__(name, value) + def _create_(cls, class_name, names=None, *, module=None, qualname=None, type=None, start=1): """Convenience method to create a new Enum class. @@ -516,13 +522,15 @@ class EnumMeta(type): return __new__, save_new, use_args -pk(1) + class Enum(metaclass=EnumMeta): """Generic enumeration. Derive from this class to define new enumerations. """ + pk(1) + def __new__(cls, value): # all enum instances are actually created during class construction # without calling this method; this method is called by the metaclass' @@ -543,6 +551,8 @@ class Enum(metaclass=EnumMeta): # still not found -- try _missing_ hook return cls._missing_(value) + pk(2) + def _generate_next_value_(name, start, count, last_values): for last_value in reversed(last_values): try: @@ -552,6 +562,8 @@ class Enum(metaclass=EnumMeta): else: return start + pk(3) + @classmethod def _missing_(cls, value): raise ValueError("%r is not a valid %s" % (value, cls.__name__)) @@ -571,7 +583,7 @@ class Enum(metaclass=EnumMeta): if m[0] != '_' and m not in self._member_map_ ] return (['__class__', '__doc__', '__module__'] + added_behavior) - + pk(4) def __format__(self, format_spec): # mixed-in Enums should use the mixed-in type's __format__, otherwise # we can get strange results with the Enum name showing up instead of @@ -599,7 +611,7 @@ class Enum(metaclass=EnumMeta): # to have members named `name` and `value`. This works because enumeration # members are not set directly on the enum class -- __getattr__ is # used to look them up. - + pk(5) @DynamicClassAttribute def name(self): """The name of the Enum member.""" @@ -646,7 +658,6 @@ class Enum(metaclass=EnumMeta): module_globals[name] = cls return cls -pk(2) class IntEnum(int, Enum): """Enum where members are also (and must be) ints""" @@ -763,7 +774,6 @@ class Flag(Enum): inverted = reduce(_or_, inverted_members, self.__class__(0)) return self.__class__(inverted) - class IntFlag(int, Flag): """Support for integer-based Flags""" @@ -828,7 +838,6 @@ class IntFlag(int, Flag): result = self.__class__(~self._value_) return result - def _high_bit(value): """returns index of highest bit, or -1 if value is zero or negative""" return value.bit_length() - 1 diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm index ef42cc6..1a90757 100644 --- a/modules/language/python/module/python.scm +++ b/modules/language/python/module/python.scm @@ -3,9 +3,9 @@ #:use-module (ice-9 match) #:use-module (ice-9 readline) #:use-module ((oop pf-objects) #:select - (

class-method static-method ref + (

class-method static-method ref (set . pf-set) py-super-mac type object pylist-ref define-python-class - object-method)) + object-method py-dict)) #:use-module (language python exceptions ) #:use-module ((language python module string ) #:select ()) #:use-module ((language python module io ) #:select (open)) @@ -48,11 +48,13 @@ divmod enumerate filter getattr hasattr setattr hex isinstance issubclass iter sum id input oct ord pow super - sorted zip + sorted zip vars ClassMethod StaticMethod Funcobj)) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) +(define vars py-dict) + (define print (case-lambda (() ((@ (guile) format) #t "~%")) @@ -112,10 +114,10 @@ r))) (define (setattr a k v) - (set a (if (string? k) (string->symbol k) k) v)) + (pf-set a (if (string? k) (string->symbol k) k) v)) (define (hasattr a b) - (let ((r (ref a (symbol->string b) miss))) + (let ((r (ref a (if (string? b) (string->symbol b) b) miss))) (not (eq? r miss)))) (define-method (issubclass x y) #f) -- cgit v1.2.3