summaryrefslogtreecommitdiff
path: root/modules
diff options
context:
space:
mode:
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>2018-04-15 22:29:50 +0200
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>2018-04-15 22:29:50 +0200
commit77e4e51a919c50e2847527aaffe67e8e19b970ae (patch)
tree61a261e5b053da07493610b947fd8b51e1a8c2f4 /modules
parent7c0c098b89dc33ad1018b6542def4e2d34ddd2a8 (diff)
progressively imporoving the conformance with python3
Diffstat (limited to 'modules')
-rw-r--r--modules/language/python/compile.scm234
-rw-r--r--modules/language/python/def.scm7
-rw-r--r--modules/language/python/dict.scm66
-rw-r--r--modules/language/python/exceptions.scm3
-rw-r--r--modules/language/python/module/enum.py50
-rw-r--r--modules/language/python/module/python.scm4
-rw-r--r--modules/language/python/number.scm60
-rw-r--r--modules/language/python/set.scm16
-rw-r--r--modules/oop/pf-objects.scm328
9 files changed, 484 insertions, 284 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index fc4a1c7..a54dab8 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -44,7 +44,9 @@
(define-syntax-rule (use a ...)
(catch #t
(lambda () (use-modules a ...))
- (lambda x (raise (ImportError '(a ...))))))
+ (lambda x
+ (warn "failed to load " x)
+ (raise (ImportError '(a ...))))))
(define s/d 'set!)
@@ -213,21 +215,36 @@
(union vs (list (exp '() (if as as (car ids)))))))
vs)))
- ((#:expr-stmt l (#:assign u))
- (union (fold (lambda (x s)
- (match x
- ((#:test (#:power v2 v1 () . _) . _)
- (if v2
- (union
- (union (list (exp '() v1))
- (list (exp '() v2)))
- s)
- (union (list (exp '() v1)) s)))
- (_ s)))
- '()
- l)
- vs))
+ ((#:expr-stmt l (#:assign u ... v))
+ (union
+ (fold (lambda (l s)
+ (union
+ s
+ (fold (lambda (x s)
+ (match x
+ ((#:test (#:power v2 v1 () . _) . _)
+ (if v2
+ (union
+ (union (list (exp '() v1))
+ (list (exp '() v2)))
+ s)
+ (union (list (exp '() v1)) s)))
+ (_ s)))
+ '()
+ l)))
+ '()
+ (cons l u))
+ vs))
+
+ ((#:for es in code . final)
+ (let ((vs (let lp ((es es))
+ (match es
+ (((#:power #f (#:tuple . l) . _))
+ (lp l))
+ (_ (union vs (map (g vs exp) es)))))))
+ (scope final (scope code vs))))
+
((#:expr-stmt l (#:assign k . u))
(union
(union (fold (lambda (x s)
@@ -248,7 +265,7 @@
((x . y)
(scope y (scope x vs)))
(_ vs)))
-
+
(define (defs x vs)
(match x
((#:def (#:identifier f) . _)
@@ -515,14 +532,14 @@
#:final
(reverse l)))
-(define (arglist->pkw . l)
+(define (arglist->pkw l)
(let lp ((l l) (r '()))
(if (pair? l)
(let ((x (car l)))
- (if (keyword? x)
- (cons (reverse r) l)
- (lp (cdr l) (cons x r))))
- (cons (reverse l) '()))))
+ (if (keyword? x)
+ (list (G 'cons) `(,(G 'list) ,@(reverse r)) `(,(G 'list) ,@l))
+ (lp (cdr l) (cons x r))))
+ (list (G 'cons) `(,(G 'list) ,@(reverse r)) ''()))))
(define (get-addings vs x)
(match x
@@ -892,6 +909,12 @@
((_ class parents code)
(with-fluids ((is-class? #t))
(let ()
+ (define (clean l)
+ (match l
+ (((#:apply . l). u) (append (clean l) (clean u)))
+ (((`= x v ) . l) (cons* (symbol->keyword x) v (clean l)))
+ ((x . l) (cons x (clean l)))
+ (() '())))
(let* ((decor (let ((r (fluid-ref decorations)))
(fluid-set! decorations '())
r))
@@ -911,7 +934,7 @@
(,(C 'mk-p-class2)
,class
,(if parents
- `(,(C 'ref-x) ,(C 'arglist->pkw) ,@parents)
+ (arglist->pkw (clean parents))
`(,(G 'cons) '() '()))
,(map (lambda (x) `(define ,x #f)) ls)
,(exp vs code))))))))))
@@ -1150,6 +1173,7 @@
(dd* (map cadr *f))
(**f (get-args** vs args))
(dd** (map cadr **f))
+ (aa `(,@arg_ ,@*f ,@arg= ,@**f))
(ab (gensym "ab"))
(vs (union dd** (union dd* (union dd= (union args vs)))))
(ns (scope code vs))
@@ -1174,19 +1198,19 @@
`(set! ,f
(,(C 'def-decor) ,decor
(,(C 'def-wrap) ,y? ,f ,ab
- (,(D 'lam) (,@arg_ ,@*f ,@arg= ,@**f)
+ (,(D 'lam) ,aa
(,(C 'with-return) ,r
,(mk `(let ,(map (lambda (x) (list x #f)) ls)
- (,(C 'with-self) ,c? ,args
+ (,(C 'with-self) ,c? ,aa
,(with-fluids ((return r))
(exp ns code))))))))))
`(set! ,f
(,(C 'def-decor) ,decor
- (,(D 'lam) (,@arg_ ,@*f ,@arg= ,@**f)
+ (,(D 'lam) ,aa
(,(C 'with-return) ,r
,(mk `(let ,(map (lambda (x) (list x #f)) ls)
- (,(C 'with-self) ,c? ,args
+ (,(C 'with-self) ,c? ,aa
,(with-fluids ((return r))
(exp ns code))))))))))
@@ -1194,19 +1218,19 @@
`(set! ,f
(,(C 'def-decor) ,decor
(,(C 'def-wrap) ,y? ,f ,ab
- (,(D 'lam) (,@arg_ ,@*f ,@arg= ,@**f)
+ (,(D 'lam) ,aa
(,(C 'with-return) ,r
(let ,(map (lambda (x) (list x #f)) ls)
- (,(C 'with-self) ,c? ,args
+ (,(C 'with-self) ,c? ,aa
,(with-fluids ((return r))
(mk
(exp ns code))))))))))
`(set! ,f
(,(C 'def-decor) ,decor
- (,(D 'lam) (,@arg_ ,@*f ,@arg= ,@**f)
+ (,(D 'lam) ,aa
(,(C 'with-return) ,r
(let ,(map (lambda (x) (list x #f)) ls)
- (,(C 'with-self) ,c? ,args
+ (,(C 'with-self) ,c? ,aa
,(with-fluids ((return r))
(exp ns code))))))))))))))
@@ -1274,10 +1298,10 @@
(car l)
`(,(G 'values) ,@l))))
- ((_ l (#:assign x y . u))
+ ((_ a (#:assign b c . u))
(let ((z (gensym "x")))
- `(let ((,x ,(exp vs `(#:expr-stmt1 ((#:verb ,z)) (#:assign ,y . ,u)))))
- ,(exp vs `(#:expr-stmt ,x (#:assign ((#:verb ,z))))))))
+ `(let ((,z ,(exp vs `(#:expr-stmt1 ,b (#:assign ,c . ,u)))))
+ ,(exp vs `(#:expr-stmt ,a (#:assign ((#:verb ,z))))))))
((_ l type)
(=> fail)
@@ -1340,11 +1364,11 @@
(#:expr-stmt1
- ((_ l (#:assign x y . u))
+ ((_ a (#:assign b c . u))
(let ((z (gensym "x")))
- `(let ((,x ,(exp vs `(#:expr-stmt1 ((#:verb ,z))
- (#:assign ,y . ,u)))))
- ,(exp vs `(#:expr-stmt ,x (#:assign ((#:verb ,z))))))))
+ `(let ((,z ,(exp vs `(#:expr-stmt1 ,b
+ (#:assign ,c . ,u)))))
+ ,(exp vs `(#:expr-stmt1 ,a (#:assign ((#:verb ,z))))))))
((_ l type)
(=> fail)
@@ -1706,7 +1730,8 @@
(if (pair? a)
(let lp ((l a))
(if (pair? l)
- (let ((x (car l)))
+ (begin
+ (set! x (car l))
(with-sp ((continue (lp (cdr l)))
(break (values)))
code
@@ -1720,10 +1745,10 @@
(if (pair? l)
(begin
(let/ec continue-ret
- (let ((x (car l)))
- (with-sp ((continue (continue-ret))
- (break (break-ret)))
- code)))
+ (set! x (car l))
+ (with-sp ((continue (continue-ret))
+ (break (break-ret)))
+ code))
(lp (cdr l))))))
(for/adv1 (x) (a) code #f #t)))
@@ -1731,12 +1756,13 @@
(if (pair? a)
(let/ec break-ret
(let ((x (let lp ((l a) (old #f))
- (if (pair? l)
- (let ((x (car l)))
+ (if (pair? l)
+ (begin
+ (set! x (car l))
(let/ec continue-ret
(with-sp ((continue (continue-ret))
(break (break-ret)))
- code))
+ code))
(lp (cdr l)))
old))))
next))
@@ -1749,13 +1775,15 @@
(lambda (x)
(syntax-case x ()
((_ (x ...) (in) code #f #f)
- (with-syntax ((inv (gentemp #'in)))
+ (with-syntax ((inv (gentemp #'in))
+ ((xx ...) (generate-temporaries #'(x ...))))
#'(let ((inv (wrap-in in)))
(catch StopIteration
(lambda ()
(let lp ()
(call-with-values (lambda () (next inv))
- (lambda (x ...)
+ (lambda (xx ...)
+ (set! x xx) ...
(with-sp ((break (values))
(continue (values)))
code
@@ -1763,28 +1791,32 @@
(lambda z (values))))))
((_ (x ...) (in ...) code #f #f)
- (with-syntax (((inv ...) (generate-temporaries #'(in ...))))
+ (with-syntax (((inv ...) (generate-temporaries #'(in ...)))
+ ((xx ...) (generate-temporaries #'(x ...))))
#'(let ((inv (wrap-in in)) ...)
(catch StopIteration
(lambda ()
(let lp ()
(call-with-values (lambda () (values (next inv) ...))
- (lambda (x ...)
+ (lambda (xx ...)
+ (set! x xx) ...
(with-sp ((break (values))
(continue (values)))
- code
- (lp))))))
+ code
+ (lp))))))
(lambda z (values))))))
((_ (x ...) (in) code #f #t)
- (with-syntax ((inv (gentemp #'in)))
+ (with-syntax ((inv (gentemp #'in))
+ ((xx ...) (generate-temporaries #'(x ...))))
#'(let ((inv (wrap-in in)))
(let lp ()
(let/ec break-ret
(catch StopIteration
(lambda ()
(call-with-values (lambda () (next inv))
- (lambda (x ...)
+ (lambda (xx ...)
+ (set! x xx) ...
(let/ec continue-ret
(with-sp ((break (break-ret))
(continue (continue-ret)))
@@ -1793,14 +1825,16 @@
(lambda z (values))))))))
((_ (x ...) (in ...) code #f #t)
- (with-syntax (((inv ...) (generate-temporaries #'(in ...))))
+ (with-syntax (((inv ...) (generate-temporaries #'(in ...)))
+ ((xx ...) (generate-temporaries #'(x ...))))
#'(let ((inv (wrap-in in)) ...)
(let lp ()
(let/ec break-ret
(catch StopIteration
(lambda ()
(call-with-values (lambda () (values (next inv) ...))
- (lambda (x ...)
+ (lambda (xx ...)
+ (set! x xx) ...
(let/ec continue-ret
(with-sp ((break (break-ret))
(continue (continue-ret)))
@@ -1831,71 +1865,67 @@
(if (syntax->datum #'p)
#'(let ((inv (wrap-in in)))
(let/ec break-ret
- (let ((x #f) ...)
- (catch StopIteration
- (lambda ()
- (let lp ()
- (call-with-values (lambda () (next inv))
- (lambda (xx ...)
- (set! x xx) ...
- (let/ec continue-ret
- (with-sp ((break (break-ret))
- (continue (continue-ret)))
- code))
- (lp)))))
- (lambda q else)))))
-
- #'(let ((inv (wrap-in in)))
- (let ((x #f) ...)
- (let/ec break-ret
- (catch StopIteration
- (lambda ()
- (let lp ()
- (call-with-values (lambda () (next inv))
- (lambda (xx ...)
- (set! x xx) ...
- (with-sp ((break (break-ret))
- (continue (values)))
- code)
- (lp)))))
- (lambda e else)))))))))
-
- ((_ (x ...) (in ...) code else p)
- (with-syntax (((inv ...) (generate-temporaries #'(in ...))))
- (with-syntax ((get (gen #'(inv ...) #'(x ...)))
- ((xx ...) (generate-temporaries #'(x ...))))
- (if (syntax->datum #'p)
- #'(let ((inv (wrap-in in)) ...)
- (let/ec break-ret
- (let ((x #f) ...)
(catch StopIteration
(lambda ()
(let lp ()
- (call-with-values (lambda () get)
+ (call-with-values (lambda () (next inv))
(lambda (xx ...)
(set! x xx) ...
(let/ec continue-ret
(with-sp ((break (break-ret))
(continue (continue-ret)))
- code))
+ code))
(lp)))))
- (lambda q else)))))
+ (lambda q else))))
- #'(let ((inv (wrap-in in)) ...)
- (let ((x #f) ...)
+ #'(let ((inv (wrap-in in)))
(let/ec break-ret
(catch StopIteration
(lambda ()
(let lp ()
- (call-with-values (lambda () get)
+ (call-with-values (lambda () (next inv))
(lambda (xx ...)
(set! x xx) ...
(with-sp ((break (break-ret))
(continue (values)))
code)
(lp)))))
- (lambda e else))))))))))))
-
+ (lambda e else))))))))
+
+ ((_ (x ...) (in ...) code else p)
+ (with-syntax (((inv ...) (generate-temporaries #'(in ...))))
+ (with-syntax ((get (gen #'(inv ...) #'(x ...)))
+ ((xx ...) (generate-temporaries #'(x ...))))
+ (if (syntax->datum #'p)
+ #'(let ((inv (wrap-in in)) ...)
+ (let/ec break-ret
+ (catch StopIteration
+ (lambda ()
+ (let lp ()
+ (call-with-values (lambda () get)
+ (lambda (xx ...)
+ (set! x xx) ...
+ (let/ec continue-ret
+ (with-sp ((break (break-ret))
+ (continue (continue-ret)))
+ code))
+ (lp)))))
+ (lambda q else))))
+
+ #'(let ((inv (wrap-in in)) ...)
+ (let/ec break-ret
+ (catch StopIteration
+ (lambda ()
+ (let lp ()
+ (call-with-values (lambda () get)
+ (lambda (xx ...)
+ (set! x xx) ...
+ (with-sp ((break (break-ret))
+ (continue (values)))
+ code)
+ (lp)))))
+ (lambda e else)))))))))))
+
(define-syntax def-wrap
(lambda (x)
(syntax-case x ()
@@ -1941,13 +1971,15 @@
(define-syntax ref-x
(lambda (x)
- (syntax-case x ()
+ (syntax-case x (quote __dict__)
((_ v)
#'v)
((_ v (#:fastfkn-ref f _) . l)
#'(ref-x (lambda x (if (pyclass? v) (apply f x) (apply f v x))) . l))
((_ v (#:fast-id f _) . l)
#'(ref-x (f v) . l))
+ ((_ v (#:identifier '__dict__) . l)
+ #'(ref-x (py-dict v) . l))
((_ v (#:identifier x) . l)
#'(ref-x (wr x (ref v x miss)) . l))
((_ v (#:call-obj x) . l)
diff --git a/modules/language/python/def.scm b/modules/language/python/def.scm
index 5c83b6f..fa4cbc5 100644
--- a/modules/language/python/def.scm
+++ b/modules/language/python/def.scm
@@ -82,7 +82,12 @@
(ww- (fold get-ww '() #'(arg ...)))
(kv (fold get-kv '() #'(arg ...))))
(if (and-map null? (list kw ww- kv))
- #`(object-method (lambda #,as code ...))
+ #`(object-method
+ (lambda (#,@as . u12345678)
+ (if (and (pair? u12345678)
+ (not (keyword? (car u12345678))))
+ (raise (ArgumentError "too many arguments to function")))
+ code ...))
(with-syntax ((kw (if (null? kw)
(datum->syntax x (gensym "kw"))
(car kw)))
diff --git a/modules/language/python/dict.scm b/modules/language/python/dict.scm
index 260aa0d..977d5e1 100644
--- a/modules/language/python/dict.scm
+++ b/modules/language/python/dict.scm
@@ -44,13 +44,13 @@
(define H (hash 1333674836 complexity))
-(define-class <py-hashtable> () t h n)
+(define-class <py-hashtable> () t hash n)
(name-object <py-hashtable>)
(cpit <py-hashtable>
(o (lambda (o h n a)
- (slot-set! o 'h h)
+ (slot-set! o 'hash h)
(slot-set! o 'n n)
(slot-set! o 't
(let ((t (make-hash-table)))
@@ -62,7 +62,7 @@
t)))
(let ((t (slot-ref o 't)))
(list
- (slot-ref o 'h)
+ (slot-ref o 'hash)
(slot-ref o 'n)
(hash-fold (lambda (k v s) (cons (cons k v) s)) '() t)))))
@@ -71,7 +71,7 @@
(t (make-hash-table))
(h H))
(slot-set! o 't t)
- (slot-set! o 'h h)
+ (slot-set! o 'hash h)
(slot-set! o 'n 0)
o))
@@ -80,7 +80,7 @@
(t (make-weak-key-hash-table))
(h H))
(slot-set! o 't t)
- (slot-set! o 'h h)
+ (slot-set! o 'hash h)
(slot-set! o 'n 0)
o))
@@ -89,7 +89,7 @@
(t (make-weak-value-hash-table))
(h H))
(slot-set! o 't t)
- (slot-set! o 'h h)
+ (slot-set! o 'hash h)
(slot-set! o 'n 0)
o))
@@ -152,14 +152,14 @@
(define-method (pyhash-rem! (o <py-hashtable>) k)
(let ((t (slot-ref o 't))
(n (slot-ref o 'n))
- (h (slot-ref o 'h)))
+ (h (slot-ref o 'hash)))
(let ((ret (py-hash-ref t k miss)))
(if (eq? ret miss)
(values)
(begin
(py-hash-remove! t k)
- (slot-set! o 'n (- n 1))
- (slot-set! o 'h (logxor h (xy (py-hash k) (py-hash ret))))
+ (slot-set! o 'n (- n 1))
+ (slot-set! o 'hash (logxor h (xy (py-hash k) (py-hash ret))))
(values))))))
(define-method (pylist-pop! (o <py-hashtable>) k . l)
@@ -187,16 +187,16 @@
(define-method (pylist-set! (o <py-hashtable>) key val)
(let ((t (slot-ref o 't))
(n (slot-ref o 'n))
- (h (slot-ref o 'h)))
+ (h (slot-ref o 'hash)))
(let ((ret (py-hash-ref t key miss)))
(if (eq? ret miss)
(begin
(py-hash-set! t key val)
(slot-set! o 'n (+ n 1))
- (slot-set! o 'h (logxor (xy (py-hash key) (py-hash val)) h)))
+ (slot-set! o 'hash (logxor (xy (py-hash key) (py-hash val)) h)))
(begin
(py-hash-set! t key val)
- (slot-set! o 'h
+ (slot-set! o 'hash
(logxor (xy (py-hash key) (py-hash val))
(logxor
(xy (py-hash key) (py-hash ret))
@@ -242,7 +242,7 @@
(<py-hashtable>
(let ((r (make <py-hashtable>)))
- (slot-set! r 'h (slot-ref o 'h))
+ (slot-set! r 'hash (slot-ref o 'hash))
(slot-set! r 'n (slot-ref o 'n))
(slot-set! r 't (py-copy (slot-ref o 't)))
r)))
@@ -275,7 +275,7 @@
(let ((elseval (match l
(() None)
((v) v))))
- (let ((ret (py-hash-ref o k miss)))
+ (let ((ret (ref o k miss)))
(if (eq? ret miss)
elseval
ret))))
@@ -284,7 +284,7 @@
(let ((elseval (match l
(() None)
((v) v))))
- (let ((ret (py-hash-ref (slot-ref o 't) k miss)))
+ (let ((ret (ref (slot-ref o 't) k miss)))
(if (eq? ret miss)
elseval
ret)))))
@@ -453,7 +453,7 @@
(let ((t (slot-ref o 't)))
(hash-clear! t)
(slot-set! o 'n 0)
- (slot-set! o 'h H)
+ (slot-set! o 'hash H)
(values))))
#|
@@ -492,9 +492,9 @@
(define-method (py-equal? (o1 <py-hashtable>) (o2 <py-hashtable>))
(and
- (equal? (slot-ref o1 'n) (slot-ref o2 'n))
- (equal? (slot-ref o1 'h) (slot-ref o2 'h))
- (e? (slot-ref o1 't) (slot-ref o2 't))))
+ (equal? (slot-ref o1 'n) (slot-ref o2 'n))
+ (equal? (slot-ref o1 'hash) (slot-ref o2 'hash))
+ (e? (slot-ref o1 't) (slot-ref o2 't))))
(define (e? t1 t2)
(let/ec ret
@@ -548,12 +548,12 @@
(letrec ((__init__
(case-lambda
((self)
- (let ((r (make-py-hashtable)))
- (slot-set! self 't (slot-ref r 't))
- (slot-set! self 'h (slot-ref r 'h))
- (slot-set! self 'n (slot-ref r 'n))))
+ (let ((r (make-hash-table)))
+ (slot-set! self 't r)
+ (slot-set! self 'hash H)
+ (slot-set! self 'n 0)))
((self x)
- (__init__ self)
+ (__init__ self)
(catch #t
(lambda ()
(for ((k v : x)) ()
@@ -572,10 +572,11 @@
(letrec ((__init__
(case-lambda
((self)
- (let ((r (make-py-weak-key-hashtable)))
- (slot-set! self 't (slot-ref r 't))
- (slot-set! self 'h (slot-ref r 'h))
- (slot-set! self 'n (slot-ref r 'n))))
+ (let ((r (make-hash-table)))
+ (slot-set! self 't r)
+ (slot-set! self 'hash H)
+ (slot-set! self 'n 0)))
+
((self x)
(__init__ self)
(if (is-a? x <py-hashtable>)
@@ -590,10 +591,11 @@
(letrec ((__init__
(case-lambda
((self)
- (let ((r (make-py-weak-value-hashtable)))
- (slot-set! self 't (slot-ref r 't))
- (slot-set! self 'h (slot-ref r 'h))
- (slot-set! self 'n (slot-ref r 'n))))
+ (let ((r (make-hash-table)))
+ (slot-set! self 't r)
+ (slot-set! self 'hash H)
+ (slot-set! self 'n 0)))
+
((self x)
(__init__ self)
(if (is-a? x <py-hashtable>)
diff --git a/modules/language/python/exceptions.scm b/modules/language/python/exceptions.scm
index 93ce54d..9d51116 100644
--- a/modules/language/python/exceptions.scm
+++ b/modules/language/python/exceptions.scm
@@ -3,7 +3,7 @@
#:use-module (oop goops)
#:export (StopIteration GeneratorExit RuntimeError
Exception ValueError TypeError
- IndexError KeyError AttributeError
+ IndexError KeyError AttributeError ArgumentError
SyntaxError SystemException
OSError ProcessLookupError PermissionError
None NotImplemented NotImplementedError
@@ -40,6 +40,7 @@
(define-er SystemException 'SystemException)
(define-er RuntimeError 'RuntimeError)
(define-er IndexError 'IndexError)
+(define-er ArgumentError 'IndexError)
(define-er ValueError 'ValueError)
(define None 'None)
(define-er KeyError 'KeyError)
diff --git a/modules/language/python/module/enum.py b/modules/language/python/module/enum.py
index 89047cd..1549862 100644
--- a/modules/language/python/module/enum.py
+++ b/modules/language/python/module/enum.py
@@ -11,7 +11,6 @@ try:
except ImportError:
from collections import OrderedDict
-
__all__ = [
'EnumMeta',
'Enum', 'IntEnum', 'Flag', 'IntFlag',
@@ -50,6 +49,8 @@ def _make_class_unpicklable(cls):
cls.__module__ = '<unknown>'
_auto_null = object()
+
+
class auto:
"""
Instances are replaced with an appropriate value in Enum class suites.
@@ -117,10 +118,14 @@ class EnumMeta(type):
def __prepare__(metacls, cls, bases):
# create the namespace dict
enum_dict = _EnumDict()
+ pk('got dict')
+
# inherit previous flags and _generate_next_value_ function
member_type, first_enum = metacls._get_mixins_(bases)
+
if first_enum is not None:
enum_dict['_generate_next_value_'] = getattr(first_enum, '_generate_next_value_', None)
+
return enum_dict
def __new__(metacls, cls, bases, classdict):
@@ -128,42 +133,45 @@ 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).
+ pk('new enum meta')
member_type, first_enum = metacls._get_mixins_(bases)
__new__, save_new, use_args = metacls._find_new_(classdict, member_type,
first_enum)
-
+ pk(1)
# 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]
-
+ pk(2)
# adjust the sunders
_order_ = classdict.pop('_order_', None)
-
+ pk(3)
# check for illegal enum names (any others?)
invalid_names = set(enum_members) & {'mro', }
if invalid_names:
raise ValueError('Invalid enum member name: {0}'.format(
','.join(invalid_names)))
-
+ pk(4)
# create a default docstring if one has not been provided
if '__doc__' not in classdict:
classdict['__doc__'] = 'An enumeration.'
-
+ pk(5)
# create our new Enum type
enum_class = super().__new__(metacls, cls, bases, classdict)
+
enum_class._member_names_ = [] # names in definition order
enum_class._member_map_ = OrderedDict() # name->value map
enum_class._member_type_ = member_type
-
+ pk(6)
# 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.
enum_class._value2member_map_ = {}
-
+ pk(7)
# If a custom type is mixed into the Enum, and it does not know how
# to pickle itself, pickle.dumps will succeed but pickle.loads will
# fail. Rather than have the error show up later and possibly far
@@ -180,7 +188,7 @@ class EnumMeta(type):
'__reduce_ex__', '__reduce__')
if not any(m in member_type.__dict__ for m in methods):
_make_class_unpicklable(enum_class)
-
+ pk(8)
# instantiate them, checking for duplicates as we go
# we instantiate first instead of checking for duplicates first in case
# a custom __new__ is doing something funky with the values -- such as
@@ -230,7 +238,7 @@ class EnumMeta(type):
enum_class._value2member_map_[value] = enum_member
except TypeError:
pass
-
+ pk(9)
# double check that repr and friends are not the mixin's or various
# things break (such as pickle)
for name in ('__repr__', '__str__', '__format__', '__reduce_ex__'):
@@ -239,7 +247,7 @@ class EnumMeta(type):
enum_method = getattr(first_enum, name, None)
if obj_method is not None and obj_method is class_method:
setattr(enum_class, name, enum_method)
-
+ pk(10)
# replace any other __new__ with our own (as long as Enum is not None,
# anyway) -- again, this is to support pickle
if Enum is not None:
@@ -248,14 +256,14 @@ class EnumMeta(type):
if save_new:
enum_class.__new_member__ = __new__
enum_class.__new__ = Enum.__new__
-
+ pk(11)
# py3 support for definition order (helps keep py2/py3 code in sync)
if _order_ is not None:
if isinstance(_order_, str):
_order_ = _order_.replace(',', ' ').split()
if _order_ != enum_class._member_names_:
raise TypeError('member order does not match _order_')
-
+ pk(12)
return enum_class
def __bool__(self):
@@ -424,9 +432,10 @@ class EnumMeta(type):
bases: the tuple of bases that was given to __new__
"""
+ pk('bases',bases)
if not bases:
return object, Enum
-
+ pk(2)
# double check that we are not subclassing a class with existing
# enumeration members; while we're at it, see if any other data
# type has been mixed in so we can use the correct __new__
@@ -436,6 +445,9 @@ class EnumMeta(type):
issubclass(base, Enum) and
base._member_names_):
raise TypeError("Cannot extend enumerations")
+ pk(3)
+ pk(base)
+ pk(bases)
# base is now the last base in bases
if not issubclass(base, Enum):
raise TypeError("new enumerations must be created as "
@@ -473,11 +485,12 @@ class EnumMeta(type):
# now find the correct __new__, checking to see of one was defined
# by the user; also check earlier enum classes in case a __new__ was
# saved as __new_member__
+ pk(0)
__new__ = classdict.get('__new__', None)
-
+ pk(1)
# should __new__ be saved as __new_member__ later?
save_new = __new__ is not None
-
+ pk(2)
if __new__ is None:
# check all possibles for __new_member__ before falling back to
# __new__
@@ -496,7 +509,7 @@ class EnumMeta(type):
break
else:
__new__ = object.__new__
-
+ pk(3)
# if a non-object.__new__ is used then whatever value/tuple was
# assigned to the enum member name will be passed to __new__ and to the
# new enum member's __init__
@@ -504,7 +517,7 @@ class EnumMeta(type):
use_args = False
else:
use_args = True
-
+ pk(4)
return __new__, save_new, use_args
class Enum(metaclass=EnumMeta):
@@ -636,6 +649,7 @@ class Enum(metaclass=EnumMeta):
module_globals[name] = cls
return cls
+pk(6)
class IntEnum(int, Enum):
"""Enum where members are also (and must be) ints"""
diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm
index 3398dbb..ef42cc6 100644
--- a/modules/language/python/module/python.scm
+++ b/modules/language/python/module/python.scm
@@ -29,7 +29,7 @@
#:use-module (language python eval )
#:use-module (language python bool )
- #:replace (list abs min max hash round format)
+ #:replace (list abs min max hash round format map)
#:re-export (StopIteration GeneratorExit RuntimeError
Exception ValueError TypeError
@@ -47,7 +47,7 @@
chr classmethod staticmethod objectmethod
divmod enumerate filter
getattr hasattr setattr hex isinstance issubclass
- iter map sum id input oct ord pow super
+ iter sum id input oct ord pow super
sorted zip
ClassMethod StaticMethod Funcobj))
diff --git a/modules/language/python/number.scm b/modules/language/python/number.scm
index 6d93435..845a155 100644
--- a/modules/language/python/number.scm
+++ b/modules/language/python/number.scm
@@ -74,7 +74,7 @@
(define-syntax-rule (mk-biop1 mk-biop0 op r1)
(begin
(mk-biop0 op)
- (define-method (op v (o <p>))
+ (define-method (op (o <p>) v)
(aif it (ref o 'r1)
(it v)
(next-method)))))
@@ -95,6 +95,7 @@
(define-method (op o2 (o1 <py-int>))
(op o2 (slot-ref o1 'x)))))
+
(mk-biop2 b0 r+ + __add__ __radd__)
(mk-biop2 b0 r- - __sub__ __rsub__)
(mk-biop2 b0 r* * __mul__ __rmul__)
@@ -106,6 +107,7 @@
(mk-biop2 b0 rexpt expt __pow__ __rpow__)
(b0 py-equal?)
+
(define-method (py-lshift (o1 <integer>) (o2 <integer>))
(ash o1 o2))
(define-method (py-rshift (o1 <integer>) (o2 <integer>))
@@ -123,6 +125,62 @@
(define-method (py-lognot (o1 <integer>))
(lognot o1))
+(define-method (py-logand o1 (o2 <py-int>))
+ (py-logand o1 (slot-ref o2 'x)))
+
+(define-method (py-logand (o1 <py-int>) o2)
+ (py-logand (slot-ref o1 'x) o2))
+
+(define-method (py-logior o1 (o2 <py-int>))
+ (py-logior o1 (slot-ref o2 'x)))
+
+(define-method (py-logior (o1 <py-int>) o2)
+ (py-logior (slot-ref o1 'x) o2))
+
+(define-method (py-logxor o1 (o2 <py-int>))
+ (py-logxor o1 (slot-ref o2 'x)))
+
+(define-method (py-logxor (o1 <py-int>) o2)
+ (py-logxor (slot-ref o1 'x) o2))
+
+(define-method (py-lognot (o1 <py-int>))
+ (lognot (slot-ref o1 'x)))
+
+(define-method (py-logand (o1 <p>) o2)
+ (aif it (ref o1 '__and__)
+ (it o2)
+ (next-method)))
+
+(define-method (py-logand o1 (o2 <p>))
+ (aif it (ref o1 '__rand__)
+ (it o2)
+ (next-method)))
+
+(define-method (py-logior (o1 <p>) o2)
+ (aif it (ref o1 '__or__)
+ (it o2)
+ (next-method)))
+
+(define-method (py-logior o1 (o2 <p>))
+ (aif it (ref o1 '__ror__)
+ (it o2)
+ (next-method)))
+
+(define-method (py-logxor (o1 <p>) o2)
+ (aif it (ref o1 '__xor__)
+ (it o2)
+ (next-method)))
+
+(define-method (py-logxor o1 (o2 <p>))
+ (aif it (ref o1 '__rxor__)
+ (it o2)
+ (next-method)))
+
+(define-method (py-lognot (o1 <p>))
+ (aif it (ref o1 '__not__)
+ (it)
+ (next-method)))
+
(define-method (py-/ (o1 <number>) (o2 <integer>))
(/ o1 (exact->inexact o2)))
diff --git a/modules/language/python/set.scm b/modules/language/python/set.scm
index 5582d36..2f3b7cc 100644
--- a/modules/language/python/set.scm
+++ b/modules/language/python/set.scm
@@ -224,6 +224,22 @@
(t (slot-ref d 't)))
(not (eq? miss (py-hash-ref t x miss))))))
+ (define __and__
+ (lambda (self op)
+ (intersection self op)))
+
+ (define __or__
+ (lambda (self op)
+ (union self op)))
+
+ (define __sub__
+ (lambda (self op)
+ (difference self op)))
+
+ (define __xor__
+ (lambda (self op)
+ (symmetric_difference self op)))
+
(define __eq__
(lambda (self x)
(and
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index d42865f..64ad776 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -17,7 +17,7 @@
py-super-mac py-super py-equal?
*class* *self* pyobject? pytype?
type object pylist-set! pylist-ref tr
- resolve-method-g rawref rawset
+ resolve-method-g rawref rawset py-dict
))
#|
@@ -34,6 +34,26 @@ The datastructure is functional but the objects mutate. So one need to
explicitly tell it to not update etc.
|#
+(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
+
+(define (pk-obj o)
+ (pk 'start-pk-obj)
+ (let ((h (slot-ref o 'h)))
+ (hash-for-each (lambda (k v) (pk k)) h)
+ (pk 'finished-obj)
+ (aif cl (hash-ref h '__class__)
+ (if (is-a? cl <p>)
+ (if (hash-table? (slot-ref cl 'h))
+ (hash-for-each (lambda (k v)
+ (if (member k '(__name__ __qualname__))
+ (pk k v)
+ (pk k)))
+ (slot-ref cl 'h))
+ (pk 'no-hash-table))
+ (pk 'no-class))
+ (pk 'false-class)))
+ (pk 'end-pk-obj))
+
(define fail (cons 'fail '()))
(define-syntax-rule (kif it p x y)
@@ -52,7 +72,6 @@ explicitly tell it to not update etc.
(define (is-acl? a b) (member a (cons b (class-subclasses b))))
-(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
(define-class <p> (<applicable-struct> <object>) h)
(define-class <pf> (<p>) size n) ; the pf object consist of a functional
; hashmap it's size and number of live
@@ -88,6 +107,27 @@ explicitly tell it to not update etc.
(define-method (rawset (o <procedure>) key val)
(set-procedure-property! o key val))
+(define-method (find-in-class (klass <pf>) key fail)
+ (let ((r (vhash-assoc key (slot-ref klass 'h))))
+ (if r
+ (cdr r)
+ fail)))
+
+(define-syntax-rule (find-in-class-and-parents klass key fail-)
+ (aif parents (find-in-class klass '__mro__ #f)
+ (let lp ((parents parents))
+ (if (pair? parents)
+ (kif r (find-in-class (car parents) key fail)
+ r
+ (lp (cdr parents)))
+ fail-))
+ (kif r (find-in-class klass key fail)
+ r
+ fail-)))
+
+(define-inlinable
+ (ficap klass key fail) (find-in-class-and-parents klass key fail))
+
(define (mk-getter-object f)
(lambda (obj cls)
(if (pytype? obj)
@@ -95,10 +135,10 @@ explicitly tell it to not update etc.
(if (pyclass? obj)
(if (pytype? cls)
(lambda x (apply f obj x))
- (lambda x (apply f x)))
+ f)
(if (pyclass? cls)
(lambda x (apply f obj x))
- (lambda x (apply f x)))))))
+ f)))))
(define (mk-getter-class f)
(lambda (obj cls)
@@ -158,20 +198,17 @@ explicitly tell it to not update etc.
(define (resolve-method-o o pattern)
(resolve-method-g (class-of o) pattern))
-(define (get-dict self name parents)
- (aif it (ref self '__prepare__)
- (it self name parents)
- (make-hash-table)))
-
(define (hashforeach a b) (values))
(define (new-class0 meta name parents dict . kw)
(let* ((goops (pylist-ref dict '__goops__))
- (p (kwclass->class kw meta))
+ (p (kwclass->class kw meta))
(class (make-p p)))
+ (pk 'new-class0)
(slot-set! class 'procedure
(lambda x
(create-object class meta goops x)))
+
(if (hash-table? dict)
(hash-for-each
(lambda (k v) k (set class k v))
@@ -194,7 +231,7 @@ explicitly tell it to not update etc.
class))
(define (new-class meta name parents dict kw)
- (aif it (ref meta '__new__)
+ (aif it (and meta (ficap meta '__new__ #f))
(apply it meta name parents dict kw)
(apply new-class0 meta name parents dict kw)))
@@ -205,31 +242,55 @@ explicitly tell it to not update etc.
#f)
class))
-(define (create-class meta name parents gen-methods . keys)
- (let ((dict (gen-methods (get-dict meta name keys))))
+
+(define (the-create-object class x)
+ (let* ((meta (ref class '__class__))
+ (goops (ref class '__goops__))
+ (obj (aif it (ficap class '__new__ #f)
+ (it)
+ (make-object class meta goops))))
+ (aif it (ref obj '__init__)
+ (apply it x)
+ #f)
+
+ (slot-set! obj 'procedure
+ (lambda x
+ (aif it (ref obj '__call__)
+ (apply it x)
+ (error "not a callable object"))))
+
+ obj))
+
+(define (create-object class meta goops x)
+ (with-fluids ((*make-class* #t))
+ (aif it (ficap meta '__call__ #f)
+ (apply it class x)
+ (the-create-object class x))))
+
+(define type-call
+ (lambda (class . l)
+ (if (pytype? class)
+ (apply (case-lambda
+ ((meta obj)
+ (ref obj '__class__ 'None))
+ ((meta name bases dict . keys)
+ (type- meta name bases dict keys)))
+ class l)
+ (the-create-object class l))))
+
+(define (get-dict self name parents)
+ (aif it (and self (ficap self '__prepare__ #f))
+ (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 (ref meta '__class__)
- (aif it (find-in-class (ref meta '__class__) '__call__ #f)
+ (aif it (find-in-class it '__call__ #f)
(apply it meta name parents dict keys)
(type- meta name parents dict keys))
(type- meta name parents dict keys))))
-(define (create-object class meta goops x)
- (with-fluids ((*make-class* #t))
- (aif it #f
- (apply it x)
- (let ((obj (aif it (find-in-class class '__new__ #f)
- (it)
- (make-object class meta goops))))
- (aif it (ref obj '__init__)
- (apply it x)
- #f)
- (slot-set! obj 'procedure
- (lambda x
- (aif it (ref obj '__call__)
- (apply it x)
- (error "not a callable object"))))
- obj))))
-
(define (make-object class meta goops)
(let ((obj (make-p goops)))
(set obj '__class__ class)
@@ -272,6 +333,11 @@ explicitly tell it to not update etc.
(f obj class)
it)))
+(define-inlinable (gokx obj class it)
+ (aif f (rawref it '__get__)
+ (f obj class)
+ it))
+
(define *location* (make-fluid #f))
(define-syntax-rule (mrefx x key l)
(let ()
@@ -304,30 +370,12 @@ explicitly tell it to not update etc.
(define-method (find-in-class (klass <p>) key fail)
(hash-ref (slot-ref klass 'h) key fail))
-
-(define-method (find-in-class (klass <pf>) key fail)
- (let ((r (vhash-assoc key (slot-ref klass 'h))))
- (if r
- (cdr r)
- fail)))
-
-(define-syntax-rule (find-in-class-and-parents klass key fail)
- (kif r (find-in-class klass key fail)
- r
- (aif parents (find-in-class klass '__mro__ #f)
- (let lp ((parents (cdr parents)))
- (if (pair? parents)
- (kif r (find-in-class (car parents) key fail)
- r
- (lp (cdr parents)))
- fail))
- fail)))
-
+
(define-syntax-rule (mrefx klass key l)
(let ()
(define (end) (if (pair? l) (car l) #f))
(fluid-set! *location* klass)
- (kif it (find-in-class klass key fail)
+ (kif it (find-in-class-and-parents klass key fail)
it
(aif klass (find-in-class klass '__class__ #f)
(begin
@@ -341,26 +389,17 @@ explicitly tell it to not update etc.
(define-syntax-rule (mrefx-py x key l)
(let ((xx x))
- (let* ((g (mrefx xx '__fget__ '(#t)))
- (f (if g
- (if (eq? g #t)
- (aif it (mrefx xx '__getattribute__ '())
- (let ((f (gox xx it)))
- (rawset xx '__fget__ it)
- f)
- (begin
- (if (mc?)
- (rawset xx '__fget__ #f))
- #f))
- g)
- #f)))
- (if (or (not f) (eq? f not-implemented))
- (gox xx (mrefx xx key l))
- (catch #t
- (lambda ()
- (f xx key))
- (lambda x
- (gox xx (mrefx xx key l))))))))
+ (let* ((f (aif it (or (mrefx xx '__getattribute__ '())
+ (mrefx xx '__getattr__ '()))
+ (gox xx it)
+ #f)))
+ (if (or (not f) (eq? f not-implemented))
+ (gox xx (mrefx xx key l))
+ (catch #t
+ (lambda ()
+ (f xx key))
+ (lambda x
+ (gox xx (mrefx xx key l))))))))
(define-syntax-rule (mref x key l)
@@ -372,7 +411,15 @@ explicitly tell it to not update etc.
(let ((res (mrefx-py xx key l)))
res)))
-(define-method (ref x key . l) (if (pair? l) (car l) #f))
+(define-method (ref x key . l)
+ (cond
+ ((eq? x 'None)
+ (apply ref NoneObj key l))
+ ((pair? l)
+ (car l))
+ (else
+ #f)))
+
(define-method (ref (x <pf> ) key . l) (mref x key l))
(define-method (ref (x <p> ) key . l) (mref x key l))
(define-method (ref (x <pyf>) key . l) (mref-py x key l))
@@ -712,28 +759,32 @@ explicitly tell it to not update etc.
((name supers.kw methods)
(make-p-class name "" supers.kw methods))
((name doc supers.kw methods)
- (define kw (cdr supers.kw))
- (define supers (car supers.kw))
+ (define s.kw supers.kw)
+ (define kw (cdr s.kw))
+ (define supers (car s.kw))
(define goopses (map (lambda (sups)
(aif it (ref sups '__goops__ #f)
it
sups))
supers))
+
(define parents (let ((p (filter-parents supers)))
- (if (null? p)
- (if object
- (list object)
- '())
- p)))
+ p))
+
+ (define cparents (if (null? parents)
+ (if object
+ (list object)
+ '())
+ parents))
(define meta (aif it (memq #:metaclass kw)
(cadr it)
- (if (null? parents)
+ (if (null? cparents)
type
- (let* ((p (car parents))
+ (let* ((p (car cparents))
(m (ref p '__class__))
(mro (reverse (ref m '__mro__ '()))))
- (let lp ((l (cdr parents))
+ (let lp ((l (cdr cparents))
(max mro)
(min mro))
(if (pair? l)
@@ -753,7 +804,8 @@ explicitly tell it to not update etc.
(lp (cdr l) mro min)))))
(car (reverse min))))))))
- (define goops (make-class (append goopses (list (kw->class kw meta)))
+ (define goops (make-class (append goopses
+ (list (kw->class kw meta)))
'() #:name name))
(define (make-module)
@@ -766,33 +818,42 @@ explicitly tell it to not update etc.
(map symbol->string (cdddr l))
".")
l)))
-
+
(define (gen-methods dict)
+ (define (filt-bases x)
+ (let lp ((x x))
+ (if (pair? x)
+ (let ((y (car x)))
+ (if (is-a? y <p>)
+ (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__ parents)
+ (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 parents))
+ (pylist-set! dict '__mro__ (get-mro cparents))
(pylist-set! dict '__doc__ doc)
dict)
(let ((cl (with-fluids ((*make-class* #t))
- (create-class meta name parents gen-methods kw))))
+ (create-class meta name parents gen-methods kw))))
(aif it (ref meta '__init_subclass__)
- (let lp ((ps parents))
+ (let lp ((ps cparents))
(if (pair? ps)
(let ((super (car ps)))
(it cl super)
(lp (cdr ps)))))
#f)
-
+
cl))))
@@ -867,8 +928,8 @@ explicitly tell it to not update etc.
(lambda (x)
(syntax-case x ()
((_ name parents ((ddef dname dval) ...) body)
- #'(mk-p-class name parents "" (ddef dname dval) ...))
- ((_ name parents doc (ddef dname dval) ...)
+ #'(mk-p-class2 name parents "" ((ddef dname dval) ...) body))
+ ((_ name parents doc ((ddef dname dval) ...) body)
(with-syntax (((ddname ...)
(map (lambda (dn)
(datum->syntax
@@ -894,13 +955,13 @@ explicitly tell it to not update etc.
#'(let ()
(define name
(letruc ((dname (make-up dval)) ...)
- body
- (make-p-class 'name doc
- parents
- (lambda (dict)
- (pylist-set! dict 'dname dname)
- ...
- (values)))))
+ body
+ (make-p-class 'name doc
+ parents
+ (lambda (dict)
+ (pylist-set! dict 'dname dname)
+ ...
+ (values)))))
(begin
(module-define! (current-module) 'ddname (ref name 'dname))
@@ -1001,11 +1062,15 @@ explicitly tell it to not update etc.
code ...)))
cl)))))
-
+(define type-goops #f)
(define (kind x)
+ (if (not type-goops) (set! type-goops (ref type '__goops__)))
(and (is-a? x <p>)
(aif it (find-in-class x '__goops__ #f)
- (if (is-a? (make it) (ref type '__goops__))
+ (if (or
+ (not type-goops)
+ (eq? it type-goops)
+ (member it (class-subclasses type-goops)))
'type
'class)
'object)))
@@ -1028,25 +1093,23 @@ explicitly tell it to not update etc.
(define (not-a-super) 'not-a-super)
(define (py-super class obj)
(define (make cl parents)
- (if (or (pyclass? obj) (pytype? obj))
- cl
- (let ((c (make-p <p>))
- (o (make-p <p>)))
- (set c '__super__ #t)
- (set c '__mro__ parents)
- (set c '__getattribute__ (lambda (self key . l)
- (aif it (ref c key)
- (if (procedure? it)
- (if (eq? (procedure-property
- it
- 'py-special)
- 'class)
- (it cl)
- (it obj))
- it)
- (error "no attribute"))))
- (set o '__class__ c)
- o)))
+ (if (not cl)
+ #f
+ (if (or (pyclass? obj) (pytype? obj))
+ cl
+ (let ((c (make-p <py>))
+ (o (make-p <py>)))
+ (set c '__class__ type)
+ (set c '__mro__ (cons c parents))
+ (set c '__getattribute__ (lambda (self key . l)
+ (aif it (ficap c key #f)
+ (if (procedure? it)
+ (gokx obj cl it)
+ it)
+ (error "no attribute"))))
+ (set c '__name__ "**super**")
+ (set o '__class__ c)
+ o))))
(call-with-values
(lambda ()
@@ -1222,17 +1285,16 @@ explicitly tell it to not update etc.
(define __init_subclass__ (lambda x (values)))
(define ___zub_classes__ (make-weak-key-hash-table))
(define __subclasses__ subclasses)
- (define __call__
- (case-lambda
- ((meta obj)
- (ref obj '__class__ 'None))
- ((meta name bases dict . keys)
- (type- meta name bases dict keys))))))
+ (define __call__ type-call)
+ (define mro (lambda (self) (ref self '__mro__)))))
+
(set type '__class__ type)
(set! object (make-python-class object ()
- (define __subclasses__ subclasses)
- (define __weakref__ (lambda (self) self))))
+ (define __init__ (lambda x (values)))
+ (define __subclasses__ subclasses)
+ (define __weakref__ (lambda (self) self))))
+
(name-object type)
(name-object object)
@@ -1242,4 +1304,14 @@ explicitly tell it to not update etc.
it
(next-method)))
-
+
+(define-method (py-dict (o <p>))
+ (aif it (ref o '__dict__)
+ it
+ (slot-ref o 'h)))
+
+(define-python-class NoneObj ()
+ (define __new__
+ (lambda x 'None)))
+
+