diff options
Diffstat (limited to 'modules/language/python/number.scm')
| -rw-r--r-- | modules/language/python/number.scm | 218 |
1 files changed, 218 insertions, 0 deletions
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)) |