summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--modules/language/python/compile.scm4
-rw-r--r--modules/language/python/dict.scm117
-rw-r--r--modules/language/python/exceptions.scm6
-rw-r--r--modules/language/python/hash.scm12
-rw-r--r--modules/language/python/list.scm9
-rw-r--r--modules/language/python/module.scm16
-rw-r--r--modules/language/python/module/collections.scm113
-rw-r--r--modules/language/python/module/collections/abc.scm19
-rw-r--r--modules/language/python/module/enum.py47
-rw-r--r--modules/language/python/module/python.scm8
-rw-r--r--modules/language/python/string.scm4
-rw-r--r--modules/oop/pf-objects.scm370
12 files changed, 442 insertions, 283 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index 5df4f3c..00443a9 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -1118,7 +1118,7 @@
(let* ((decor (let ((r (fluid-ref decorations)))
(fluid-set! decorations '())
r))
- (arg_ (get-args_ vs args))
+ (arg_ (get-args_ vs args))
(arg= (get-args= vs args))
(dd= (map cadr arg=))
(c? (fluid-ref is-class?))
@@ -1131,7 +1131,7 @@
(dd** (map cadr **f))
(aa `(,@arg_ ,@*f ,@arg= ,@**f))
(ab (gensym "ab"))
- (vs (union dd** (union dd* (union dd= (union args vs)))))
+ (vs (union dd** (union dd* (union dd= (union arg_ vs)))))
(ns (scope code vs))
(df (defs code '()))
(ex (gensym "ex"))
diff --git a/modules/language/python/dict.scm b/modules/language/python/dict.scm
index 0e130d0..18420dd 100644
--- a/modules/language/python/dict.scm
+++ b/modules/language/python/dict.scm
@@ -191,7 +191,7 @@
(let ((ret (py-hash-ref t key miss)))
(if (eq? ret miss)
(begin
- (py-hash-set! t key val)
+ (py-hash-set! t key val)
(slot-set! o 'n (+ n 1))
(slot-set! o 'hash (logxor (xy (py-hash key) (py-hash val)) h)))
(begin
@@ -275,7 +275,7 @@
(let ((elseval (match l
(() None)
((v) v))))
- (let ((ret (ref o k miss)))
+ (let ((ret (py-hash-ref o k miss)))
(if (eq? ret miss)
elseval
ret))))
@@ -284,7 +284,7 @@
(let ((elseval (match l
(() None)
((v) v))))
- (let ((ret (ref (slot-ref o 't) k miss)))
+ (let ((ret (py-hash-ref (slot-ref o 't) k miss)))
(if (eq? ret miss)
elseval
ret)))))
@@ -545,29 +545,40 @@
(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 dict-get (resolve-method-g py-get <dict>))
-(define dict-len (resolve-method-g len <dict>))
-(define dict-bool (resolve-method-g bool <dict>))
-
-
-(define-python-class dict (<py-hashtable>)
+(define <in> `(,<top> ,<py-hashtable>))
+(define (resolve a b) (object-method (resolve-method-g a b)))
+(define dict-set! (resolve pylist-set! <dict>))
+(define dict-ref (resolve pylist-ref <dict>))
+(define dict-del! (resolve pylist-delete! <dict>))
+(define dict-pop! (resolve pylist-pop! <dict>))
+(define dict-clear! (resolve py-clear <dict>))
+(define dict-get (resolve py-get <dict>))
+(define dict-len (resolve len <dict>))
+(define dict-bool (resolve bool <dict>))
+(define dict-in (resolve in <in> ))
+(define dict-items (resolve py-items <dict>))
+
+(define-python-class dict (<py> <py-hashtable>)
(define __getitem__ dict-ref)
- (define __setitem__ dict-set!)
+ (define __setitem__
+ (lambda (self key val)
+ (dict-set! self key val)))
(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 items dict-items)
+ (define __iter__ (lambda (self)
+ (wrap-in (slot-ref self 't))))
+ (define __contains__
+ (lambda (self x) (dict-in x self)))
(define __format___ (lambda x #f))
(define __setattr__ (@@ (oop pf-objects) __setattr__))
(define __getattribute__ (@@ (oop pf-objects) __getattribute__))
-
+
+
(define __init__
(letrec ((__init__
(case-lambda
@@ -591,7 +602,71 @@
__init__)))
-(define-python-class weak-key-dict (<py-hashtable>)
+(define (norm k)
+ (if (symbol? k)
+ (symbol->string k)
+ k))
+
+(define fail (list 'fail))
+
+(define-python-class dictNs ()
+ (define __getitem__
+ (lambda (self k)
+ (pylist-ref (ref self '_dict) (norm k))))
+
+ (define __setitem__
+ (lambda (self k v)
+ (pylist-set! (ref self '_dict) (norm k) v)))
+
+ (define __iter__
+ (lambda (self)
+ (wrap-in (ref self '_dict))))
+
+ (define pop
+ (lambda (self k . l)
+ (apply pylist-pop! (ref self '_dict) (norm k) l)))
+
+ (define clear
+ (lambda (self)
+ (py-clear (ref self '_dict))))
+
+ (define get
+ (lambda (self key . l)
+ (apply py-get (ref self '_dict) (norm key) l)))
+
+ (define __len__
+ (lambda (self)
+ (len (ref self '_dict))))
+
+ (define __bool__
+ (lambda (self)
+ (bool (ref self '_dict))))
+
+ (define __contains__
+ (lambda (self x)
+ (in (norm x) (ref self '_dict))))
+
+ (define items
+ (lambda (self)
+ (py-items (ref self '_dict))))
+
+ (define __repr__
+ (lambda (self)
+ (format #f "Ns:~a" (ref (ref self '_dict) '__name__))))
+
+ (define __getattr__
+ (lambda (self key)
+ (let ((r (ref (ref self '_dict) key fail)))
+ (if (eq? r fail)
+ (raise (AttributeError key))
+ r))))
+
+ (define __init__
+ (lambda (self d) (set self '_dict d))))
+
+(set! (@@ (oop pf-objects) dictNs) dictNs)
+
+(define-python-class weak-key-dict (<py> <py-hashtable>)
(define __init__
(letrec ((__init__
(case-lambda
@@ -610,7 +685,7 @@
(slot-ref x 't)))))))
__init__)))
-(define-python-class weak-value-dict (<py-hashtable>)
+(define-python-class weak-value-dict (<py> <py-hashtable>)
(define __init__
(letrec ((__init__
(case-lambda
@@ -647,6 +722,10 @@
(pylist-sort! l)
l))
-
+(set! (@@ (oop pf-objects) hash-for-each*)
+ (lambda (f dict)
+ (for ((k v : dict)) ()
+ (f k v))))
+
(define-method (py-class (o <hashtable>)) dict)
(define-method (py-class (o <py-hashtable>)) dict)
diff --git a/modules/language/python/exceptions.scm b/modules/language/python/exceptions.scm
index 9d51116..0e16e4b 100644
--- a/modules/language/python/exceptions.scm
+++ b/modules/language/python/exceptions.scm
@@ -22,11 +22,11 @@
(define __repr__
(lambda (self)
- (aif it (ref self 'value #f)
+ (aif it (rawref self 'value #f)
(format #f "~a:~a"
- (ref self '__name__) it)
+ (rawref self '__name__) it)
(format #f "~a"
- (ref self '__name__))))))
+ (rawref self '__name__))))))
(define-syntax define-er
(syntax-rules ()
diff --git a/modules/language/python/hash.scm b/modules/language/python/hash.scm
index 168cd44..423abb3 100644
--- a/modules/language/python/hash.scm
+++ b/modules/language/python/hash.scm
@@ -42,7 +42,11 @@
s))))
(define-method (py-hash (x <p>))
- (aif it (ref x '__hash__)
- (pk 'hash (it))
- (next-method)))
-
+ (define (next)
+ (catch #t
+ (lambda () (next-method))
+ (lambda x (hash x N))))
+
+ (aif it (ref-class x '__hash__ #f)
+ (it)
+ (next)))
diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm
index 1a8374e..91b66b4 100644
--- a/modules/language/python/list.scm
+++ b/modules/language/python/list.scm
@@ -144,11 +144,6 @@
(define-method (pylist-ref (o <vector>) n)
(vector-ref o n))
-(define-method (pylist-ref (o <p>) n)
- (aif it (ref o '__getitem__)
- (it n)
- (next-method)))
-
;;; SET
(define-method (pylist-set! (o <py-list>) nin val)
(define N (slot-ref o 'n))
@@ -164,10 +159,6 @@
(define-method (pylist-set! (o <vector>) n val)
(vector-set! o n val))
-(define-method (pylist-set! (o <p>) n val)
- (aif it (ref o '__setitem__)
- (it n val)
- (next-method)))
;;SLICE
(define-method (pylist-slice (o <p>) n1 n2 n3)
diff --git a/modules/language/python/module.scm b/modules/language/python/module.scm
index 6570452..101f62e 100644
--- a/modules/language/python/module.scm
+++ b/modules/language/python/module.scm
@@ -139,15 +139,13 @@
(lambda (self k)
(define (fail)
(raise (AttributeError "getattr in Module")))
- (if (rawref self '_module)
- (let ((k (_k k))
- (m (_m self)))
- (let ((x (module-ref m k e)))
- (if (eq? e x)
- (fail)
- x)))
- (fail))))
-
+ (let ((k (_k k))
+ (m (_m self)))
+ (let ((x (module-ref m k e)))
+ (if (eq? e x)
+ (fail)
+ x)))))
+
(define __setattr__
(lambda (self k v)
(let ((k (_k k))
diff --git a/modules/language/python/module/collections.scm b/modules/language/python/module/collections.scm
index 1a158c9..04f7ab6 100644
--- a/modules/language/python/module/collections.scm
+++ b/modules/language/python/module/collections.scm
@@ -94,20 +94,19 @@
(define-python-class OrderedDict (dict)
(define __init__
(lam (self (* args) (** kwds))
+ ((ref dict '__init__) self)
+
(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)))))
+ (if (not (ref self '__root))
+ (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))))
@@ -127,7 +126,7 @@
(set-key! link key)
(set-next! last link)
(set-prev! root link)
- (dict_setitem self key value)))))
+ (dict-set! self key value)))))
(define __delitem__
(lam (self key (= dict_delitem dict-del!))
@@ -145,7 +144,7 @@
(lambda (yield)
(let ((root (ref self '__root)))
(let lp ((curr (get-next root)))
- (if ((not (eq? curr root)))
+ (if (not (eq? curr root))
(let ((key (get-key curr)))
(yield key (pylist-ref self key))
(lp (get-next curr)))))))))))
@@ -209,11 +208,16 @@
(define __update update)
(define keys
- (lambda (self) _OrderedDictKeysView(self)))
+ (lambda (self)
+ (_OrderedDictKeysView self)))
+
(define items
- (lambda (self) _OrderedDictItemsView(self)))
+ (lambda (self)
+ (_OrderedDictItemsView self)))
+
(define values
- (lambda (self) _OrderedDictValuesView(self)))
+ (lambda (self)
+ (_OrderedDictValuesView self)))
(define __ne__ (ref MutableMapping '__ne__))
@@ -645,51 +649,54 @@
(make-p-class (string->symbol typename) '(())
(lambda (dict)
- (pylist-set! dict '__init__
- (eval (v `(lam
- (self
- ,@(map (lambda (key) `(= ,key #f))
- field_names))
+ (pylist-set! dict '__init__
+ (object-method
+ (eval (v `(lam
+ (self
+ ,@(map (lambda (key) `(= ,key #f))
+ field_names))
- ,@(map (lambda (key) `(set self ',key ,key))
- field_names)))
- mod))
+ ,@(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 '__getitem__
+ (object-method
+ (lambda (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)))))
+ (pylist-set! dict '__setitem__
+ (object-method
+ (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__
+ (object-method
+ (lambda (self . l)
+ (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))))))
+ (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)
diff --git a/modules/language/python/module/collections/abc.scm b/modules/language/python/module/collections/abc.scm
index 4bd242d..4d442d3 100644
--- a/modules/language/python/module/collections/abc.scm
+++ b/modules/language/python/module/collections/abc.scm
@@ -516,7 +516,10 @@
(define __iter__
(lambda (self)
- ((ref (ref self '_mapping) 'items)))))
+ ((make-generator ()
+ (lambda (yield)
+ (for ((k v : (ref self '_mapping))) ()
+ (yield (list k v)))))))))
(define-python-class KeysView (MappingView Set)
;; Mixins
@@ -524,10 +527,13 @@
(lambda (self k)
(let ((m (ref self '_mapping)))
(in k m))))
-
+
(define __iter__
(lambda (self)
- ((ref (ref self '_mapping) 'keys)))))
+ ((make-generator ()
+ (lambda (yield)
+ (for ((k v : (ref self '_mapping))) ()
+ (yield k))))))))
(define-python-class ValuesView (MappingView)
;; Mixins
@@ -541,6 +547,7 @@
(define __iter__
(lambda (self)
- ((ref (ref self '_mapping) 'values)))))
-
-
+ ((make-generator ()
+ (lambda (yield)
+ (for ((k v : (ref self '_mapping))) ()
+ (yield v))))))))
diff --git a/modules/language/python/module/enum.py b/modules/language/python/module/enum.py
index 0f623f0..723fab7 100644
--- a/modules/language/python/module/enum.py
+++ b/modules/language/python/module/enum.py
@@ -50,14 +50,12 @@ def _make_class_unpicklable(cls):
_auto_null = object()
-
class auto:
"""
Instances are replaced with an appropriate value in Enum class suites.
"""
value = _auto_null
-
class _EnumDict(dict):
"""Track enum member order and ensure member names are not reused.
@@ -90,10 +88,10 @@ class _EnumDict(dict):
elif _is_dunder(key):
if key == '__order__':
key = '_order_'
- elif key in self._member_names:
+ elif (key in self._member_names):
# descriptor overwriting an enum?
raise TypeError('Attempted to reuse key: %r' % key)
- elif not _is_descriptor(value):
+ elif (not _is_descriptor(value)):
if key in self:
# enum overwriting a descriptor?
raise TypeError('%r already defined as: %r' % (key, self[key]))
@@ -105,13 +103,12 @@ class _EnumDict(dict):
self._last_values.append(value)
super().__setitem__(key, value)
-
# Dummy value for Enum as EnumMeta explicitly checks for it, but of course
# until EnumMeta finishes running the first time the Enum class doesn't exist.
# This is also why there are checks in EnumMeta like `if Enum is not None`
Enum = None
-
+pk('EnumMeta')
class EnumMeta(type):
"""Metaclass for Enum"""
@classmethod
@@ -132,13 +129,15 @@ class EnumMeta(type):
# cannot be mixed with other types (int, float, etc.) if it has an
# inherited __new__ unless a new __new__ is defined (or the resulting
# class will fail).
+
member_type, first_enum = metacls._get_mixins_(bases)
- __new__, save_new, use_args = metacls._find_new_(classdict, member_type,
- first_enum)
+ new, save_new, use_args = metacls._find_new_(classdict, member_type,
+ first_enum)
# save enum items into separate mapping so they don't get baked into
# the new class
enum_members = {k: classdict[k] for k in classdict._member_names}
+
for name in classdict._member_names:
del classdict[name]
@@ -150,21 +149,19 @@ class EnumMeta(type):
if invalid_names:
raise ValueError('Invalid enum member name: {0}'.format(
','.join(invalid_names)))
-
+
# create a default docstring if one has not been provided
if '__doc__' not in classdict:
classdict['__doc__'] = 'An enumeration.'
# 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.
@@ -197,14 +194,16 @@ class EnumMeta(type):
args = (value, )
else:
args = value
+
if member_type is tuple: # special case for tuple enums
args = (args, ) # wrap it one more time
+
if not use_args:
- enum_member = __new__(enum_class)
+ enum_member = new(enum_class)
if not hasattr(enum_member, '_value_'):
enum_member._value_ = value
else:
- enum_member = __new__(enum_class, *args)
+ enum_member = new(enum_class, *args)
if not hasattr(enum_member, '_value_'):
if member_type is object:
enum_member._value_ = value
@@ -214,6 +213,7 @@ class EnumMeta(type):
enum_member._name_ = member_name
enum_member.__objclass__ = enum_class
enum_member.__init__(*args)
+
# If another member with the same value was already defined, the
# new member becomes an alias to the existing one.
for name, canonical_member in enum_class._member_map_.items():
@@ -223,11 +223,13 @@ class EnumMeta(type):
else:
# Aliases don't appear in member names (only in __members__).
enum_class._member_names_.append(member_name)
+
# performance boost for any member that would not shadow
# a DynamicClassAttribute
if member_name not in base_attributes:
setattr(enum_class, member_name, enum_member)
# now add to _member_map_
+
enum_class._member_map_[member_name] = enum_member
try:
# This may fail if value is not hashable. We can't add the value
@@ -370,8 +372,6 @@ class EnumMeta(type):
if name in member_map:
raise AttributeError('Cannot reassign members.')
- pk('set',name)
-
super().__setattr__(name, value)
@@ -522,6 +522,7 @@ class EnumMeta(type):
return __new__, save_new, use_args
+pk('enum')
class Enum(metaclass=EnumMeta):
"""Generic enumeration.
@@ -529,7 +530,6 @@ class Enum(metaclass=EnumMeta):
Derive from this class to define new enumerations.
"""
- pk(1)
def __new__(cls, value):
# all enum instances are actually created during class construction
@@ -551,8 +551,6 @@ 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:
@@ -562,8 +560,6 @@ 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__))
@@ -583,7 +579,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
@@ -611,7 +607,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."""
@@ -658,6 +654,7 @@ class Enum(metaclass=EnumMeta):
module_globals[name] = cls
return cls
+pk('intenum')
class IntEnum(int, Enum):
"""Enum where members are also (and must be) ints"""
@@ -666,6 +663,7 @@ class IntEnum(int, Enum):
def _reduce_ex_by_name(self, proto):
return self.name
+pk('flag')
class Flag(Enum):
"""Support for flags"""
@@ -773,7 +771,8 @@ class Flag(Enum):
]
inverted = reduce(_or_, inverted_members, self.__class__(0))
return self.__class__(inverted)
-
+
+pk('intflag')
class IntFlag(int, Flag):
"""Support for integer-based Flags"""
@@ -837,6 +836,8 @@ class IntFlag(int, Flag):
def __invert__(self):
result = self.__class__(~self._value_)
return result
+
+pk('rest')
def _high_bit(value):
"""returns index of highest bit, or -1 if value is zero or negative"""
diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm
index 1a90757..7b01c93 100644
--- a/modules/language/python/module/python.scm
+++ b/modules/language/python/module/python.scm
@@ -324,7 +324,13 @@
(define-python-class StaticMethod ())
(define-python-class Funcobj ())
+(define-method (py-mod (s <string>) l)
+ (let* ((s (py-replace s "%s" "~a"))
+ (s (py-replace s "%r" "~a"))
+ (l (for ((x : l)) ((r '()))
+ (cons x r)
+ #:final (reverse r))))
+ (apply (@ (guile) format) #f s l)))
-
diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm
index f94580c..ff90ef1 100644
--- a/modules/language/python/string.scm
+++ b/modules/language/python/string.scm
@@ -56,7 +56,9 @@
(define-method (f (o <py-string>) . l) (apply f (slot-ref o 'str) l))))
(define-py0 (pylist-ref s i)
- (list->string (list (string-ref s i))))
+ (list->string (list (string-ref s (if (< i 0)
+ (+ (len s) i)
+ i)))))
(define-py0 (bool s)
(not (= (len s) 0)))
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index 6ee2c58..361e6ee 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -18,6 +18,7 @@
*class* *self* pyobject? pytype?
type object pylist-set! pylist-ref tr
resolve-method-g rawref rawset py-dict
+ ref-class
))
#|
@@ -34,6 +35,9 @@ The datastructure is functional but the objects mutate. So one need to
explicitly tell it to not update etc.
|#
+;; this is mutated by the dict class
+(define dictNs '(dictNs))
+
#;
(define (pkk . l)
(let* ((r (reverse l))
@@ -41,6 +45,8 @@ explicitly tell it to not update etc.
(z (car r)))
(apply pk x)
z))
+
+
(define (pkk . l)
(car (reverse l)))
@@ -115,6 +121,16 @@ explicitly tell it to not update etc.
(name-object <pyf>)
(name-object <property>)
+(define-method (pylist-set! (o <p>) key val)
+ (aif it (ref o '__setitem__)
+ (it key val)
+ (next-method)))
+
+(define-method (pylist-ref (o <p>) key)
+ (aif it (ref o '__getitem__)
+ (it key)
+ (next-method)))
+
(define-method (ref (o <procedure>) key . l)
(aif it (procedure-property o key)
it
@@ -147,12 +163,30 @@ explicitly tell it to not update etc.
(aif dict (hash-ref h '__dict__)
(kif it (py-get dict key fail)
it
- (hash-ref h key -fail))
+ (kif it (py-get dict (symbol->string key) fail)
+ it
+ (hash-ref h key -fail)))
(hash-ref h key -fail))))
+(define-method (find-in-class x key fail) fail)
+
+(define-method (find-in-class-raw (klass <pf>) key fail)
+ (let ((r (vhash-assoc key (slot-ref klass 'h))))
+ (if r
+ (cdr r)
+ fail)))
+
+(define-method (find-in-class-raw (klass <p>) key -fail)
+ (let ((h (slot-ref klass 'h)))
+ (hash-ref h key -fail)))
+
+
(define-syntax-rule (find-in-class-and-parents klass key fail-)
- (aif parents (find-in-class klass '__mro__ #f)
- (let lp ((parents parents))
+ (aif parents (let ((x (find-in-class-raw klass '__mro__ #f)))
+ (if (null? x)
+ #f
+ x))
+ (let lp ((parents parents))
(if (pair? parents)
(kif r (find-in-class (car parents) key fail)
r
@@ -162,20 +196,35 @@ explicitly tell it to not update etc.
r
fail-)))
-(define-inlinable
- (ficap klass key fail) (find-in-class-and-parents klass key fail))
+(define-syntax-rule (find-in-class-and-parents-raw klass key fail-)
+ (aif parents (find-in-class-raw klass '__mro__ #f)
+ (let lp ((parents parents))
+ (if (pair? parents)
+ (kif r (find-in-class-raw (car parents) key fail)
+ r
+ (lp (cdr parents)))
+ fail-))
+ (kif r (find-in-class-raw klass key fail)
+ r
+ fail-)))
+
+(define-inlinable (ficap klass key fail)
+ (find-in-class-and-parents klass key fail))
+
+(define-inlinable (ficap-raw klass key fail)
+ (find-in-class-and-parents-raw klass key fail))
(define (mk-getter-object f)
(lambda (obj cls)
- (pkk 'obj-name (find-in-class obj '__name__ #f))
- (pkk 'cls-name (find-in-class cls '__name__ #f))
- (if (pkk 'type-obj (pytype? obj))
+ (find-in-class obj '__name__ #f)
+ (find-in-class cls '__name__ #f)
+ (if (pytype? obj)
f
- (if (pkk 'class-obj (pyclass? obj))
- (if (pkk 'type-cls (pytype? cls))
+ (if (pyclass? obj)
+ (if (pytype? cls)
(lambda x (apply f obj x))
f)
- (if (pkk 'class-cls (pyclass? cls))
+ (if (pyclass? cls)
(lambda x (apply f obj x))
f)))))
@@ -225,7 +274,7 @@ explicitly tell it to not update etc.
(if (pair? ms)
(let* ((m (car ms))
(p (method-specializers m))
- (f (method-generic-function m)))
+ (f (method-procedure m)))
(aif it (mmatch p pattern)
(cons (cons it f) (lp (cdr ms)))
(lp (cdr ms))))
@@ -258,66 +307,47 @@ explicitly tell it to not update etc.
(list c type)
(list c object))
(cons c l))))
-
+
+(define hash-for-each* hash-for-each)
+
(define (new-class0 meta name parents dict . kw)
- (let* ((goops (pkk 'new-class0 name (pylist-ref dict '__goops__)))
+ (let* ((goops (pylist-ref dict '__goops__))
(p (kwclass->class kw meta))
(class (make-p p)))
(slot-set! class 'procedure
(lambda x
(create-object class x)))
-
- (if (hash-table? dict)
- (hash-for-each
- (lambda (k v) k (set class k v))
- dict)
- (begin (set class '__dict__ dict)))
-
- (let lp ((mro (find-in-class class '__mro__ #f)))
- (if (pair? mro)
- (let ((p (car mro)))
- (aif it (find-in-class p '__zub_classes__ #f)
- (hash-set! it class #t)
- #f)
-
- (aif it (find-in-class p '__init_subclass__ #f)
- (apply it class p #f kw)
- #f)
-
- (lp (cdr mro)))))
(when class
- (rawset class '__class__ meta)
- (rawset class '__goops__ goops)
- (rawset class '__name__ (pylist-ref dict '__name__))
- (rawset class '__bases__ (pylist-ref dict '__bases__))
-
- (rawset class '__mro__
- (add-default
- class
- (find-in-class-and-parents
- class '__mro__ '())))
+ (let lp ((mro (pylist-ref dict '__mro__)))
+ (if (pair? mro)
+ (let ((p (car mro)))
+ (aif it (find-in-class p '__zub_classes__ #f)
+ (hash-set! it class #t)
+ #f)
+
+ (aif it (find-in-class p '__init_subclass__ #f)
+ (apply it class p #f kw)
+ #f)
+
+ (lp (cdr mro)))))
- (if (not (ficap class '__getattribute__ #f))
- (rawset class '__getattribute__ attr))
- (aif it (py-get dict '__getattribute__ #f)
- (rawset class '__getattribute__ it)
- #f)
-
- (aif it (py-get dict '__getattr__)
- (rawset class '__getattr__ it)
- #f)
+ (hash-for-each*
+ (lambda (k v)
+ (let ((k (if (string? k) (string->symbol k) k)))
+ (rawset class k v)))
+ dict)
- (aif it (py-get dict '__setattr__ #f)
- (rawset class '__setattr__ it)
- #f)
-
- (aif it (py-get dict '__delattr__ #f)
- (rawset class '__delattr__ it)
- #f))
-
+ (rawset class '__goops__ goops)
+
+ (let ((mro (add-default class (pylist-ref dict '__mro__))))
+ (rawset class '__mro__ mro))
+
+ (if (not (ficap-raw class '__getattribute__ #f))
+ (rawset class '__getattribute__ attr)))
+
class))
(define (new-class meta name parents dict kw)
@@ -330,11 +360,12 @@ explicitly tell it to not update etc.
(aif it (and meta (find-in-class-and-parents meta '__init__ #f))
(it class name parents dict keys)
#f)
+
class))
(define (the-create-object class x)
- (let* ((meta (and class (find-in-class class '__class__ #f)))
+ (let* ((meta (and class (find-in-class-raw class '__class__ #f)))
(goops (find-in-class class '__goops__ #f))
(obj (aif it (ficap class '__new__ #f)
(apply it class x)
@@ -355,7 +386,7 @@ explicitly tell it to not update etc.
(define (create-object class x)
(if (pytype? class)
(apply type-call class x)
- (let ((meta (and class (find-in-class class '__class__ #f))))
+ (let ((meta (and class (find-in-class-raw class '__class__ #f))))
(with-fluids ((*make-class* #t))
(aif it (ficap meta '__call__ #f)
(apply it class x)
@@ -366,7 +397,7 @@ explicitly tell it to not update etc.
(if (pytype? class)
(apply (case-lambda
((meta obj)
- (and obj (find-in-class obj '__class__ 'None)))
+ (and obj (find-in-class-raw obj '__class__ 'None)))
((meta name bases dict . keys)
(type- meta name bases dict keys)))
class l)
@@ -374,13 +405,13 @@ explicitly tell it to not update etc.
(define (get-dict self name parents)
(aif it (and self (ficap self '__prepare__ #f))
- (it self name parents)
+ (dictNs (it self name parents))
(make-hash-table)))
(define (create-class meta name parents gen-methods keys)
(let ((dict (gen-methods (get-dict meta name parents))))
- (aif it (and meta (find-in-class meta '__class__ #f))
- (aif it (find-in-class it '__call__ #f)
+ (aif it (and meta (find-in-class-raw meta '__class__ #f))
+ (aif it (ficap-raw it '__call__ #f)
(apply it meta name parents dict keys)
(type- meta name parents dict keys))
(type- meta name parents dict keys))))
@@ -468,7 +499,7 @@ explicitly tell it to not update etc.
(fluid-set! *location* klass)
(kif it (find-in-class-and-parents klass key fail)
it
- (aif klass (and klass (find-in-class klass '__class__ #f))
+ (aif klass (and klass (find-in-class-raw klass '__class__ #f))
(begin
(fluid-set! *location* klass)
(kif it (find-in-class-and-parents klass key fail)
@@ -481,8 +512,8 @@ explicitly tell it to not update etc.
(define (mrefx-py x key l)
(let ((xx x))
(define (exit) (if (pair? l) (car l) #f))
- (aif class (find-in-class xx '__class__ #f)
- (aif f (find-in-class-and-parents class '__getattribute__ #f)
+ (aif class (find-in-class-raw xx '__class__ #f)
+ (aif f (ficap-raw class '__getattribute__ #f)
(kif it (if (eq? f __getattribute__)
(f xx key)
(catch #t
@@ -580,17 +611,21 @@ explicitly tell it to not update etc.
(define (mc?) (not (fluid-ref *make-class*)))
(define __setattr__
- (lambda (self key val)
- (kif desc (ref self key fail)
- (aif it (ref desc '__set__)
- (it self val)
- (mset self key val))
- (mset self key val))))
+ (lambda (self key1 val)
+ (define key (if (string? key1) (string->symbol key1) key1))
+ (let ((h (aif dict (rawref self '__dict__)
+ dict
+ (slot-ref self 'h))))
+ (kif desc (py-get h key fail)
+ (aif it (rawref desc '__set__ #f)
+ (it self val)
+ (pylist-set! h key val))
+ (pylist-set! h key val)))))
(define (mset-py x key val)
(let* ((xx x))
- (aif class (find-in-class xx '__class__ #f)
- (aif f (find-in-class-and-parents class '__setattr__ #f)
+ (aif class (find-in-class-raw xx '__class__ #f)
+ (aif f (find-in-class-and-parents-raw class '__setattr__ #f)
(if (eq? f __setattr__)
(f xx key val)
(f xx (symbol->string key) val))
@@ -866,14 +901,14 @@ explicitly tell it to not update etc.
(if (null? cparents)
type
(let* ((p (car cparents))
- (m (ref p '__class__))
+ (m (rawref p '__class__))
(mro (reverse (ref m '__mro__ '()))))
(let lp ((l (cdr cparents))
(max mro)
(min mro))
(if (pair? l)
(let* ((p (car l))
- (meta (ref p '__class__))
+ (meta (rawref p '__class__))
(mro (ref meta '__mro__ '())))
(let lp2 ((max max) (mr (reverse mro)))
(if (and (pair? max) (pair? mr))
@@ -886,10 +921,24 @@ explicitly tell it to not update etc.
(lp (cdr l) max mro)
(lp (cdr l) max min))
(lp (cdr l) mro min)))))
- (car (reverse min))))))))
+ (if (null? min)
+ type
+ (car (reverse min)))))))))
+ (define (unique l)
+ (define t (make-hash-table))
+ (let lp ((l l))
+ (if (pair? l)
+ (let ((c (car l)))
+ (if (hashq-ref t c)
+ (lp (cdr l))
+ (begin
+ (hashq-set! t c #t)
+ (cons c (lp (cdr l))))))
+ '())))
- (define goops (make-class (append goopses
- (list (kw->class kw meta)))
+ (define goops (make-class (unique
+ (append goopses
+ (list (kw->class kw meta))))
'() #:name name))
(define (make-module)
@@ -912,21 +961,17 @@ explicitly tell it to not update etc.
(cons y (lp (cdr x)))
(lp (cdr x))))
'())))
-
+
(methods dict)
-
(pylist-set! dict '__goops__ goops)
- (pylist-set! dict '__class__ meta)
(pylist-set! dict '__zub_classes__ (make-weak-key-hash-table))
(pylist-set! dict '__module__ (make-module))
(pylist-set! dict '__bases__ (filt-bases parents))
- (pylist-set! dict '__fget__ #t)
- (pylist-set! dict '__fset__ #t)
(pylist-set! dict '__name__ name)
(pylist-set! dict '__qualname__ name)
- (pylist-set! dict '__class__ meta)
(pylist-set! dict '__mro__ (get-mro cparents))
(pylist-set! dict '__doc__ doc)
+ (pylist-set! dict '__class__ meta)
dict)
(let ((cl (with-fluids ((*make-class* #t))
@@ -1047,10 +1092,9 @@ explicitly tell it to not update etc.
(make-p-class 'name doc
parents
(lambda (dict)
- (begin
- (pylist-set! dict 'dname dname))
+ (pylist-set! dict 'dname dname)
...
- (values)))))
+ dict))))
(begin
(module-define! (current-module) 'ddname dname)
(name-object ddname))
@@ -1101,24 +1145,36 @@ explicitly tell it to not update etc.
(else
'none)))
-(define (print o l)
- (define p (if (pyclass? o) "C" (if (pyobject? o) "O" "T")))
- (define port (if (pair? l) (car l) #t))
- (format port "~a"
- (aif it (if (pyclass? o)
- #f
- (if (pyobject? o)
- (ref o '__repr__)
- #f))
- (format
- #f "~a(~a)<~a>"
- p (get-type o) (it))
- (format
- #f "~a(~a)<~a>"
- p (get-type o) (ref o '__name__ 'Annonymous)))))
-
-(define-method (write (o <p>) . l) (print o l))
-(define-method (display (o <p>) . l) (print o l))
+(define (print o l z)
+ (begin
+ (define p (if (pyclass? o) "C" (if (pyobject? o) "O" "T")))
+ (define port (if (pair? l) (car l) #t))
+ (format port "~a"
+ (aif it (if (pyclass? o)
+ #f
+ (if (pyobject? o)
+ z
+ #f))
+ (format
+ #f "~a(~a)<~a>"
+ p (get-type o) (it))
+ (format
+ #f "~a(~a)<~a>"
+ p (get-type o) (aif it (find-in-class-raw
+ o '__name__ 'Annonymous)
+ it
+ (ref
+ o '__name__ 'Annonymous)))))))
+
+(define-method (write (o <p>) . l)
+ (aif it (ref o '__repr__)
+ (print o l it)
+ (print o l #f)))
+
+(define-method (display (o <p>) . l)
+ (aif it (ref o '__repr__)
+ (print o l it)
+ (print o l #f)))
(define (arglist->pkw l)
(let lp ((l l) (r '()))
@@ -1152,7 +1208,7 @@ explicitly tell it to not update etc.
(define type-goops #f)
(define (kind x)
- (if (not type-goops) (set! type-goops (ref type '__goops__)))
+ (if (not type-goops) (set! type-goops (rawref type '__goops__)))
(and (is-a? x <p>)
(aif it (find-in-class x '__goops__ #f)
(if (or
@@ -1181,7 +1237,6 @@ explicitly tell it to not update etc.
(define (not-a-super) 'not-a-super)
(define (py-super class obj)
(define (make cl parents)
- (pk 'parents cl parents)
(if (not cl)
#f
(let ((c (make-p <py>))
@@ -1191,21 +1246,18 @@ explicitly tell it to not update etc.
(rawset c '__getattribute__
(lambda (self key)
(set! key (if (string? key) (string->symbol key) key))
- (pk 'key key)
- (pk key (kif it (pk 'it (ficap c key fail))
- (aif dt (pk '__get__ (ref it '__get__))
- (dt obj cl)
- it)
- fail))))
+ (kif it (ficap c key fail)
+ (aif dt (ref it '__get__)
+ (dt obj cl)
+ it)
+ fail)))
(rawset c '__name__ "**super**")
(rawset o '__class__ c)
o)))
- (pk 'super class (ref obj '__name__))
-
(call-with-values
(lambda ()
- (let ((ll (pk 'l class (ref (ref obj '__class__) '__mro__ '()))))
+ (let ((ll (ref (ref obj '__class__) '__mro__ '())))
(if (pair? ll)
(let lp ((l ll))
(if (pair? l)
@@ -1378,40 +1430,45 @@ explicitly tell it to not update etc.
(hash-fold (lambda (k v s) (cons k s)) '() h))
'()))
+(define ref-class
+ (lambda (self key fail)
+ (aif class (find-in-class-raw self '__class__ #f)
+ (kif it1 (ficap class key fail)
+ (aif dd1 (rawref it1 '__get__)
+ (dd1 self class)
+ it1)
+ fail)
+ fail)))
+
(define __getattribute__
- (case-lambda
- ((self key)
- (define (-fail class)
- (if (eq? key 'mro)
- (find-in-class self '__mro__ fail)
- fail))
-
- (aif class (pkk 'class (find-in-class self '__class__ #f))
- (kif it1 (pkk 'c (find-in-class-and-parents class key fail))
- (aif dd1 (pkk 'get (rawref it1 '__get__))
- (if (pkk 'set (rawref it1 '__set__))
- (pkk 'desc key (dd1 self class))
- (kif it2 (find-in-class-and-parents self key fail)
- (pkk 'object key it2)
- (pkk 'gox key (dd1 self class))))
- (kif it2 (pkk 'o (find-in-class-and-parents self key fail))
- (pkk 'object key it2)
- (pkk 'class key it1)))
- (kif it2 (pkk 'o2 (find-in-class-and-parents self key fail))
- (pkk 'object key it2)
- (aif it (pkk 'getattr
- (find-in-class-and-parents class '__getattr__ #f))
- (kif it1 (catch #t
- (lambda () (it self (symbol->string key)))
+ (lambda (self key-)
+ (define key (if (string? key-) (string->symbol key-) key-))
+ (aif class (find-in-class-raw self '__class__ #f)
+ (kif it1 (ficap class key fail)
+ (aif dd1 (rawref it1 '__get__)
+ (if (rawref it1 '__set__)
+ (dd1 self class)
+ (kif it2 (ficap self key fail)
+ it2
+ (dd1 self class)))
+ (kif it2 (ficap self key fail)
+ it2
+ it1))
+ (kif it2 (ficap self key fail)
+ it2
+ (aif it (ficap-raw class '__getattr__ #f)
+ (kif it1 (catch #t
+ (lambda ()
+ (it self (symbol->string key)))
(lambda x fail))
- (aif dd1 (rawref it1 '__get__)
- (pkk 'getattr-gox key (dd1 self class))
- (pkk 'getattr key it1))
- (pkk 'fail1 (-fail class)))
- (pkk 'fail2 (-fail class)))))
- (pkk 'classfail fail)))))
-
+ (aif dd1 (rawref it1 '__get__)
+ (dd1 self class)
+ it1)
+ fail)
+ fail)))
+ fail)))
+
(define attr __getattribute__)
(define (*str* self)
@@ -1434,6 +1491,7 @@ explicitly tell it to not update etc.
(define mro (lambda (self) (ref self '__mro__)))))
(set type '__class__ type)
+(rawset type '__mro__ (list type))
(define _mro (object-method (lambda (self) (ref self '__mro__))))
@@ -1441,6 +1499,11 @@ explicitly tell it to not update etc.
(set! object
(make-python-class object ()
+ (define __new__ (lambda (class . a)
+ (make-object
+ class
+ (find-in-class-raw class '__class__ #f)
+ (find-in-class-raw class '__goops__ #f))))
(define __init__ (lambda x (values)))
(define __subclasses__ subclasses)
(define __getattribute__ attr)
@@ -1449,7 +1512,8 @@ explicitly tell it to not update etc.
(define __format__ (lambda (self x) (*str* self)))
(define __reduce_ex__ (lambda x (error "not implemented")))
(define __weakref__ (lambda (self) self))))
-
+
+(rawset object '__mro__ (list object))
(name-object type)
(name-object object)
@@ -1467,7 +1531,7 @@ explicitly tell it to not update etc.
(if (eq? x 'None)
(py-dict NoneObj)
(make-hash-table)))
-
+
(define-method (py-dict (o <p>))
(aif it (ref o '__dict__)
it
generated by cgit v1.2.3 (git 2.46.0) at 2024-11-10 11:10:00 +0000