property values
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 4 Oct 2017 18:03:43 +0000 (20:03 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 4 Oct 2017 18:03:43 +0000 (20:03 +0200)
modules/language/python/compile.scm
modules/language/python/def.scm
modules/language/python/exceptions.scm
modules/language/python/list.scm
modules/language/python/module/python.scm
modules/language/python/number.scm
modules/oop/pf-objects.scm

index 275c635575196955f9a0824d06f7dbe81c7389ec..c9acea10094277351ff8afc0228c3877ff2b6543 100644 (file)
    ((__close__)     (Y 'sendClose))
    
    ;; Numerics
+   ((__index__)    (N 'py-index))
    ((__add__ )     (N '+))
    ((__mul__ )     (N '*))
    ((__sub__ )     (N '-))
index bc745f0f75b5035602d9d9b667b485c0fad821f2..c65cd07a818c3bdddf257c0d778252f5973ee8ac 100644 (file)
@@ -9,8 +9,8 @@
       (lam (car l) (fold lam s (cdr l)))
       s))
 
-(define-syntax-rule (take-1 ww* kw s v)
-  (if (null? ww*)
+(define-syntax-rule (take-1 pww ww* kw s v)
+  (if (not pww)
       (values ww*
               (aif it (hash-ref kw s #f)
                    (begin
       ((_ (arg ...) code ...)
        (let* ((as  (fold get-as '() #'(arg ...)))
               (kw  (fold get-kw '() #'(arg ...)))
-              (ww  (fold get-ww '() #'(arg ...)))
+              (ww- (fold get-ww '() #'(arg ...)))
               (kv  (fold get-kv '() #'(arg ...))))
-         (if (and-map null? (list kw ww kv))
+         (if (and-map null? (list kw ww- kv))
              #`(lambda #,as code ...)
              (with-syntax ((kw      (if (null? kw)
                                         (datum->syntax x (gensym "kw"))
                                         (car kw)))
-                           (ww      (if (null? ww)
+                           (ww      (if (null? ww-)
                                         (datum->syntax x (gensym "ww"))
-                                        (car ww)))
+                                        (car ww-)))
                            ((k ...) (map car kv))
                            ((s ...) (map ->kw (map car kv)))
                            ((v ...) (map cdr kv)))
               #`(lambda* (#,@as . l)                     
                    (call-with-values (lambda () (get-akw l))
                      (lambda (ww* kw)
-                       (let*-values (((ww* k) (take-1 ww* kw s v))
+                       (let*-values (((ww* k) (take-1 #,(null? ww-) ww* kw s v))
                                      ...)
                          (let ((ww ww*)
                                (kw (pytonize kw)))
index 4fffdabc0a659ab786fdc86a7cf017d051bb69d8..ce96f160540d4f2c304f088150675341615010e5 100644 (file)
@@ -3,20 +3,20 @@
   #:use-module (oop goops)
   #:export (StopIteration GeneratorExit RuntimeError
                           Exception ValueError TypeError
-                          IndexError KeyError
+                          IndexError KeyError AttributeError
                           None))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
-(define StopIteration 'StopIteration)
-(define GeneratorExit 'GeneratorExit)
-(define RuntimeError  'RuntimeError)
-(define IndexError    'IndexError)
-(define ValueError    'ValueError)
-(define None          'None)
-(define KeyError      'KeyError)
-(define TypeError     'TypeError)
-
+(define StopIteration  'StopIteration)
+(define GeneratorExit  'GeneratorExit)
+(define RuntimeError   'RuntimeError)
+(define IndexError     'IndexError)
+(define ValueError     'ValueError)
+(define None           'None)
+(define KeyError       'KeyError)
+(define TypeError      'TypeError)
+(define AttributeError 'AttributeError)
 (define-python-class Exception ()
   (define __init__
     (case-lambda
index 7f0d7e43636580ca7470ba909cd1c76c623b045a..1a3e7c5a69800ed7c0d10764e1ff09ff01e2dd06 100644 (file)
 (define-method (pylist-remove! (o <p>) . l) (apply (ref o 'remove) l))
 
 ;; SORT!
-(define-method (pylist-sort! (o <py-list>) )
-  (let lp ((l (sort (to-list o) <)) (i 0))
-    (if (pair? l)
-        (begin
-          (pylist-set! o i (car l))
-          (lp (cdr l) (+ i 1))))))
+(define (id x) id)
+(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))))))
+   l))
 
 (define-method (pylist-sort! (o <p>) . l) (apply (ref o 'sort) l))
 
           
 (define-python-class list (<py-list>)
   (define  __init__
-    (lambda (self . x)
-      (slot-set! self 'vec (make-vector 30))
-      (slot-set! self 'n   0)
-      (for-each (lambda (x) (pylist-append! self x)) x))))
+    (case-lambda
+      ((self)
+       (slot-set! self 'vec (make-vector 30))
+       (slot-set! self 'n   0))
+      ((self it)
+       (__init__ self)
+       (for ((i : it)) () (pylist-append self i))))))
 
 (define pylist list)
 
index 4159d918677cc68f941087e61a6cb4a263445dec..110ae6b6a113b1a33feabb87c3976138a71024e5 100644 (file)
@@ -1,8 +1,11 @@
 (define-module (language python module python)
   #:use-module (oop goops)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 readline)
   #:use-module ((oop pf-objects) #:select
-                (<p> class-method static-method refq))
+                (<p> <property> class-method static-method refq))
   #:use-module (language python exceptions       )
+  #:use-module (language python def              )
   #:use-module (language python for              )
   #:use-module (language python try              )
   #:use-module (language python yield            )
   #:use-module (language python dir              )
   #:use-module (language python hash             )
 
-  #:replace (list abs)
+  #:replace (list abs min max)
   #:re-export (Exception StopIteration send sendException next
                          GeneratorExit sendClose RuntimeError
-                         len dir next dict)
+                         len dir next dict None)
   #:export (print repr complex float int round
                   set all any bin callable
                   chr classmethod staticmethod
                   divmod enumerate filter format
                   getattr hasattr hash hex isinstance
-                  iter map))
+                  iter map sum id input oct ord pow
+                  property))
+
+(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
 (define print
   (case-lambda
@@ -35,7 +41,6 @@
 
 (define (repr x) (format #f "~a" x))
 (define abs     py-abs)
-(define list    pylist)
 (define string  pystring)
 (define complex py-complex)
 (define float   py-float)
@@ -56,7 +61,7 @@
 (define-method (callable (x <applicable>       )) #t)
 (define-method (callable (x <primitive-generic>)) #t)
 (define-method (callable (x <p>))
-  (ref x '__call__))
+  (refq x '__call__))
                             
 (define chr integer->char)
   
            (if (f x)
                (yield x))))))
 
-(define miss (list 'miss))
+(define miss ((@ (guile) list) 'miss))
 
 (define* (getattr a b #:optional (k miss))
-  (let ((r (ref a (symbol->string b) k)))
+  (let ((r (refq a (symbol->string b) k)))
     (if (eq? r miss)
         (raise AttributeError "object/class ~a is missing attribute ~a" a b)
         r)))
 
 (define (hasattr a b)
-  (let ((r (ref a (symbol->string b) k)))
+  (let ((r (refq a (symbol->string b) miss)))
     (not (eq? r miss))))
   
 (define (isinstance o cl)
   (case-lambda
     ((o) (aif it (wrap-in o)
               it
-              (aif get (ref o '__getitem__)
+              (aif get (refq o '__getitem__)
                    (make-generator iter
                                    (lambda (yield)
-                                     (for () (i 0)
+                                     (for () ((i 0))
                                           (yield (get i))
                                           (+ i 1))))
                    (raise TypeError "not iterable" o))))
                                   (yield r)))))))))
                                
                                       
-       
+
 (define-syntax map
   (lambda (x)
     (syntax-case x ()
              (lambda (yield)
                (for ((x : a) ...) () (yield (f x ...))))))))))
                     
+(define* (sum i #:optional (start 0))
+  (for ((x : i)) ((s start))
+       (+ s x)
+       #:final
+       s))
+
+
+(define (id x) (object-address x))
+
+(define (input str)
+  (format #t str)
+  (readline))
+
+(define (idx x) x)
 
+(def (py-min (* l) (= key idx) (= default miss))
+     (let lp ((l l))
+       (match l
+         ((it)
+          (for ((x : it)) ((s default) (b default))
+               (if (eq? s miss)
+                   (values (key x) x)
+                   (let ((k (key x)))
+                     (if (< k s)
+                         (values k x)
+                         (values s b))))
+               #:final
+               (if (eq? b miss)
+                   (raise ValueError "min does not work for zero length list")
+                   b)))
+         (_ (lp ((@ (guile) list) l))))))
+
+(def (py-max (* l) (= key idx) (= default miss))
+     (let lp ((l l))
+       (match l
+         ((it)
+          (for ((x : it)) ((s default) (b default))
+               (if (eq? default miss)
+                   (values (key x) x)
+                   (let ((k (key x)))
+                     (if (> k s)
+                         (values k x)
+                         (values s b))))
+               #:final
+               (if (eq? b miss)
+                   (raise ValueError "min does not work for zero length list")
+                   b)))
+         (_ (lp ((@ (guile) list) l))))))
+
+(define (oct x) (+ "0o" (number->string (py-index x) 8)))
+(define (ord x) (char->integer (string-ref (pylist-ref x 0) 0)))
+
+(define pow
+  (case-lambda
+    ((x y)
+     (expt x y))
+    ((x y z)
+     (py-mod (expt x y) z))))
+
+(def (property (= getx None) (= setx None) (= delx None))
+     (let ((o (make <property>)))
+       (slot-set! o 'get getx)
+       (slot-set! o 'set setx)
+       (slot-set! o 'del delx)
+       o))
+       
 
+(define min  py-min)
+(define max  py-max)
+(define list pylist)
 
-                             
index 56a50cf6f3d1169b14855fa72f3adcee6ed2c03c..efab4e49e93744eec5e29fa12a3f449921c52cdb 100644 (file)
@@ -8,10 +8,10 @@
   #:export (py-int py-float py-complex
                    py-/ py-logand py-logior py-logxor py-abs py-trunc
                    py-lshift py-rshift py-mod py-floordiv py-round
-                   <py-int> <py-float> <py-complex>
+                   <py-int> <py-float> <py-complex> 
                    py-divmod pyfloat-listing pyint-listing pycomplex-listing
                    py-as-integer-ratio py-conjugate py-fromhex py-hex py-imag
-                   py-is-integer py-real hex py-bin))
+                   py-is-integer py-real hex py-bin py-index))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
 (define-method (py-fromhex     (o <real>))
   (error "1.2.fromhex('0x1.ap4') is not implemented"))
 
-(define-method (py-hex         (o <real>))
-  (error "1.2.hex() is not implemented"))
+(define (py-hex x)
+  (+ "0x" (number->string (py-index x) 16)))
                                
 (define-method (py-is-integer  (o <real>))
   (= 1 (denominator (inexact->exact o))))
   (magnitude o))
 (define-method (py-abs (o <number>))
   (abs o))
-
+(define-method (py-index  (o <integer>)) o)
 (mk-unop u0 py-abs       __abs__)
 (mk-unop u0 py-conjugate conjugate)
 (mk-unop u0 py-imag imag)
 (mk-unop u0 py-numerator   numerator)
 (mk-unop u0 py-as-integer-ratio as_integer_ratio)
 (mk-unop u0 py-fromhex fromhex)
-(mk-unop u0 py-hex hex)
 (mk-unop i0 hex __hex__)
 (mk-unop u0 py-is-integer is_integer)
-
+(mk-unop u0 py-index __index__)
 
 (define-method (write (o <py-float>) . l)
   (apply write (slot-ref o 'x) l))
            (aif it (slot-ref n '__float__)
                 (slot-set! self 'x it)
                 (raise ValueError "could not make float from " n)))))))))
-
   
 (define-python-class py-complex (<py-complex>)
   (define __init__
   (number->string o 2))
 (define-method (py-bin (o <py-int>))
   (number->string (slot-ref o 'x) 2))
-(define-method (py-bin (o <p>))
-  (let ((r (ref o '__index__)))
-    (number->string (r) 2)
-    (raise TypeError "object cannot be interpretted as an index")))
+(define (py-bin o)
+  (+ "0b" (number->string (py-index o) 2)))
 
   
index d916fe88123780bdacf5dfcc0972001fb4c837f6..05f65bef5ea301e06667374d458f6f7e2ac75424 100644 (file)
@@ -2,7 +2,7 @@
   #:use-module (oop goops)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
-  #:export (set ref make-pf <p> <py> <pf> <pyf>
+  #:export (set ref make-pf <p> <py> <pf> <pyf> <property>
                 call with copy fset fcall make-p put put!
                 pcall pcall! get fset-x pyclass? refq
                 def-pf-class  mk-pf-class  make-pf-class
@@ -34,6 +34,8 @@ explicitly tell it to not update etc.
 (define-class <py>  (<p>))
 (define-class <pyf> (<pf>))
 
+(define-class <property> () get set del)
+
 (define (mk x)
   (letrec ((o (make (ref x '__goops__))))
     (slot-set! o 'procedure
@@ -162,17 +164,29 @@ explicitly tell it to not update etc.
 
 (define not-implemented (cons 'not 'implemeneted))
 
+(define-syntax-rule (prop-ref xx x)
+    (let ((r x))
+      (if (is-a? r <property>)
+          ((slot-ref r 'get) xx)
+          r)))
+
 (define-syntax-rule (mrefx-py- x key l)
-  (let ((f (mrefx- x '__getattribute__ '())))
-    (if (or (not f) (eq? f not-implemented))
-        (mrefx- x key l)
-        (apply f x key l))))
+  (let ((xx x))
+    (prop-ref
+     xx
+     (let ((f (mrefx- xx '__getattribute__ '())))
+       (if (or (not f) (eq? f not-implemented))
+           (mrefx- xx key l)
+           (apply f xx key l))))))
 
 (define-syntax-rule (mrefx-py x key l)
-  (let ((f (mrefx x '__getattribute__ '())))
-    (if (or (not f) (eq? f not-implemented))
-        (mrefx    x key l)
-        (apply f x key l))))
+  (let ((xx x))
+    (prop-ref
+     xx
+     (let ((f (mrefx xx '__getattribute__ '())))
+       (if (or (not f) (eq? f not-implemented))
+           (mrefx    xx key l)
+           (apply f xx key l))))))
 
 (define-syntax-rule (unx mrefx- mref-)
   (define-syntax-rule (mref- x key l)
@@ -285,10 +299,13 @@ explicitly tell it to not update etc.
       (values))))
 
 (define-syntax-rule (mset-py- x key val)
-  (let ((f (mref-py- x '__setattr__ '())))
-    (if (or (eq? f not-implemented) (not f))
-        (mset- x key val)
-        (f key val))))
+  (let ((v (mref- x key fail)))
+    (if (or (eq? v fail) (not (is-a? v <property>)))
+        (let ((f (mref-py- x '__setattr__ '())))
+          (if (or (eq? f not-implemented) (not f))
+              (mset- x key val)              
+              (f key val)))
+        ((slot-ref v 'set) x val))))
 
 (define-syntax-rule (mklam (mset a ...) val)
   (if (procedure? val)
@@ -297,10 +314,10 @@ explicitly tell it to not update etc.
           (mset a ... (object-method val)))
       (mset a ... val)))
 
-(define-method (set (x <pf>)  key val) (mset     x key val))
-(define-method (set (x <p>)   key val) (mset-    x key val))
-(define-method (set (x <pyf>) key val) (mset-py  x key val))
-(define-method (set (x <py>)  key val) (mset-py- x key val))
+(define-method (set (x <pf>)  key val) (mklam (mset     x key) val))
+(define-method (set (x <p>)   key val) (mklam (mset-    x key) val))
+(define-method (set (x <pyf>) key val) (mklam (mset-py  x key) val))
+(define-method (set (x <py>)  key val) (mklam (mset-py- x key) val))
 
 ;; mref will reference the value of the key in the object x, an extra default
 ;; parameter will tell what the fail object is else #f if fail