From 408076be6aed70bc21dd01065dad9d99f05d3a27 Mon Sep 17 00:00:00 2001
From: Stefan Israelsson Tampe <stefan.itampe@gmail.com>
Date: Fri, 23 Feb 2018 13:12:17 +0100
Subject: operator.scm

---
 modules/language/python/module/operator.scm | 303 ++++++++++++++++++++++++++++
 1 file changed, 303 insertions(+)
 create mode 100644 modules/language/python/module/operator.scm

(limited to 'modules/language/python/module/operator.scm')

diff --git a/modules/language/python/module/operator.scm b/modules/language/python/module/operator.scm
new file mode 100644
index 0000000..70a989d
--- /dev/null
+++ b/modules/language/python/module/operator.scm
@@ -0,0 +1,303 @@
+(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)
-- 
cgit v1.2.3