path: root/modules/language/python/module/operator.scm

(define-module (language python module operator)
  #:use-module (oop pf-objects)
  #:use-module (ice-9 control)
  #:use-module (language python number)
  #:use-module (language python list)
  #:use-module (language python string)
  #:use-module (language python for)
  #:use-module (language python try)
  #:use-module (language python def)
  #:use-module (language python persist)
  #:use-module (language python exceptions)
  #:use-module ((language python module python)
		#:select (enumerate getattr hasattr))

  #:export
  (abs add and_ attrgetter concat contains countOf
	delitem eq floordiv ge getitem gt iadd iand
	iconcat ifloordiv ilshift imatmul imod imul
	index indexOf inv invert ior ipow irshift
	is_ is_not isub itemgetter itruediv ixor le
	length_hint lshift lt matmul methodcaller mod
	mul ne neg not_ or_ pos pow rshift
	setitem sub truediv truth xor
	__lt__ __le__ __eq__ __ne__ __ge__ __gt__ __not__ __abs__ __add__
	__and__ __floordiv__ __index__ __inv__ __invert__ __lshift__ __mod__
	__mul__ __matmul__ __neg__ __or__ __pos__ __pow__ __rshift__ __sub__
	__truediv__ __xor__ __concat__ __contains__ __delitem__ __getitem__
	__setitem__ __iadd__ __iand__ __iconcat__ __ifloordiv__ __ilshift__
	__imod__ __imul__ __imatmul__ __ior__ __ipow__ __irshift__ __isub__
	__itruediv__ __ixor__ ))

;; Comparison Operations
(define-inlinable (lt a b) (<  a b))
(define-inlinable (le a b) (<= a b))
(define-inlinable (eq a b) (equal? a b))
(define-inlinable (ne a b) (not (equal? a b)))
(define-inlinable (ge a b) (>= a b))
(define-inlinable (gt a b) (>  a b))

