summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>2018-08-25 20:42:16 +0200
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>2018-08-25 20:42:16 +0200
commit476007acf39bbf6e2e4a1239ebb8835195895156 (patch)
treeee08fd893116d61ce1956ccc8700f145e02e2c3f
parent582d1c6f0be332ad4cb9f421bea5c2be56a12408 (diff)
socket compiles
-rw-r--r--modules/language/python/compile.scm9
-rw-r--r--modules/language/python/dict.scm18
-rw-r--r--modules/language/python/for.scm6
-rw-r--r--modules/language/python/list.scm23
-rw-r--r--modules/language/python/module.scm55
-rw-r--r--modules/language/python/module/_python.scm6
-rw-r--r--modules/language/python/module/enum.py17
-rw-r--r--modules/language/python/module/os.scm12
-rw-r--r--modules/language/python/module/socket.py23
-rw-r--r--modules/language/python/string.scm4
-rw-r--r--modules/oop/pf-objects.scm285
11 files changed, 277 insertions, 181 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index 983eb66..d912587 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -1061,14 +1061,9 @@
((_ (#:from (() . nm) l))
;; Make sure to load the module in
(let* ((xl (map (lambda (nm) (exp vs nm)) nm))
- (ll `(language python module ,@xl))
- (? (catch #t
- (lambda () (Module (reverse ll) (reverse xl)) #t)
- (lambda x #f))))
-
- (if ? (for-each dont-warn (get-exported-symbols ll)))
+ (ll `(language python module ,@xl)))
- `(,(C 'use) ,? ',ll
+ `(,(C 'use) #t '()
(,ll
#:select
,(map (lambda (x)
diff --git a/modules/language/python/dict.scm b/modules/language/python/dict.scm
index be857ba..9eb698d 100644
--- a/modules/language/python/dict.scm
+++ b/modules/language/python/dict.scm
@@ -651,7 +651,7 @@
(define __setitem__
(lambda (self k v)
(pylist-set! (ref self '_dict) (norm k) v)))
-
+
(define __iter__
(lambda (self)
((make-generator ()
@@ -688,7 +688,21 @@
(for ((k v : (ref self '_dict))) ((l '()))
(cons (list (renorm k) v) l)
#:final (reverse l))))
-
+
+ (define keys
+ (lambda (self)
+ (for ((k v : self)) ((l '()))
+ (cons (renorm k) l)
+ #:final
+ l)))
+
+ (define values
+ (lambda (self)
+ (for ((k v : self)) ((l '()))
+ (cons v l)
+ #:final
+ l)))
+
(define __repr__
(lambda (self)
(for ((k v : (ref self '_dict))) ((l '()))
diff --git a/modules/language/python/for.scm b/modules/language/python/for.scm
index 5b7b4a6..cebb5d1 100644
--- a/modules/language/python/for.scm
+++ b/modules/language/python/for.scm
@@ -20,6 +20,8 @@
(syntax-rules (:)
((for ((x ... : E) ...) ((c n) ...) code ... #:final fin)
(for-work #f ((x ... : E) ...) ((c n) ...) (code ...) fin values))
+ ((for ((x ... : E) ...) ((c n) ...) code ... #:finally fin)
+ (for-work #f ((x ... : E) ...) ((c n) ...) (code ...) fin values))
((for ((x ... : E) ...) ((c n) ...) code ... #:else fin)
(for-work #f ((x ... : E) ...) ((c n) ...) (code ...) (values)
@@ -28,6 +30,9 @@
((for lp ((x ... : E) ...) ((c n) ...) code ... #:final fin)
(for-work lp ((x ... : E) ...) ((c n) ...) (code ...) fin values))
+ ((for lp ((x ... : E) ...) ((c n) ...) code ... #:finally fin)
+ (for-work lp ((x ... : E) ...) ((c n) ...) (code ...) fin values))
+
((for lp ((x ... : E) ...) ((c n) ...) code ... #:else fin)
(for-work lp ((x ... : E) ...) ((c n) ...) (code ...) (values)
(lambda () fin)))
@@ -147,6 +152,7 @@
(define-method (wrap-in (o <p>))
(aif it (ref o '__iter__)
(let ((x (it)))
+ (pk 'wrap-in o x)
(cond
((pair? x) (wrap-in x))
(else x)))
diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm
index 7deda10..a60703c 100644
--- a/modules/language/python/list.scm
+++ b/modules/language/python/list.scm
@@ -695,14 +695,27 @@
;; SORT!
(define (id x) x)
+(define (sort- it key reverse)
+ (catch #t
+ (lambda ()
+ (for ((x : it)) ((l '()) (i 0))
+ (values (cons ((@ (guile) list) (key x) i x) l)
+ (+ i 1))
+
+ #:final
+ (begin
+ (let lp ((l (sort (reverse! l) (if reverse > <)))
+ (i 0))
+ (if (pair? l)
+ (let ((x (car l)))
+ (pylist-set! it i (caddr x))
+ (lp (cdr l) (+ i 1))))))))
+ (lambda x (raise (TypeError "problem in sorting layout")))))
+
(define-method (pylist-sort! (o <py-list>) . l)
(apply
(lambda* (#:key (key id) (reverse #f))
- (let lp ((l (sort (map key (to-list o)) (if reverse > <))) (i 0))
- (if (pair? l)
- (begin
- (pylist-set! o i (car l))
- (lp (cdr l) (+ i 1))))))
+ (sort- o key reverse))
l))
(define-method (pylist-sort! (o <p>) . l)
diff --git a/modules/language/python/module.scm b/modules/language/python/module.scm
index 8e705a8..5cefeba 100644
--- a/modules/language/python/module.scm
+++ b/modules/language/python/module.scm
@@ -145,13 +145,17 @@
(define (fail)
(raise (AttributeError "getattr in Module")))
(let ((k (_k k)))
- (let ((x (module-ref (rawref self '_export) k e)))
- (if (eq? e x)
- (let ((x (module-ref (_m self) k e)))
- (if (eq? e x)
- (fail)
- x))
- x)))))
+ (cond
+ ((memq k '(__iter__ __repr__))
+ (lambda () ((rawref self k) self)))
+ (else
+ (let ((x (module-ref (rawref self '_export) k e)))
+ (if (eq? e x)
+ (let ((x (module-ref (_m self) k e)))
+ (if (eq? e x)
+ (fail)
+ x))
+ x)))))))
(define __setattr__
(lambda (self k v)
@@ -190,30 +194,31 @@
(module-for-each add m)
(module-for-each add (rawref self '_export))
(py-list l))))
+
+
+ (define __iter__
+ (lambda (self)
+ (let* ((h (slot-ref self 'h))
+ (l '())
+ (m (_m self))
+ (add (lambda (k v)
+ (let ((k (symbol->string k)))
+ (if (and (not (in "-" k)) (variable-bound? v))
+ (set! l (cons (list k (variable-ref v))
+ l)))))))
+ (module-for-each add m)
+ (module-for-each add (rawref self '_export))
+ l)))
+
(define __repr__
- (lambda (self) (format #f "Module(~a)" (ref self '__name__))))
+ (lambda (self) (format #f "Module(~a)" (rawref self '__name__))))
(define __getitem__
(lambda (self k)
(define k (if (string? k) (string->symbol k) k))
- (__getattribute__ self k)))
-
- (define __iter__
- (lambda (self)
- (define m (_m self))
- ((make-generator ()
- (lambda (yield)
- (define l '())
- (define (f k v) (set! l (cons (list (symbol->string k) v) l)))
- (module-for-each f m)
- (let lp ((l l))
- (if (pair? l)
- (begin
- (apply yield (car l))
- (lp (cdr l)))))))))))
-
+ (__getattribute__ self k))))
(define-syntax import
@@ -270,3 +275,5 @@
(let ((e (Module x)))
(pylist-set! modules x e)
e))))
+
+(set! (@@ (oop pf-objects) Module) Module)
diff --git a/modules/language/python/module/_python.scm b/modules/language/python/module/_python.scm
index 531a6b5..6db3cf1 100644
--- a/modules/language/python/module/_python.scm
+++ b/modules/language/python/module/_python.scm
@@ -55,7 +55,11 @@
(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
-(define vars py-dict)
+(define (vars x)
+ (for ((k v : x)) ((l '()))
+ (cons (cons k v) l)
+ #:final
+ (dict l)))
(define (repr x) ((@ (guile) format) #f "~a" x))
(define abs py-abs)
diff --git a/modules/language/python/module/enum.py b/modules/language/python/module/enum.py
index 34e19b6..80b9499 100644
--- a/modules/language/python/module/enum.py
+++ b/modules/language/python/module/enum.py
@@ -17,7 +17,6 @@ __all__ = [
'auto', 'unique',
]
-
def _is_descriptor(obj):
"""Returns True if obj is a descriptor, False otherwise."""
return (
@@ -532,11 +531,13 @@ class Enum(metaclass=EnumMeta):
# all enum instances are actually created during class construction
# without calling this method; this method is called by the metaclass'
# __call__ (i.e. Color(3) ), and by pickle
+
if type(value) is cls:
# For lookups like Color(Color.RED)
return value
# by-value search for a matching enum member
# see if it's in the reverse mapping (for hashable values)
+
try:
if value in cls._value2member_map_:
return cls._value2member_map_[value]
@@ -545,6 +546,7 @@ class Enum(metaclass=EnumMeta):
for member in cls._member_map_.values():
if member._value_ == value:
return member
+
# still not found -- try _missing_ hook
return cls._missing_(value)
@@ -626,6 +628,7 @@ class Enum(metaclass=EnumMeta):
# also, replace the __reduce_ex__ method so unpickling works in
# previous Python versions
module_globals = vars(sys.modules[module])
+
if source:
source = vars(source)
else:
@@ -636,19 +639,24 @@ class Enum(metaclass=EnumMeta):
# are multiple names for the same number rather than varying
# between runs due to hash randomization of the module dictionary.
members = [
- (name, source[name])
- for name in source.keys()
- if filter(name)]
+ (name, source[name])
+ for name in source.keys()
+ if filter(name)]
try:
# sort by value
members.sort(key=lambda t: (t[1], t[0]))
except TypeError:
# unless some values aren't comparable, in which case sort by name
members.sort(key=lambda t: t[0])
+
cls = cls(name, members, module=module)
+
cls.__reduce_ex__ = _reduce_ex_by_name
+
module_globals.update(cls.__members__)
+
module_globals[name] = cls
+
return cls
@@ -887,3 +895,4 @@ def _power_of_two(value):
if value < 1:
return False
return value == 2 ** _high_bit(value)
+
diff --git a/modules/language/python/module/os.scm b/modules/language/python/module/os.scm
index d593b58..dab8dda 100644
--- a/modules/language/python/module/os.scm
+++ b/modules/language/python/module/os.scm
@@ -2355,8 +2355,10 @@
(define path "posixpath")
(define (_get_exports_list mod)
- (let ((p (rawref mod '_private)))
- (rawset mod '_private #f)
- (let ((l (dir mod)))
- (rawset mod '_private p)
- l)))
+ (let ((p (rawref mod '_export))
+ (l '()))
+ (module-for-each
+ (lambda (k v)
+ (set! l (cons (symbol->string k) l)))
+ p)
+ (py-list l)))
diff --git a/modules/language/python/module/socket.py b/modules/language/python/module/socket.py
index 31b814a..cb70bc8 100644
--- a/modules/language/python/module/socket.py
+++ b/modules/language/python/module/socket.py
@@ -47,33 +47,32 @@ Integer constants:
Many other constants may be defined; these may be used in calls to
the setsockopt() and getsockopt() methods.
"""
-pk(0,1)
+
import _socket
from _socket import *
-pk(0,2)
import os, sys, io, selectors
from enum import IntEnum, IntFlag
-pk(0,3)
+
try:
import errno
except ImportError:
errno = None
-pk(0,4)
+
EBADF = getattr(errno, 'EBADF', 9)
EAGAIN = getattr(errno, 'EAGAIN', 11)
EWOULDBLOCK = getattr(errno, 'EWOULDBLOCK', 11)
-pk(0,5)
+
__all__ = ["fromfd", "getfqdn", "create_connection",
"AddressFamily", "SocketKind"]
__all__.extend(os._get_exports_list(_socket))
-pk(0,6)
+
# Set up the socket.AF_* socket.SOCK_* constants as members of IntEnums for
# nicer string representations.
# Note that _socket only knows about the integer values. The public interface
# in this module understands the enums and translates them back from integers
# where needed (e.g. .family property of a socket object).
name__ = '_socket'
-pk(1)
+
IntEnum._convert(
'AddressFamily',
name__,
@@ -92,7 +91,7 @@ IntFlag._convert(
'AddressInfo',
name__,
lambda C: C.isupper() and C.startswith('AI_'))
-pk(2)
+
_LOCALHOST = '127.0.0.1'
_LOCALHOST_V6 = '::1'
@@ -462,7 +461,7 @@ def fromfd(fd, family, type, proto=0):
"""
nfd = dup(fd)
return socket(family, type, proto, nfd)
-pk(3)
+
if hasattr(_socket.socket, "share"):
def fromshare(info):
""" fromshare(info) -> socket object
@@ -472,7 +471,7 @@ if hasattr(_socket.socket, "share"):
"""
return socket(0, 0, 0, info)
__all__.append("fromshare")
-pk(4)
+
if hasattr(_socket, "socketpair"):
def socketpair(family=None, type=SOCK_STREAM, proto=0):
@@ -533,7 +532,7 @@ else:
lsock.close()
return (ssock, csock)
__all__.append("socketpair")
-pk(5)
+
socketpair.__doc__ = """socketpair([family[, type[, proto]]]) -> (socket object, socket object)
Create a pair of socket objects from the sockets returned by the platform
socketpair() function.
@@ -751,4 +750,4 @@ def getaddrinfo(host, port, family=0, type=0, proto=0, flags=0):
_intenum_converter(socktype, SocketKind),
proto, canonname, sa))
return addrlist
-pk(6)
+
diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm
index 3069527..a189d84 100644
--- a/modules/language/python/string.scm
+++ b/modules/language/python/string.scm
@@ -191,9 +191,9 @@
(mk-is py-isalnum isalnum char-alphabetic? char-numeric?)
(mk-is py-isalpha isalpha char-alphabetic?)
(mk-is py-isdigit isdigit char-numeric?)
-(mk-is py-islower islower char-lower-case?)
+(mk-is py-islower islower (lambda (ch) (or (eq? ch #\_) (char-lower-case? ch))))
(mk-is py-isspace isspace char-whitespace?)
-(mk-is py-isupper isupper char-upper-case?)
+(mk-is py-isupper isupper (lambda (ch) (or (eq? ch #\_) (char-upper-case? ch))))
(define-py (py-identifier? isidentifier s)
(let lp ((l (string->list s)) (first? #t))
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index 5eea799..f5b6466 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -184,18 +184,18 @@ explicitly tell it to not update etc.
(define-syntax-rule (find-in-class-and-parents klass key fail-)
- (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
- (lp (cdr parents)))
- fail-))
- (kif r (find-in-class klass key fail)
- r
+ (kif r (find-in-class klass key fail)
+ r
+ (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
+ (lp (cdr parents)))
+ fail-))
fail-)))
(define-syntax-rule (find-in-class-and-parents-raw klass key fail-)
@@ -310,8 +310,116 @@ explicitly tell it to not update etc.
(define hash-for-each* hash-for-each)
+(define (kw->class kw meta)
+ (if (memq #:functional kw)
+ (if (memq #:fast kw)
+ <pf>
+ (if (or (not meta) (is-a? meta <pyf>) (is-a? meta <py>))
+ <pyf>
+ <pf>))
+ (if (memq #:fast kw)
+ (if (or (is-a? meta <pyf>) (is-a? meta <pf>))
+ <pf>
+ <p>)
+ (cond
+ ((is-a? meta <pyf>)
+ <pyf>)
+ ((is-a? meta <py>)
+ <py>)
+ ((is-a? meta <pf>)
+ <pf>)
+ ((is-a? meta <p>)
+ <p>)
+ (else
+ <py>)))))
+
+(define (project-goopses supers)
+ (map (lambda (sups)
+ (aif it (find-in-class sups '__goops__ #f)
+ it
+ sups))
+ supers))
+
+(define (filter-parents l)
+ (let lp ((l l))
+ (if (pair? l)
+ (if (is-a? (car l) <p>)
+ (cons (car l) (lp (cdr l)))
+ (lp (cdr l)))
+ '())))
+
+(define (get-goops meta name parents kw)
+ (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))))))
+ '())))
+
+ (make-class
+ (unique
+ (append
+ (project-goopses parents)
+ (list (kw->class kw meta)))) '() #:name name))
+
+(define (get-cparents supers)
+ (let ((parents (filter-parents supers)))
+ (if (null? parents)
+ (if object
+ (list object)
+ '())
+ parents)))
+
+(define (get-mros supers)
+ (get-mro (get-cparents supers)))
+
+(define (Module x . l) (reverse x))
+
+(define (add-specials pylist-set! dict name goops supers meta doc)
+ (define (make-module)
+ (let ((l (module-name (current-module))))
+ (if (and (>= (length l) 3)
+ (equal? (list-ref l 0) 'language)
+ (equal? (list-ref l 1) 'python)
+ (equal? (list-ref l 2) 'module))
+ (Module (reverse l) (reverse (cdddr l)))
+ l)))
+
+ (define parents (filter-parents supers))
+ (define cparents (get-cparents supers))
+
+ (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))))
+ '())))
+
+ (pylist-set! dict '__goops__ goops)
+ (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 '__name__ name)
+ (pylist-set! dict '__qualname__ name)
+ (pylist-set! dict '__mro__ (get-mro cparents))
+ (if doc (pylist-set! dict '__doc__ doc))
+ (pylist-set! dict '__class__ meta))
+
(define (new-class0 meta name parents dict . kw)
- (let* ((goops (pylist-ref dict '__goops__))
+ (set! name (if (symbol? name) name (string->symbol name)))
+ (let* ((raw? #f)
+ (goops (catch #t
+ (lambda () (pylist-ref dict '__goops__))
+ (lambda x
+ (set! raw? #t)
+ (get-goops meta name parents kw))))
(p (kwclass->class kw meta))
(class (make-p p)))
@@ -320,7 +428,10 @@ explicitly tell it to not update etc.
(create-object class x)))
(when class
- (let lp ((mro (pylist-ref dict '__mro__)))
+ (let lp ((mro (catch #t
+ (lambda () (pylist-ref dict '__mro__))
+ (lambda x (get-mros parents)))))
+
(if (pair? mro)
(let ((p (car mro)))
(aif it (find-in-class p '__zub_classes__ #f)
@@ -332,22 +443,37 @@ explicitly tell it to not update etc.
#f)
(lp (cdr mro)))))
-
-
+
(hash-for-each*
(lambda (k v)
(let ((k (if (string? k) (string->symbol k) k)))
(rawset class k v)))
dict)
-
- (rawset class '__goops__ goops)
- (let ((mro (add-default class (pylist-ref dict '__mro__))))
+ (if raw?
+ (begin
+ (add-specials rawset class name goops parents meta
+ (catch #t
+ (lambda () (pylist-ref kw "doc"))
+ (lambda x #f)))
+ (set (rawref class '__module__)
+ (if (string? name) (string->symbol name) name)
+ class))
+ (rawset class '__goops__ goops))
+
+ (let ((mro (add-default class
+ (catch #t
+ (lambda () (pylist-ref dict '__mro__))
+ (lambda x (get-mros parents))))))
(rawset class '__mro__ mro))
-
- (if (not (ficap-raw class '__getattribute__ #f))
- (rawset class '__getattribute__ attr)))
-
+
+ (catch #t
+ (lambda ()
+ (if (not (ficap-raw class '__getattribute__ #f))
+ (rawset class '__getattribute__ attr)))
+ (lambda x
+ (rawset class '__getattribute__ attr))))
+
class))
(define (new-class meta name parents dict kw)
@@ -398,7 +524,15 @@ explicitly tell it to not update etc.
(if (pytype? class)
(apply (case-lambda
((meta obj)
- (and obj (find-in-class-raw obj '__class__ 'None)))
+ (catch #t
+ (lambda ()
+ (aif it (find-in-class-raw obj '__class__ #f)
+ it
+ type))
+ (lambda x
+ (warn x)
+ type)))
+
((meta name bases dict . keys)
(type- meta name bases dict keys)))
class l)
@@ -803,39 +937,7 @@ explicitly tell it to not update etc.
;; it's good to have a null object so we don't need to construct it all the
;; time because it is functional we can get away with this.
(define null (make-p <pf>))
-
-(define (filter-parents l)
- (let lp ((l l))
- (if (pair? l)
- (if (is-a? (car l) <p>)
- (cons (car l) (lp (cdr l)))
- (lp (cdr l)))
- '())))
-
-(define (kw->class kw meta)
- (if (memq #:functional kw)
- (if (memq #:fast kw)
- <pf>
- (if (or (not meta) (is-a? meta <pyf>) (is-a? meta <py>))
- <pyf>
- <pf>))
- (if (memq #:fast kw)
- (if (or (is-a? meta <pyf>) (is-a? meta <pf>))
- <pf>
- <p>)
- (cond
- ((is-a? meta <pyf>)
- <pyf>)
- ((is-a? meta <py>)
- <py>)
- ((is-a? meta <pf>)
- <pf>)
- ((is-a? meta <p>)
- <p>)
- (else
- <py>)))))
-
(define (defaulter d)
(if d
(aif it (ref d '__goops__)
@@ -874,6 +976,7 @@ explicitly tell it to not update etc.
(define type #f)
(define object #f)
+
(define make-p-class
(case-lambda
((name supers.kw methods)
@@ -881,22 +984,9 @@ explicitly tell it to not update etc.
((name doc supers.kw methods)
(define s.kw supers.kw)
(define kw (cdr s.kw))
- (define supers (car s.kw))
- (define goopses (map (lambda (sups)
- (aif it (find-in-class sups '__goops__ #f)
- it
- sups))
- supers))
-
- (define parents (let ((p (filter-parents supers)))
- p))
-
- (define cparents (if (null? parents)
- (if object
- (list object)
- '())
- parents))
-
+ (define supers (car s.kw))
+ (define parents (filter-parents supers))
+ (define cparents (get-cparents supers))
(define meta (aif it (memq #:metaclass kw)
(cadr it)
(if (null? cparents)
@@ -918,55 +1008,12 @@ explicitly tell it to not update etc.
(lp l m mro))
(lp l m mro)))
(() m)))))))
-
- (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 (unique
- (append goopses
- (list (kw->class kw meta))))
- '() #:name name))
-
- (define (make-module)
- (let ((l (module-name (current-module))))
- (if (and (>= (length l) 3)
- (equal? (list-ref l 0) 'language)
- (equal? (list-ref l 1) 'python)
- (equal? (list-ref l 2) 'module))
- (string-join
- (map symbol->string (cdddr l))
- ".")
- l)))
+
+ (define goops (get-goops meta name supers kw))
- (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))))
- '())))
-
+ (define (gen-methods dict)
(methods dict)
- (pylist-set! dict '__goops__ goops)
- (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 '__name__ name)
- (pylist-set! dict '__qualname__ name)
- (pylist-set! dict '__mro__ (get-mro cparents))
- (pylist-set! dict '__doc__ doc)
- (pylist-set! dict '__class__ meta)
+ (add-specials pylist-set! dict name goops supers meta doc)
dict)
(let ((cl (with-fluids ((*make-class* #t))