From 596eebc8eea930e964114defa57ac39e42c2a605 Mon Sep 17 00:00:00 2001
From: Stefan Israelsson Tampe <stefan.itampe@gmail.com>
Date: Wed, 4 Oct 2017 20:03:43 +0200
Subject: property values

---
 modules/language/python/module/python.scm | 98 +++++++++++++++++++++++++++----
 1 file changed, 85 insertions(+), 13 deletions(-)

(limited to 'modules/language/python/module')

diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm
index 4159d91..110ae6b 100644
--- a/modules/language/python/module/python.scm
+++ b/modules/language/python/module/python.scm
@@ -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            )
@@ -16,16 +19,19 @@
   #: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)
   
@@ -77,16 +82,16 @@
            (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)
@@ -100,10 +105,10 @@
   (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))))
@@ -117,7 +122,7 @@
                                   (yield r)))))))))
                                
                                       
-       
+
 (define-syntax map
   (lambda (x)
     (syntax-case x ()
@@ -127,7 +132,74 @@
              (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)
 
-                             
-- 
cgit v1.2.3