progressively imporoving the conformance with python3
[software/python-on-guile.git] / modules / language / python / module / python.scm
index 4159d918677cc68f941087e61a6cb4a263445dec..ef42cc6a63ec00612376a2574c8773ac80e66b48 100644 (file)
@@ -1,8 +1,15 @@
 (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 ref
+                     py-super-mac type object pylist-ref define-python-class
+                    object-method))
   #:use-module (language python exceptions       )
+  #:use-module ((language python module string   ) #:select ())
+  #:use-module ((language python module io       ) #:select (open))
+  #:use-module (language python def              )
   #:use-module (language python for              )
   #:use-module (language python try              )
   #:use-module (language python yield            )
   #:use-module (language python set              )
   #:use-module (language python compile          )
   #:use-module (language python string           )
+  #:use-module (language python bytes            )
   #:use-module (language python set              )
   #:use-module (language python number           )
   #:use-module (language python dir              )
   #:use-module (language python hash             )
+  #:use-module (language python property         )
+  #:use-module (language python range            )
+  #:use-module (language python tuple            )
+  #:use-module (language python eval             )
+  #:use-module (language python bool             )
 
-  #:replace (list abs)
-  #:re-export (Exception StopIteration send sendException next
-                         GeneratorExit sendClose RuntimeError
-                         len dir next dict)
-  #: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))
+  #:replace (list abs min max hash round format map)
+  
+  #:re-export (StopIteration GeneratorExit RuntimeError
+                             Exception ValueError TypeError
+                             IndexError KeyError AttributeError
+                             send sendException next
+                             GeneratorExit sendClose RuntimeError
+                             SyntaxError bool
+                             len dir next dict None property range
+                             tuple bytes bytearray eval locals globals
+                             compile exec type object open
+                             )
+  
+  #:export (print repr complex float int str
+                  set all any bin callable reversed
+                  chr classmethod staticmethod objectmethod
+                  divmod enumerate filter
+                  getattr hasattr setattr hex isinstance issubclass
+                  iter sum id input oct ord pow super
+                  sorted zip
+                 ClassMethod StaticMethod Funcobj))
+
+(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
 (define print
   (case-lambda
-    (()  (format #t "~%"))
-    ((x) (format #t "~s~%" x))
-    (l   (format #t "~s~%" l))))
+    (()  ((@ (guile) format) #t "~%"))
+    ((x) ((@ (guile) format) #t "~s~%" x))
+    (l   ((@ (guile) format) #t "~s~%" l))))
 
-(define (repr x) (format #f "~a" x))
+(define (repr x) ((@ (guile) format) #f "~a" x))
 (define abs     py-abs)
-(define list    pylist)
-(define string  pystring)
+(define str     pystring)
 (define complex py-complex)
 (define float   py-float)
 (define int     py-int)
 (define-method (callable (x <primitive-generic>)) #t)
 (define-method (callable (x <p>))
   (ref x '__call__))
-                            
+
 (define chr integer->char)
-  
+
+(define objectmethod object-method)
 (define classmethod  class-method)
 (define staticmethod static-method)
 
 (define (enumerate l)
-  (make-generator enumerate
+  ((make-generator ()
     (lambda (yield)
-      (for ((x : l)) ((i 0))
-           (yield i x)
-           (+ i 1)))))
+       (for ((x : l)) ((i 0))
+            (yield i x)
+           (+ i 1))))))
 
 (define (filter f l)
-  (make-generator enumerate
-    (lambda (yield)
-      (for ((x : l)) ()
-           (if (f x)
-               (yield x))))))
+  ((make-generator ()
+     (lambda (yield)
+       (for ((x : l)) ()
+            (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 (ref a (if (string? b) (string->symbol b) b) k)))
     (if (eq? r miss)
         (raise AttributeError "object/class ~a is missing attribute ~a" a b)
         r)))
 
+(define (setattr a k v)
+  (set a (if (string? k) (string->symbol k) k) v))
+
 (define (hasattr a b)
-  (let ((r (ref a (symbol->string b) k)))
+  (let ((r (ref a (symbol->string b) miss)))
     (not (eq? r miss))))
+
+(define-method (issubclass x y) #f)
+(define-method (issubclass (sub <p>) (cls <p>))
+  (aif it (ref cls '__subclasscheck__)
+       (it cls sub)
+       (if (eq? sub cls)
+          #t
+          (is-a? (ref sub '__goops__) (ref cls '__goops__)))))
+
+(define-method (isinstance x y)
+  (if (null? y)
+      #f
+      (if (pair? y)
+         (or (isinstance x (car y))
+             (isinstance x (cdr y)))
+         (is-a? x y))))
+
+(define-method (isinstance (i <integer>) y)
+  (if (issubclass y int)
+      #t
+      (if (pair? y)
+         (or (isinstance i (car y))
+             (isinstance i (cdr y)))
+         (is-a? i y))))
+
+(define-method (isinstance (i <real>) y)
+  (if (issubclass y float)
+      #t
+      (if (pair? y)
+         (or (isinstance i (car y))
+             (isinstance i (cdr y)))
+         (is-a? i y))))
+
+(define-method (isinstance (i <pair>) y)
+  (if (issubclass y tuple)
+      #t
+      (if (pair? y)
+         (or (isinstance i (car y))
+             (isinstance i (cdr y)))
+         (is-a? i y))))
+
+(define-method (isinstance (i <string>) y)
+  (if (issubclass y str)
+      #t
+      (if (pair? y)
+         (or (isinstance i (car y))
+             (isinstance i (cdr y)))
+         (is-a? i y))))
+
+(define-method (isinstance (i <bytevector>) y)
+  (if (issubclass y bytes)
+      #t
+      (if (pair? y)
+         (or (isinstance i (car y))
+             (isinstance i (cdr y)))
+         (is-a? i y))))
+
+
+(define-method (isinstance o (cl <p>))
+  (cond
+   ((eq? cl py-list)
+    (is-a? o <py-list>))
+   (else #f)))
   
-(define (isinstance o cl)
-  (if (pair? cl)
-      (or
-       (isinstance o (car cl))
-       (isinstance o (cdr cl)))
-      (is-a? o cl)))
+(define-method (isinstance (o <p>) (cl <p>))
+  (cond
+   ((ref cl '__instancecheck__) =>
+    (lambda (it)
+      (it o)))
+   ((pair? cl)
+    (or
+     (isinstance o (car cl))
+     (isinstance o (cdr cl))))
+   (else
+    (is-a? o (ref cl '__goops__)))))
+              
+              
 
 (define iter
   (case-lambda
               (aif get (ref 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 ()
       ((map f a ...)
        (with-syntax (((x ...) (generate-temporaries #'(a ...))))
-         #'(make-generator map
-             (lambda (yield)
-               (for ((x : a) ...) () (yield (f x ...))))))))))
+        #'(for ((x : a) ...) ((l '()))
+           (cons (f x ...) l)
+           #:final (py-list (reverse l))))))))
                     
+(define* (sum i #:optional (start 0))
+  (for ((x : i)) ((s start))
+       (+ s x)
+       #:final
+       s))
+
+
+(define (id x) (object-address x))
+
+(define (input str)
+  ((@ (guile) 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 miss) (b miss))
+               (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)
+                  (if (eq? default miss)
+                      (raise ValueError
+                             "min does not work for zero length list")
+                      default)
+                   b)))
+         (_ (lp ((@ (guile) list) l))))))
 
+(def (py-max (* l) (= key idx) (= default miss))
+     (let lp ((l l))
+       (match l
+         ((it)
+          (for ((x : it)) ((s miss) (b miss))
+               (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)
+                  (if (eq? default miss)
+                      (raise ValueError
+                             "min does not work for zero length list")
+                      default)
+                   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))))
+
+(define-syntax-rule (super . l) (py-super-mac . l))       
+
+(define min  py-min)
+(define max  py-max)
+(define list pylist)
+(define reversed py-reversed)
+(define (key-id x) x)
+(define* (sorted it #:key (key key-id) (reverse #f))
+  (define l (to-pylist '()))
+  (for ((x : it)) () (pylist-append! l x))
+  (pylist-sort! l #:key key #:reverse reverse)
+  l)
+
+(define (zip . l)
+  (let ((l ((@ (guile) map) wrap-in l)))
+    ((make-generator ()
+      (lambda (yield)
+        (let lp ()
+          (let lp2 ((l l) (r '()))
+            (if (pair? l)
+                (call-with-values (lambda () (next (car l)))
+                  (lambda z
+                    (lp2 (cdr l) (append (reverse z) r))))
+                (begin
+                  (yield (reverse r))
+                  (lp))))))))))
+
+(define-python-class ClassMethod  ())
+(define-python-class StaticMethod ())
+(define-python-class Funcobj      ())
+     
+           
+     
+
+