;; Logical Operations
(define-inlinable (not_ a)     (not a))
(define-inlinable (truth    a) (if a #t #f))
(define-inlinable (is_    a b) (eq? a b))
(define-inlinable (is_not a b) (not (eq? a b)))

;; Mathematical/Bitwise Operations
(define abs (@ (guile) abs))
(define-inlinable (add  a b) (+ a b))
(define and_     py-logand)
(define floordiv py-floordiv)
(define index    py-index)
(define inv      py-lognot)
(define invert   inv)
(define lshift   py-lshift)
(define mod      py-mod)
(define-inlinable (mul x y) (* x y))
(define matmul   py-matmul)
(define-inlinable (neg x) (- x))
(define or_ py-logior)
(define-inlinable (pos a) (+ a))
(define pow expt)
(define rshift py-rshift)
(define-inlinable (sub a b) (- a b))
(define truediv py-/)
(define xor py-logxor)

;; Sequence Operations
(define-inlinable (concat   a b) (+ a b))
(define-inlinable (contains a b) (in b a))
(define (countOf a b)
  (for ((x : a)) ((c 0))
       (if (equal? x b)
	   (+ c 1)
	   c)
       
       #:final c))

(define delitem pylist-delete!)
(define getitem pylist-ref)
(define (indexOf a b)
  (for ((i x : (enumerate a))) ()
       (if (equal? x b)
	   (break i))

       #:final (raise ValueError "sequence.index(x): x not in sequence'")))
	   
(define setitem pylist-delete!)

(define* (length_hint obj #:optional (default 0))
  (if (not (and (number? default) (integer? default)))
      (raise TypeError (format #f "default=~ a is not an integer" default)))
  (let/ec ret (values)
    #;(try
     (lambda ()
       (ret (len obj)))
     
     #:except TypeError =>
     (lambda x (values)))

    #;(let ((hint
	   (try
	    (lambda ()
	      (ref obj '__length_hint__))

	    #:except AttributeError =>
	    (lambda x (ret default)))))
      (let ((val (try
		  (lambda () (hint))

		  #:except TypeError =>
		  (lambda x (ret default)))))
	(cond
	 ((eq? val NotImplemented)
	  default)
	 ((not (and (number? val) (integer? val)))
	  (raise TypeError
		 (format #f "__length_hint__() must be integer, not ~ a" val)))
	 ((< val 0)
	  (raise ValueError
		 "__length_hint__() should return integer >= 0"))
	 (else
	  val))))))

;; Generalized Lookup Objects
(define-python-class attrgetter ()
  (define __init__
    (lambda (self attr . attrs)
      (if (null? attrs)
	  (begin
            (if (not (py-string? attr))
		(raise TypeError "attribute name must be a string"))
            (set self '_attrs (list attr))
            (let ((names (string-split attr #\.)))
	      (define (func obj)
                (for ((name : names)) ((obj obj))
		     (getattr obj name)
		     
		     #:final obj))
	      (set self '_call func)))
	  (let ((attrs (cons attr attrs)))
            (set self '_attrs attrs)
            (let ((getters (map attrgetter attrs)))
	      (define (func obj)
		(for ((getter : getters)) ((l '()))
		     (cons (getter obj) l)
		     
		     #:final (reverse l)))
	      (set self '_call func))))))

  (define __call__
    (lambda (self obj)
      ((ref self '_call) obj)))
  
  (define __repr__
    (lambda (self)
      (let ((cl (ref self '__class__))
	    (as (ref self '_attrs)))
	(format #f "~a(~a~{,~a~})"
		(ref cl '__name__)
		(car as)
		(cdr as))))))

(name-object attrgetter)

(define-python-class itemgetter ()
  (define __init__
    (lambda (self  item . items)
      (if (null? items)
	  (let ()            
            (define (func obj)
	      (pylist-ref obj item))
	    (set self '_items (list item))
            (set self '_call func))
	  (let ()
	    (define (func obj)
	      (map (lambda (i) (pylist-ref obj i))
		   (ref self '_items)))
	    (set self '_items (cons item items))
            (set self '_call func)))))


  (define __call__
    (lambda (self obj)
      ((ref self '_call) obj)))

  (define __repr__
    (lambda (self)
      (let ((args (ref self '_args)))
	(format #f "~a(~a~{,~a~})"
		(ref (ref self '__class__) '__name__)
		(car args) (cdr args))))))

(name-object itemgetter)



(define-python-class methodcaller ()
  (define __init__
    (lam (self (* args) (** kwargs))
	 (if (< (len args) 1)
	     (raise TypeError
		    "methodcaller needs at least one argument, the method name"
		    ))
	 (let ((name (car args)))
	   (set self '_name name)
	   (if (not (py-string? name))
	       (raise TypeError "method name must be a string")))
	 
	 (set self '_args    (cdr args))
	 (set self '_kwargs  kwargs)))

  (define __call__
    (lambda (self obj)
      (py-apply (getattr obj (ref self '_name))
		(*  (ref self '_args))
		(** (ref self '_kwargs)))))

  (define __repr__
    (lambda (self)
      (define cln (ref (ref self '__class__) '__name__))
      (define v1 (for ((x : (ref self '_args)))
		      ((l (list (ref self '_name))))
		      (cons x l)

		      #:final l))
      (define v2 (for ((k v : (ref self '_kwargs))) ((l v1))
		      (cons (format #f "~a=~a" k v) l)

		      #:final (reverse l)))
      (format #f "~a(~a~{,~a~})" cln (car v2) (cdr v2)))))

(name-object methodcaller)
  

;; In-place Operations
(define iadd py-iadd)
(define iand py-ilogand)
(define (iconcat a b)
  (if (not (hasattr a '__getitem__'))
      (raise TypeError
	     (format
	      #f
	      "'~a' object can't be concatenated"
	      (ref (type a) '__name__))))
  (iadd a b))

(define ifloordiv py-ifloordiv)
(define ilshift   py-ilshift)
(define imod      py-imod)
(define imul      py-imul)
(define imatmul   py-imatmul)
(define ior       py-ilogior)
(define ipow      py-ipow)
(define irshift   py-irshift)
(define isub      py-isub)
(define itruediv  py-i/)
(define ixor      py-ilogxor)

(define __lt__       lt)
(define __le__       le)
(define __eq__       eq)
(define __ne__       ne)
(define __ge__       ge)
(define __gt__       gt)
(define __not__      not_)
(define __abs__      abs)
(define __add__      add)
(define __and__      and_)
(define __floordiv__ floordiv)
(define __index__    index)
(define __inv__      inv)
(define __invert__   invert)
(define __lshift__   lshift)
(define __mod__      mod)
(define __mul__      mul)
(define __matmul__   matmul)
(define __neg__      neg)
(define __or__       or_)
(define __pos__      pos)
(define __pow__      pow)
(define __rshift__   rshift)
(define __sub__      sub)
(define __truediv__  truediv)
(define __xor__      xor)
(define __concat__   concat)
(define __contains__ contains)
(define __delitem__  delitem)
(define __getitem__  getitem)
(define __setitem__  setitem)
(define __iadd__     iadd)
(define __iand__     iand)
(define __iconcat__  iconcat)
(define __ifloordiv__ ifloordiv)
(define __ilshift__  ilshift)
(define __imod__     imod)
(define __imul__     imul)
(define __imatmul__  imatmul)
(define __ior__      ior)
(define __ipow__     ipow)
(define __irshift__  irshift)
(define __isub__     isub)
(define __itruediv__ itruediv)
(define __ixor__     ixor)