some improvements

parent 27993e7d
......@@ -1854,11 +1854,17 @@ empty list."
`(,(T 'try) (,(G 'lambda) () ,(exp vs x)))))
((_ x exc else . fin)
`(,(T 'try) (lambda () ,(exp vs x))
`(,(T 'try) (lambda () ,(exp vs x))
,@(let lp ((exc exc) (r '()))
(define (f x)
(match x
((#:list . l)
`((@ (guile) or) ,@(map (lambda (x) (exp vs x)) l)))
(x (exp vs x))))
(match exc
((((test . #f) code) . exc)
(lp exc (cons `(#:except ,(exp vs test) ,(exp vs code)) r)))
(lp exc (cons `(#:except ,(f test) ,(exp vs code)) r)))
(((#f code) . exc)
(lp exc (cons `(#:except #t ,(exp vs code)) r)))
......@@ -1867,7 +1873,7 @@ empty list."
(let ((l (gensym "l")))
(lp exc
`(#:except ,(exp vs test) => (,(G 'lambda)
`(#:except ,(f test) => (,(G 'lambda)
(,(exp vs as) . ,l)
,(exp vs code)))
......@@ -120,10 +120,11 @@
(define miss (slask-it ((@ (guile) list) 'miss)))
(define* (getattr a b #:optional (k miss))
(let ((r (ref a (if (string? b) (string->symbol b) b) miss)))
(if (eq? r miss)
(if (eq? k miss)
(if (equal? b "__module__")
(pk 'getattr b k)
(let ((r (pk 'getattr 2 (ref a (if (string? b) (string->symbol b) b) miss))))
(if (pk 'getattr 3 (eq? r miss))
(if (pk 'getattr 4 (eq? k miss))
(if (pk 'getattr 5 (equal? b "__module__"))
(raise AttributeError
"object/class ~a is missing attribute ~a" a b))
......@@ -61,10 +61,11 @@
#:final (reverse l))))))
(pk 'abc_o_a (object-address cls))
(for ((base : bases)) ()
(for ((name : (ref base '__abstractmethods__ (py-set '())))) ()
(let ((value (getattr cls name None)))
(if (ref value '__isabstractmethod__)
((ref abstracts 'add) name)))))
(for ((name : (ref base '__abstractmethods__ '()))) ()
(let ((value (rawref cls name None)))
(if (ref value '__isabstractmethod__ #f)
((ref abstracts 'add) name))))
(set cls '__abstractmethods__ (frozenset abstracts))
(set cls '_abc_registry (WeakSet))
......@@ -606,7 +606,7 @@
(set! verbose xx)
(pk 'namedtyple typename field_names)
(let ((seen (py-set)))
(if (string? field_names)
(set! field_names
......@@ -660,35 +660,37 @@
(py-add! seen name))
(set! field_names (map string->symbol (to-list field_names)))
(pk 'namedtyple typename field_names)
(make-p-class (string->symbol typename) '(())
(lambda (dict)
(pk 'collections 1)
(pylist-set! dict '_fields (map symbol->string field_names))
(pk 'collections 2)
(pylist-set! dict '__init__
(eval (v `(lam
,@(map (lambda (key) `(= ,key ,None))
(reverse field_names)))
((@ (guile) values))
,@(map (lambda (key) `(set self ',key ,key))
(reverse field_names))))
(pk 'collections 3)
(pylist-set! dict '__getitem__
(lambda (self i)
(if (number? i)
(ref self (list-ref field_names i))
(ref self (scm-sym i))))))
(pk 'collections 4)
(pylist-set! dict '__setitem__
(lambda (self i val)
(if (number? i)
(set self (list-ref field_names i) val)
(set self (scm-sym i) val)))))
(pk 'collections 5)
(pylist-set! dict '__repr__
(lambda (self . l)
......@@ -702,7 +704,7 @@
(car l)
(cdr l))))))
(pk 'collections 6)
(if (eq? module None)
(set! module (module-name (current-module)))
(if (string? (scm-str module))
......@@ -710,7 +712,8 @@
(+ '(language python module)
(map scm-sym
(string-split module #\.))))))
(pk 'collections 7)
(if verbose (pretty-print verbose))))))
(define UserDict dict)
......@@ -2060,7 +2060,7 @@ def _make_nmtuple(name, types):
# Now, both __annotations__ and _field_types are used to maintain compatibility.
nm_tpl.__annotations__ = nm_tpl._field_types = collections.OrderedDict(types)
nm_tpl.__module__ = sys._getframe(2).f_globals.get('__name__', '__main__')
except (AttributeError, ValueError):
......@@ -569,8 +569,11 @@ explicitly tell it to not update etc.
(apply new-class0 meta name parents dict kw)))
(define (type- meta name parents dict keys)
(pk 'type- meta name)
(let ((class (new-class meta name parents dict keys)))
(aif it (and meta (find-in-class-and-parents meta '__init__ #f))
(pk 'type- 1)
(aif it (pk 'teyp- 2
(and meta (find-in-class-and-parents meta '__init__ #f)))
(it class name parents dict keys)
......@@ -664,9 +667,11 @@ explicitly tell it to not update etc.
(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-raw meta '__class__ #f))
(aif it (ficap-raw it '__call__ #f)
(pk 'create-class meta name)
(let ((dict (gen-methods (pk 'create-class 2 (get-dict meta name parents)))))
(pk 'create-class 1 meta)
(aif it (and meta (pk '__class (find-in-class-raw meta '__class__ #f)))
(aif it (pk 2 '__call__ (ficap-raw it '__call__ #f))
(apply it meta name parents dict keys)
(type- meta name parents dict keys))
(type- meta name parents dict keys))))
......@@ -1129,7 +1134,7 @@ explicitly tell it to not update etc.
(define supers (car
(define parents (filter-parents supers))
(define cparents (pk 'cparents (get-cparents supers)))
(define meta (aif it (memq #:metaclass kw)
(define meta (pk 'meta (aif it (memq #:metaclass kw)
(cadr it)
(if (null? cparents)
......@@ -1141,28 +1146,30 @@ explicitly tell it to not update etc.
((pp . l)
(aif mm (rawref pp '__class__)
(aif mmro (rawref mm '__mro__)
(pk 'pf-object 'mmro m mmro)
((memq m mmro)
(lp l mm mmro))
((memq mm mro)
(lp l m mro))
(error "TypeError for meta"))))
(error "TypeError for meta")))
(lp l m mro))
(lp l m mro)))
(() m)))))))
(() m))))))))
(define goops (get-goops meta name supers kw))
(define (gen-methods dict)
(define (gen-methods dict)
(pk 'gen-methods 1)
(methods dict)
(pk 'gen-methods 2)
(add-specials pylist-set! dict name goops supers meta doc)
(pk 'pf-objects 12)
(let ((cl (with-fluids ((*make-class* #t))
(create-class meta name parents gen-methods kw))))
(pk 'pf-objects 13)
(aif it (ref meta '__init_subclass__)
(let lp ((ps cparents))
(if (pair? ps)
Markdown is supported
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment