more pythonic number system

3 files changed, 299 insertions, 41 deletions

diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index 610546f..4de9ac6 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -10,6 +10,7 @@
   #:use-module (language python try)
   #:use-module (language python list)
   #:use-module (language python string)
+  #:use-module (language python number)
   #:use-module (language python def)
   #:use-module (ice-9 pretty-print)
   #:export (comp))
@@ -17,7 +18,7 @@
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
 (define-inlinable (C  x) `(@@ (language python compile) ,x))
-(define-inlinable (N  x) `(@@ (language python numeric) ,x))
+(define-inlinable (N  x) `(@@ (language python number)  ,x))
 (define-inlinable (Y  x) `(@@ (language python yield)   ,x))
 (define-inlinable (T  x) `(@@ (language python try)     ,x))
 (define-inlinable (F  x) `(@@ (language python for)     ,x))
@@ -32,8 +33,6 @@
 (define-inlinable (G  x) `(@  (guile)                   ,x))
 (define-inlinable (H  x) `(@  (language python hash)    ,x))
 
-
-
 (define s/d 'set!)
 
 (define-syntax clear-warning-data
@@ -240,15 +239,34 @@
    ((__close__)     (Y 'sendClose))
    
    ;; Numerics
-   ((__add__ )    (N '+))
-   ((__radd__)    (N 'r+))
-   ((__mul__ )    (N '+))
-   ((__rmul__)    (N 'r*))
-   ((__le__  )    (N '<))
-   ((__lt__  )    (N '<=))
-   ((__ge__  )    (N '>))
-   ((__gt__  )    (N '>=))
-      
+   ((__add__ )     (N '+))
+   ((__mul__ )     (N '*))
+   ((__sub__ )     (N '-))
+   ((__radd__ )    (N 'r+))
+   ((__rmul__ )    (N 'r*))
+   ((__rsub__ )    (N 'r-))
+   ((__neg__ )     (N '-))
+   ((__le__  )     (N '<))
+   ((__lt__  )     (N '<=))
+   ((__ge__  )     (N '>))
+   ((__gt__  )     (N '>=))
+   ((__abs__ )     (N 'py-abs))
+   ((__pow__ )     (N 'expt))
+   ((__rpow__ )    (N 'rexpt))
+   ((__truediv__)  (N 'py-/))
+   ((__rtruediv__) (N 'py-r/))
+   ((__and__)      (N 'py-logand))   
+   ((__or__)       (N 'py-logior))
+   ((__xor__)      (N 'py-logxor))
+   ((__rand__)     (N 'py-rlogand))   
+   ((__ror__)      (N 'py-rlogior))
+   ((__rxor__)     (N 'py-rlogxor))
+   ((__divmod__)   (N 'py-divmod))
+   ((__rdivmod__)  (N 'py-rdivmod))
+   ((__invert__)   (N 'py-lognot))
+   ((__int__)      (N 'mk-int))
+   ((__float__)    (N 'mk-float))
+   
    ;; Lists
    ((append)       (L 'pylist-append!))
    ((count)        (L 'pylist-count))
@@ -428,10 +446,11 @@
       ("//="  'floor-quotient)))
   
   (match x
-    ((#:test (#:power kind (#:identifier v . _) addings . _) . _)
-     (let* ((v.add   (if (is-prefix? (string->symbol v))
+    ((#:test (#:power kind v addings . _) . _)
+     (let* ((v       (exp vs v))
+            (v.add   (if (is-prefix? v)
                          (let ((w (symbol->string (exp vs (car addings)))))
-                           (cons (string-append v "." w)
+                           (cons (string-append (symbol->string v) "." w)
                                  (cdr addings)))
                          (cons v addings)))
             (v       (car v.add))
@@ -439,30 +458,28 @@
             (addings (get-addings vs addings)))
        (define q (lambda (x) `',x))
        (if kind
-           (let ((v (string->symbol v)))
-             (if (null? addings)                   
-                 (if op
-                     `(,s/d ,v (,(tr-op op) ,v ,u))
-                     `(,s/d ,v ,u))
-                 (if op
-                     `(,s/d ,(exp vs kind)
-                            (,(O 'fset-x) ,v (list ,@(map q addings))
-                             (,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u)))
+           (if (null? addings)                   
+               (if op
+                   `(,s/d ,v (,(tr-op op) ,v ,u))
+                   `(,s/d ,v ,u))
+               (if op
+                   `(,s/d ,(exp vs kind)
+                          (,(O 'fset-x) ,v (list ,@(map q addings))
+                           (,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u)))
                      
-                     `(,s/d ,(exp vs kind)
-                            (,(O 'fset-x) ,v (list ,@(map q addings)) ,u)))))
+                   `(,s/d ,(exp vs kind)
+                          (,(O 'fset-x) ,v (list ,@(map q addings)) ,u))))
            
-           (let ((v (string->symbol v)))
-             (if (null? addings)
-                 (if op
-                     `(,s/d ,v (,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u))
-                     `(,s/d ,v ,u))
-                 `(,(C 'set-x)
-                   ,v
-                   ,addings
-                   ,(if op
-                        `(,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u)
-                        u)))))))))
+           (if (null? addings)
+               (if op
+                   `(,s/d ,v (,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u))
+                   `(,s/d ,v ,u))
+               `(,(C 'set-x)
+                 ,v
+                 ,addings
+                 ,(if op
+                      `(,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u)
+                      u))))))))
   
 (define is-class? (make-fluid #f))
 (define (gen-yargs vs x)
@@ -528,7 +545,7 @@
    (cons '* (map (g vs exp) l))))
  (#:/
   ((_ . l)
-   (cons '/ (map (g vs exp) l))))
+   (cons (N 'py-/) (map (g vs exp) l))))
 
  (#:%
   ((_ . l)
diff --git a/modules/language/python/dir.scm b/modules/language/python/dir.scm
index 36b4f02..a1c77c9 100644
--- a/modules/language/python/dir.scm
+++ b/modules/language/python/dir.scm
@@ -3,6 +3,7 @@
   #:use-module (language python for)
   #:use-module (language python dict)
   #:use-module (language python string)
+  #:use-module (language python number)
   #:use-module (oop goops)
   #:use-module (ice-9 vlist)
   #:use-module (oop pf-objects)
@@ -85,7 +86,7 @@
 (define-method (dir (o <py-list>))
   (let ((l1 (pylist-listing)))
     (if (is-a? o <p>)
-        (let* ((l2 (pk (next-method)))
+        (let* ((l2 (next-method))
                (l  (+ l1 l2)))
           (pylist-sort! l)
           l)
@@ -94,7 +95,7 @@
 (define-method (dir (o <py-hashtable>))
   (let ((l1 (pyhash-listing)))
     (if (is-a? o <p>)
-        (let* ((l2 (pk (next-method)))
+        (let* ((l2 (next-method))
                (l  (+ l1 l2)))
           (pylist-sort! l)
           l)
@@ -103,7 +104,25 @@
 (define-method (dir (o <py-string>))
   (let ((l1 (pystring-listing)))
     (if (is-a? o <p>)
-        (let* ((l2 (pk (next-method)))
+        (let* ((l2 (next-method))
+               (l  (+ l1 l2)))
+          (pylist-sort! l)
+          l)
+        l1)))
+
+(define-method (dir (o <py-int>))
+  (let ((l1 (pyint-listing)))
+    (if (is-a? o <p>)
+        (let* ((l2 (next-method))
+               (l  (+ l1 l2)))
+          (pylist-sort! l)
+          l)
+        l1)))
+
+(define-method (dir (o <py-float>))
+  (let ((l1 (pyfloat-listing)))
+    (if (is-a? o <p>)
+        (let* ((l2 (next-method))
                (l  (+ l1 l2)))
           (pylist-sort! l)
           l)
@@ -112,6 +131,10 @@
     
 (define-method (dir (o <hashtable>   )) (pyhash-listing))
 (define-method (dir (o <string>      )) (pystring-listing))
+(define-method (dir (o <complex>     ))
+  (if (integer? o)
+      (pyint-listing)
+      (pyfloat-listing)))
 
 (define-method (dir)
   (let ((l '()))
diff --git a/modules/language/python/number.scm b/modules/language/python/number.scm
new file mode 100644
index 0000000..cb4de5e
--- /dev/null
+++ b/modules/language/python/number.scm
@@ -0,0 +1,218 @@
+(define-module (language python number)
+  #:use-module (oop pf-objects)
+  #:use-module (oop goops)
+  #:use-module (language python hash)
+  #:use-module (language python list)
+  #:use-module (language python try)
+  #:use-module (language python exceptions)
+  #:export (py-int py-float py-/ py-logand py-logior py-logxor py-abs
+                   <py-int> <py-float>
+                   py-divmod pyfloat-listing pyint-listing))
+
+(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
+
+(define-class <py-int>   () x)
+(define-class <py-float> () x)
+
+(define-syntax-rule (b0 op)
+  (begin
+    (define-method (op (o1 <py-int>) o2)
+      (op (slot-ref o1 'x) o2))    
+    (define-method (op (o1 <py-float>) o2)
+      (op (slot-ref o1 'x) o2))
+    (define-method (op o2 (o1 <py-int>))
+      (op (slot-ref o1 'x) o2))    
+    (define-method (op o2 (o1 <py-float>))
+      (op (slot-ref o1 'x) o2))))
+
+(define-syntax-rule (mk-biop1 mk-biop0 op r1)
+  (begin
+    (mk-biop0 op)
+    (define-method (op v (o <p>))
+      (aif it (ref o 'r2)
+           (it v)
+           (next-method)))))
+
+(define-syntax-rule (mk-biop2 mk-biop0 rop op r1 r2)
+  (begin
+    (define-syntax-rule (rop x y) (op y x))
+    (mk-biop1 mk-biop0 op r1)
+    (define-method (op v (o <p>))
+      (aif it (ref o 'r2)
+           (it v)
+           (next-method)))))
+
+(define-syntax-rule (i0 op)
+  (begin
+    (define-method (op (o1 <py-int>) o2)
+      (op (slot-ref o1 'x) o2))    
+    (define-method (op o2 (o1 <py-int>))
+      (op o2 (slot-ref o1 'x)))))
+
+(mk-biop2 b0 r+ + __add__ __radd__)
+(mk-biop2 b0 r- - __sub__ __rsub__)
+(mk-biop2 b0 r* * __mul__ __rmul__)
+
+(mk-biop1 b0 <  __le__)
+(mk-biop1 b0 >  __ge__)
+(mk-biop1 b0 <= __lt__)
+(mk-biop1 b0 >= __gt__)
+(mk-biop2 b0 rexpt expt __pow__ __rpow__)
+(b0 equal?)
+
+(define-method (py-logand (o1 <integer>) (o2 <integer>))
+  (logand o1 o2))
+(define-method (py-logior (o1 <integer>) (o2 <integer>))
+  (logior o1 o2))
+(define-method (py-logxor (o1 <integer>) (o2 <integer>))
+  (logxor o1 o2))
+(define-method (py-lognot (o1 <integer>))
+  (lognot o1))
+
+
+(define-method (py-/ (o1 <number>) (o2 <integer>))
+  (/ o1 (exact->inexact o2)))
+(define-method (py-/ (o1 <number>) (o2 <number>))
+  (/ o1 o2))
+
+(define-method (py-divmod (o1 <integer>) (o2 <integer>))
+  (values
+   (floor-quotient o1 o2)
+   (modulo o1 o2)))
+
+(define-method (py-divmod (o1 <number>) (o2 <number>))
+  (values
+   (floor-quotient o1 o2)
+   (modulo o1 o2)))
+
+
+(mk-biop2 b0 py-rdivmod py-divmod __divmod__  __rdivmod__)
+(mk-biop2 b0 py-r/      py-/      __truediv__ __rtruediv__)
+
+(mk-biop2 i0 py-rlogand py-logand __and__ __rand__)
+(mk-biop2 i0 py-rlogior py-logior __or__  __ror__)
+(mk-biop2 i0 py-rlogxor py-logxor __xor__ __rxor__)
+
+(define-method (py-abs (o <number>)) (abs o))
+(define-method (py-floor (o1 <integer>)) o1)
+(define-method (py-floor (o1 <number> )) )
+(define-method (py-float (o1 <integer>)) (exact->inexact o1))
+(define-method (py-float (o1 <number> )) o1)
+
+(define-syntax-rule (u0 f)
+  (begin
+    (define-method (f (o <py-int>  )) (f (slot-ref o 'x)))
+    (define-method (f (o <py-float>)) (f (slot-ref o 'x)))))
+
+(define-syntax-rule (i0 f)
+  (begin
+    (define-method (f (o <py-int>  )) (f (slot-ref o 'x)))))
+
+(define-syntax-rule (mk-unop u0 f r)
+  (begin
+    (u0 f)
+    (define-method (f (o <p>))
+      ((ref o 'r)))))
+
+(u0 py-hash )
+(mk-unop u0 -         __neg__   )
+(mk-unop u0 py-abs    __abs__   )
+(mk-unop u0 py-floor  __floor__ )
+(mk-unop i0 py-lognot __invert__)
+
+(define-method (write (o <py-float>) . l)
+  (apply write (slot-ref o 'x) l))
+(define-method (write (o <py-int>) . l)
+  (apply write (slot-ref o 'x) l))
+          
+(define-python-class int (<py-int>)
+  (define __init__
+    (case-lambda
+      ((self)
+       (__init__ self 0))
+      
+      ((self n)
+       (let lp ((n n))
+         (cond
+          ((and (number? n) (integer? n))
+           (slot-set! self 'x n))
+          ((number? n)
+           (lp (py-floor n)))
+          ((string? n)
+           (lp (string->number n)))
+          (else
+           (aif it (slot-ref n '__int__)
+                (slot-set! self 'x it)
+                (raise ValueError "could not make int from " n))))))
+      
+      ((self n k)
+       (__init__ self (string->number n k))))))
+
+(define-python-class float (<py-float>)
+  (define __init__
+    (case-lambda
+      ((self n)
+       (let lp ((n n))
+         (cond
+          ((number? n)
+           (slot-set! self 'x n))
+          ((string? n)
+           (lp (string->number n)))
+          (else
+           (aif it (slot-ref n '__float__)
+                (slot-set! self 'x it)
+                (raise ValueError "could not make int from " n)))))))))
+
+(define-method (py-class (o <integer>    )) int)
+(define-method (py-class (o <real>       )) float)
+(u0 py-class)
+           
+(define py-int   int)
+(define py-float float)
+
+(define-method (mk-int   (o <number>)) (slot-ref (py-int o)   'x))
+(define-method (mk-float (o <number>)) (slot-ref (py-float o) 'x))
+
+(mk-unop u0 mk-int   __int__)
+(mk-unop u0 mk-float __float__)
+
+(define (pyint-listing)
+  (let ((l
+         (pk (to-pylist
+          (pk (map symbol->string
+               '(__abs__ __add__ __and__ __class__ __cmp__ __coerce__
+                         __delattr__ __div__ __divmod__ __doc__ __float__
+                         __floordiv__ __format__ __getattribute__
+                         __getnewargs__ __hash__ __hex__ __index__ __init__
+                         __int__ __invert__ __long__ __lshift__ __mod__
+                         __mul__ __neg__ __new__ __nonzero__ __oct__ __or__
+                         __pos__ __pow__ __radd__ __rand__ __rdiv__
+                         __rdivmod__ __reduce__ __reduce_ex__ __repr__
+                         __rfloordiv__ __rlshift__ __rmod__ __rmul__ __ror__
+                         __rpow__ __rrshift__ __rshift__ __rsub__ __rtruediv__
+                         __rxor__ __setattr__ __sizeof__ __str__ __sub__
+                         __subclasshook__ __truediv__ __trunc__ __xor__
+                         bit_length conjugate denominator imag numerator
+                         real)))))))
+    (pylist-sort! l)
+    l))
+
+(define (pyfloat-listing)
+  (let ((l
+         (to-pylist
+          (map symbol->string
+               '(__abs__ __add__ __class__ __coerce__ __delattr__ __div__
+                         __divmod__ __doc__ __eq__ __float__ __floordiv__
+                         __format__ __ge__ __getattribute__ __getformat__
+                         __getnewargs__ __gt__ __hash__ __init__ __int__
+                         __le__ __long__ __lt__ __mod__ __mul__ __ne__
+                         __neg__ __new__ __nonzero__ __pos__ __pow__
+                         __radd__ __rdiv__ __rdivmod__ __reduce__
+                         __reduce_ex__ __repr__ __rfloordiv__ __rmod__
+                         __rmul__ __rpow__ __rsub__ __rtruediv__
+                         __setattr__ __setformat__ __sizeof__ __str__
+                         __sub__ __subclasshook__ __truediv__ __trunc__
+                         as_integer_ratio conjugate fromhex hex imag
+                         is_integer real)))))
+    (pylist-sort! l)
+    l))