(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)
  #:use-module (language python persist)
  #: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-iadd
		   py-lognot py-matmul
                   <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-index
		   py-ifloordiv py-ilshift py-imod py-imul py-imatmul
		   py-ilogior py-ilogand py-ipow py-isub py-i/
		   py-irshift py-ilogxor))

(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))

(define-syntax-rule (mki py-iadd __iadd__)
  (define (py-iadd x y)
    ((ref x '__iadd__) y)))

(mki py-iadd __iadd__)

(mki py-matmul    __matmul__)
(mki py-ifloordiv __ifloordiv__)
(mki py-ilshift   __ilshift__)
(mki py-imod      __imod__)
(mki py-imul      __imul__)
(mki py-imatmul   __imatmul__)
(mki py-ilogior   __ior__)
(mki py-ilogand   __iand__)
(mki py-ipow      __ipow__)
(mki py-isub      __isub__)
(mki py-irshift   __irshift__)
(mki py-ilogxor   __ixor__)
(mki py-i/        __itruediv__)


(define-class <py-int>     () x)
(define-class <py-float>   () x)
(define-class <py-complex> () x)

(name-object <py-int>)
(name-object <py-float>)
(name-object <py-complex>)

(define-syntax-rule (mk <py-int>)
  (cpit <py-int> (o (lambda (o x) (slot-set! o 'x x)) (list (slot-ref o 'x)))))

(mk <py-int>)
(mk <py-float>)
(mk <py-complex>)

(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 (o1 <py-complex>) o2)
      (op (slot-ref o1 'x) o2))
    (define-method (op o2 (o1 <py-int>))
      (op o2 (slot-ref o1 'x)))    
    (define-method (op o2 (o1 <py-complex>))
      (op o2 (slot-ref o1 'x)))
    (define-method (op o2 (o1 <py-float>))
      (op o2 (slot-ref o1 'x)))))

(define-syntax-rule (mk-biop1 mk-biop0 op r1)
  (begin
    (mk-biop0 op)
    (define-method (op (o <p>) v)
      (aif it (ref o 'r1)
           (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 py-equal?)


(define-method (py-lshift (o1 <integer>) (o2 <integer>))
  (ash o1 o2))
(define-method (py-rshift (o1 <integer>) (o2 <integer>))
  (ash o1 (- o2)))

(mk-biop2 i0 py-rlshift py-lshift __lshift__ __rlshift__)
(mk-biop2 i0 py-rrshift py-rshift __rshift__ __rrshift__)

(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-logand o1 (o2 <py-int>))
  (py-logand o1 (slot-ref o2 'x)))

(define-method (py-logand (o1 <py-int>) o2)
  (py-logand (slot-ref o1 'x) o2))

(define-method (py-logior o1 (o2 <py-int>))
  (py-logior o1 (slot-ref o2 'x)))

(define-method (py-logior (o1 <py-int>) o2)
  (py-logior (slot-ref o1 'x) o2))

(define-method (py-logxor o1 (o2 <py-int>))
  (py-logxor o1 (slot-ref o2 'x)))

(define-method (py-logxor (o1 <py-int>) o2)
  (py-logxor (slot-ref o1 'x) o2))

(define-method (py-lognot (o1 <py-int>))
  (lognot (slot-ref o1 'x)))

(define-method (py-logand (o1 <p>) o2)
  (aif it (ref o1 '__and__)
       (it o2)
       (next-method)))

(define-method (py-logand o1 (o2 <p>))
  (aif it (ref o1 '__rand__)
       (it o2)
       (next-method)))

(define-method (py-logior (o1 <p>) o2)
  (aif it (ref o1 '__or__)
       (it o2)
       (next-method)))

(define-method (py-logior o1 (o2 <p>))
  (aif it (ref o1 '__ror__)
       (it o2)
       (next-method)))

(define-method (py-logxor (o1 <p>) o2)
  (aif it (ref o1 '__xor__)
       (it o2)
       (next-method)))

(define-method (py-logxor o1 (o2 <p>))
  (aif it (ref o1 '__rxor__)
       (it o2)
       (next-method)))

(define-method (py-lognot (o1 <p>))
  (aif it (ref o1 '__not__)
       (it)
       (next-method)))


(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)
   (floor-remainder o1 o2)))

(define-method (py-floordiv (o1 <number>) (o2 <number>))
  (floor-quotient o1 o2))

(mk-biop2 b0 py-rfloordiv py-floordiv __floordiv__ __rfloordiv__)
(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-mod (o1 <integer>) (o2 <integer>))
  (modulo o1 o2))
(define-method (py-mod (o1 <real>)    (o2 <real>))
  (floor-remainder o1 o2))

(mk-biop2 i0 py-rmod py-mod __mod__ __rmod__)


(define-method (py-floor (o1 <integer>)) o1)
(define-method (py-floor (o1 <number> )) )
(define-method (py-trunc (o1 <integer>)) (exact->inexact o1))
(define-method (py-trunc (o1 <number> ))
  (floor 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-method (f (o <py-complex>)) (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-trunc  __trunc__ )
(mk-unop i0 py-lognot __invert__)

(define-method (py-bit-length (i <integer>))
  (logcount i))

(define-method (py-conjugate (i <complex>))
  (make-rectangular (real-part i) (- (imag-part i))))
(define-method (py-conjugate (i <number>)) i)

(define-method (py-imag (i <complex>)) (imag-part i))
(define-method (py-imag (i <number>)) i)

(define-method (py-real (i <complex>)) (real-part i))
(define-method (py-real (i <number>)) i)

(define-method (py-denominator (o <integer>)) 0)
(define-method (py-denominator (o <real>))
  (denominator (inexact->exact o)))

(define-method (py-numerator (o <integer>)) o)
(define-method (py-numerator (o <real>   ))
  (numerator (inexact->exact o)))

(define-method (py-as-integer-ratio (o <integer>))
  (list o 0))
(define-method (py-as-integer-ratio (o <real>))
  (let ((r (inexact->exact o)))
    (list (numerator r) (denominator r))))

(define-method (py-fromhex     (o <real>))
  (error "1.2.fromhex('0x1.ap4') 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))))
(define-method (py-is-integer  (o <integer>)) #t)

(define-method (hex (o <integer>))
  (+ "0x" (number->string o 16)))

(define-method (py-abs (o <complex>))
  (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-real real)
(mk-unop u0 py-denominator denominator)
(mk-unop u0 py-numerator   numerator)
(mk-unop u0 py-as-integer-ratio as_integer_ratio)
(mk-unop u0 py-fromhex fromhex)
(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))
(define-method (write (o <py-int>) . l)
  (apply write (slot-ref o 'x) l))

(define-python-class int (<py> <py-int>)
  (define __init__
    (letrec ((__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))))))
      __init__)))

(name-object int)

(define (proj? x)
  (if (number? x)
      x
      (and
       (or (is-a? x <py-complex>)
           (is-a? x <py-int>)
           (is-a? x <py-float>))
       (slot-ref x 'x))))

(define (projc? x)
  (if (number? x)
      (if (not (complex? x))
          x
          #f)
      (and
       (or (is-a? x <py-complex>)
           (is-a? x <py-int>)
           (is-a? x <py-float>))
       (let ((ret (slot-ref x 'x)))
         (if (not (complex? ret))
             ret
             #f)))))

(define-python-class float (<py> <py-float>)
  (define __init__
    (case-lambda
      ((self n)
       (let lp ((n n))
         (cond
          ((projc? n) =>
           (lambda (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 float from " n)))))))))

(name-object float)

(define-python-class py-complex (<py> <py-complex>)
  (define __init__
    (case-lambda
      ((self n)
       (cond
        ((proj? n) =>
         (lambda (n)
           (slot-set! self 'x n)))
        (else
         (raise ValueError "could not make complex from " n))))
      ((self n m)
       (cond
        ((projc? n) =>
         (lambda (n)        
           (cond
            ((projc? m)
             (lambda (m)
               (slot-set! self 'x (make-rectangular n m))))
            (else
             (raise ValueError "could not make complex from " n m)))))
        (else
         (raise ValueError "could not make complex from " n m)))))))

(name-object py-complex)

(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
         (to-pylist
          (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))

(define (pycomplex-listing)
  (let ((l
         (to-pylist
          (map symbol->string
               '(__abs__ __add__ __class__ __coerce__ __delattr__ __div__
                         __divmod__ __doc__ __eq__ __float__ __floordiv__
                         __format__ __ge__ __getattribute__ __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__ __sizeof__ __str__
                         __sub__ __subclasshook__ __truediv__
                         conjugate imag real)))))
    (pylist-sort! l)
    l))

(define* (py-round x #:optional (digits 0))
  (let* ((f (expt 10.0 digits)))
    (if (equal? digits 0)
        (round x)
        (/ (round (* x f)) f))))
         
(define-method (py-bin (o <integer>))
  (number->string o 2))
(define-method (py-bin (o <py-int>))
  (number->string (slot-ref o 'x) 2))
(define (py-bin o)
  (+ "0b" (number->string (py-index o) 2)))