Merge branch 'master' of gitlab.com:python-on-guile/python-on-guile

1 files changed, 21 insertions, 338 deletions

diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm
index 3601c2f..3ae04e7 100644
--- a/modules/language/python/module/python.scm
+++ b/modules/language/python/module/python.scm
@@ -1,338 +1,21 @@
-(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> <property> class-method static-method ref (set . pf-set)
-                     py-super-mac type object pylist-ref define-python-class
-		     object-method py-dict))
-  #: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 list             )
-  #:use-module (language python dict             )
-  #: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 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 vars
-		  ClassMethod StaticMethod Funcobj))
-
-(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
-
-(define vars py-dict)
-
-(define print
-  (case-lambda
-    (()  ((@ (guile) format) #t "~%"))
-    ((x) ((@ (guile) format) #t "~s~%" x))
-    (l   ((@ (guile) format) #t "~s~%" l))))
-
-(define (repr x) ((@ (guile) format) #f "~a" x))
-(define abs     py-abs)
-(define str     pystring)
-(define complex py-complex)
-(define float   py-float)
-(define int     py-int)
-(define round   py-round)
-(define set     py-set)
-(define all     py-all)
-(define any     py-any)
-(define bin     py-bin)
-(define divmod  py-divmod)
-(define format  py-format)
-(define hash    py-hash)
-(define hex     py-hex)
-
-(define-method (callable  x                     ) #f)
-(define-method (callable (x <procedure>        )) #t)
-(define-method (callable (x <procedure-class>  )) #t)
-(define-method (callable (x <applicable>       )) #t)
-(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 ()
-    (lambda (yield)
-       (for ((x : l)) ((i 0))
-            (yield i x)
-           (+ i 1))))))
-
-(define (filter f l)
-  ((make-generator ()
-     (lambda (yield)
-       (for ((x : l)) ()
-            (if (f x)
-                (yield x)))))))
-
-(define miss ((@ (guile) list) 'miss))
-
-(define* (getattr a b #:optional (k miss))
-  (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)
-  (pf-set a (if (string? k) (string->symbol k) k) v))
-
-(define (hasattr a b)
-  (let ((r (ref a (if (string? b) (string->symbol b) 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
-	   (if (memq cls (ref sub '__mro__))
-               #t
-               #f))))
-
-(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-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
-    ((o) (aif it (wrap-in o)
-              it
-              (aif get (ref o '__getitem__)
-                   (make-generator iter
-                                   (lambda (yield)
-                                     (for () ((i 0))
-                                          (yield (get i))
-                                          (+ i 1))))
-                   (raise TypeError "not iterable" o))))
-    ((f sent)
-     (make-generator iter
-                     (lambda (yield)
-                       (for () ()
-                            (let ((r (f)))
-                              (if (equal? r sent)
-                                  (break)
-                                  (yield r)))))))))
-                               
-                                      
-
-(define-syntax map
-  (lambda (x)
-    (syntax-case x ()
-      ((map f a ...)
-       (with-syntax (((x ...) (generate-temporaries #'(a ...))))
-	 #'(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      ())
-     
-(define-method (py-mod (s <string>) l)
-  (let* ((s (py-replace s "%s" "~a"))
-         (s (py-replace s "%r" "~a"))
-         (l (for ((x : l)) ((r '()))
-                 (cons x r)
-                 #:final (reverse r))))
-    (apply (@ (guile) format) #f s l)))
-           
-
-  
+(define-module (language python module python )
+  #:use-module (language python module _python)
+  #:use-module (language python compile       )
+  #:use-module ((language python format2) #:select ()))
+
+(define-syntax re-export-all
+  (syntax-rules ()
+    [(_ iface)
+     (module-for-each 
+      (lambda (name . l)
+        (module-re-export! (current-module) ((@ (guile) list) name)))
+      (resolve-interface 'iface))]
+    [(_ iface _ li)
+     (let ((l 'li))
+       (module-for-each 
+        (lambda (name . l)        
+          (if (not (member name l))
+              (module-re-export! (current-module) ((@ (guile) list) name))))
+        (resolve-interface 'iface)))]))
+
+(re-export-all (language python module _python))