socket compiles
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sat, 25 Aug 2018 18:42:16 +0000 (20:42 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sat, 25 Aug 2018 18:42:16 +0000 (20:42 +0200)
modules/language/python/compile.scm
modules/language/python/dict.scm
modules/language/python/for.scm
modules/language/python/list.scm
modules/language/python/module.scm
modules/language/python/module/_python.scm
modules/language/python/module/enum.py
modules/language/python/module/os.scm
modules/language/python/module/socket.py
modules/language/python/string.scm
modules/oop/pf-objects.scm

index 983eb66..d912587 100644 (file)
   ((_ (#: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)
index be857ba..9eb698d 100644 (file)
   (define __setitem__
     (lambda (self k v)
       (pylist-set! (ref self '_dict) (norm k) v)))
-
+  
   (define __iter__
     (lambda (self)
       ((make-generator ()
       (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 '()))
index 5b7b4a6..cebb5d1 100644 (file)
@@ -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)))
 (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)))
index 7deda10..a60703c 100644 (file)
 
 ;; 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)
index 8e705a8..5cefeba 100644 (file)
       (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)
         (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
         (let ((e (Module x)))
           (pylist-set! modules x e)
           e))))
+
+(set! (@@ (oop pf-objects) Module) Module)
index 531a6b5..6db3cf1 100644 (file)
 
 (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)
index 34e19b6..80b9499 100644 (file)
@@ -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)
+
index d593b58..dab8dda 100644 (file)
 (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)))
index 31b814a..cb70bc8 100644 (file)
@@ -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)
+
index 3069527..a189d84 100644 (file)
 (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))
index 5eea799..f5b6466 100644 (file)
@@ -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))