pf-object fixes
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 22 Nov 2017 22:28:54 +0000 (23:28 +0100)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 22 Nov 2017 22:28:54 +0000 (23:28 +0100)
modules/language/python/bytes.scm
modules/oop/pf-objects.scm

index 44c93bc07095316fa80457f4083fa576ab01ccd8..7700a00966cc39676cafa6d420a14068c9502a02 100644 (file)
@@ -57,7 +57,7 @@
                    (lp (+ i 1)))))
            (slot-set! self 'bytes bytes)))
         ((is-a? s <py-string>)
-         (__init__ self (slot-ref s 'bytes)))        
+         (__init__ self (slot-ref s 'str)))        
         ((is-a? s <py-bytes>)
          (slot-set! self 'bytes (slot-ref s 'bytes)))
         ((is-a? s <bytevector>)
                 (b (b-make n)))
            (bytevector-copy! (slot-ref s 'vec) 0 b 0 n)
            (slot-set! self 'bytes b)))
-        (else        
+        (else
          (for ((x : s)) ((r '()))
               (cons (b-char x) r)
 
               #:final
-              (let* ((n   (length r))
+              (let* ((n     (length r))
                      (bytes (b-make n)))
                 (let lp ((i (- n 1)) (r r))
                   (if (>= i 0)
index 10016c78ef514aed6acc65742484f2c501286fde..4ed5680f6e63a38470b52ecaa8ef6e36040244ba 100644 (file)
@@ -73,10 +73,10 @@ explicitly tell it to not update etc.
                       (create-object class meta goops x)))
          (if (hash-table? dict)
              (hash-for-each
-              (lambda (k v) (set class k v))
+              (lambda (k v) (set class k v))
               dict)
              (hashforeach
-              (lambda (k v) (set class k v))
+              (lambda (k v) (set class k v))
               dict))
          (let((mro (ref class '__mro__)))
            (if (pair? mro)
@@ -98,7 +98,7 @@ explicitly tell it to not update etc.
   (let ((dict (gen-methods (get-dict meta name keys))))
     (aif it (ref meta '__class__)
          (aif it (find-in-class (ref meta '__class__) '__call__ #f)
-              (apply (it meta 'object) name parents dict keys)
+              (apply (it meta 'class) name parents dict keys)
               (type- meta name parents dict keys))
          (type- meta name parents dict keys))))
 
@@ -107,7 +107,7 @@ explicitly tell it to not update etc.
        (apply it x)       
        (let ((obj (aif it (find-in-class class '__new__ #f)
                        ((it class 'object))
-                       (make-object class meta goops))))
+                       (make-object class meta goops))))        
          (aif it (ref obj '__init__)
               (apply it x)
               #f)
@@ -254,14 +254,14 @@ explicitly tell it to not update etc.
   (let ((xx x))
     (let ((res (mrefx xx key l)))
       (if (and (not (struct? res)) (procedure? res))
-         (res xx)
+         (res xx (fluid-ref *refkind*))
          res))))
 
 (define-syntax-rule (mref-py x key l)
   (let ((xx x))
     (let ((res (mrefx-py xx key l)))
       (if (and (not (struct? res)) (procedure? res))
-         (res xx)
+         (res xx (fluid-ref *refkind*))
          res))))
 
 (define-method (ref x key . l) (if (pair? l) (car l) #f))
@@ -347,6 +347,7 @@ explicitly tell it to not update etc.
 (define-syntax-rule (mklam (mset a ...) val)
   (if (and (procedure? val)
            (not (pyclass? val))
+           (not (pytype?  val))
            (if (is-a? val <p>)
                (ref val '__call__)
                #t))
@@ -638,11 +639,11 @@ 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)))
-                              '() #:name name))
+  (define goops (make-class (append goopses (list (kw->class kw meta)))
+                            '() #:name name))
     
   (define (gen-methods dict)
-    (method dict)
+    (methods dict)
     (pylist-set! dict '__goops__   goops)
     (pylist-set! dict '__class__   meta)
     (pylist-set! dict '__fget__    #t)
@@ -652,6 +653,7 @@ explicitly tell it to not update etc.
     (pylist-set! dict '__class__   meta)
     (pylist-set! dict '__mro__     (get-mro parents))
     dict)
+  
   (create-class meta name parents gen-methods kw))
 
 
@@ -724,7 +726,7 @@ explicitly tell it to not update etc.
           (if (keyword? x)
               (cons (reverse r) l)
               (lp (cdr l) (cons x r))))
-        (cons (reverse l) '()))))
+        (cons (reverse r) '()))))
 
 (define-syntax-rule (define-python-class name (parents ...) code ...)
   (define name (mk-p-class name (arglist->pkw (list parents ...)) code ...)))