operator.scm

7 files changed, 711 insertions, 11 deletions

diff --git a/modules/language/python/def.scm b/modules/language/python/def.scm
index 1b91f85..f0bb161 100644
--- a/modules/language/python/def.scm
+++ b/modules/language/python/def.scm
@@ -1,7 +1,8 @@
 (define-module (language python def)
+  #:use-module (language python for)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-11)
-  #:export (def lam))
+  #:export (def lam py-apply))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 (define (fold lam s l)
@@ -99,6 +100,43 @@
                            code ...))))))))))))
 
 (define-syntax-rule (def (f . args) code ...) (define f (lam args code ...)))
-                                              
-                                 
-                                 
+
+
+(define (no x)
+  (and-map
+   (lambda (x)
+     (syntax-case x (* **)
+       ((*  _) #f)
+       ((** _) #f)
+       (_ #t)))
+   x))
+
+(define (mk-k x)
+  (if (keyword? x)
+      x
+      (symbol->keyword
+       (if (string? x)
+	   (string->symbol x)
+	   x))))
+
+(define-syntax m*
+  (syntax-rules (* **)
+    ((_ (*  a)) a)
+    ((_ (** kw))
+     (for ((k v : kw)) ((l '()))
+	  (cons* v (mk-k k) l)
+
+	  #:final (reverse l)))
+    ((_ a) (list a))))
+
+(define-syntax py-apply  
+  (lambda (x)
+    (syntax-case x ()
+      ((_ f a ...)
+       (if (no #'(a ...))
+	   #'(apply f a ...)
+	   #'(apply f (let lp ((l (list (m* a) ...)))
+			(if (pair? l)
+			    (append (car l) (lp (cdr l)))
+			    '()))))))))
+	       
diff --git a/modules/language/python/for.scm b/modules/language/python/for.scm
index 0cb7afe..8db5aa7 100644
--- a/modules/language/python/for.scm
+++ b/modules/language/python/for.scm
@@ -4,6 +4,7 @@
   #:use-module (language python exceptions)
   #:use-module (oop goops)
   #:use-module (ice-9 control)
+  #:use-module (language python persist)
   #:export (for break next wrap-in))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
diff --git a/modules/language/python/module/collections/abc.scm b/modules/language/python/module/collections/abc.scm
new file mode 100644
index 0000000..c056834
--- /dev/null
+++ b/modules/language/python/module/collections/abc.scm
@@ -0,0 +1,334 @@
+(define-module (language python module collections abc)
+  #:use-module (oop pf-objects)
+  #:export (Container Hashable Iterable Iterator Reversable Generator
+		      Sized Callable Collection Sequence MutableSequence
+		      ByteString Set MutableSet Mapping MutableMapping
+		      MappingView ItemsView KeysView ValuesView))
+
+(define-python-class Container ()
+  (define __containes__
+    (lambda x (error "not implemented"))))
+
+(define-python.class Hashable ()
+  (define __hash__
+    (lambda x (error "not implemented"))))
+
+(define-python-class Iterable ()
+  (define __iter__
+    (lambda x (error "not implemented"))))
+
+(define-python-class Iterator (Iterable)
+  ;; Mixin
+  (define __iter__
+    (lambda (self) self))
+
+  ;; Abstract
+  (define __next__
+    (lambda x (error "not implemented"))))
+
+(define-python-class Reversable (Iterable)
+  (define __reversed__
+    (lambda x (error "not implemented"))))
+
+(define-python-class Generator (Iterator)
+  ;; Mixin
+  (define __next__
+    (lambda (self) ((ref self 'send))))
+
+  (define close
+    (lambda (self)
+      ((ref self 'throw) GeneratorExit)))
+  
+  ;; Abstract
+  (define send
+    (lambda x (error "not implemented")))
+  (define throw
+    (lambda x (error "not implemented"))))
+
+(define-python-class Sized ()
+  (define __len__
+    (lambda x (error "not implemented"))))
+
+(define-python-class Callable ()
+  (define __call__
+    (lambda x (error "not implemented"))))
+
+(define-python-class Collection (Sized Iterable Container))
+
+(define-python-class Sequence (Reversable Collection)
+  ;; Mixin
+  (define __contains__
+    (lambda (self x)
+      (let ((f (ref self '__getitem)))
+	(for ((i : (range (len self))))
+	     (if (equal? x (f i))
+		 (break #t))
+	     #:final #f))))
+
+  (define __iter__
+    (lambda (self)
+      ((mk-iterator       
+	(lambda (yield)
+	  (let ((f (ref self '__getitem)))
+	    (for ((i : (range (len self))))
+		 (yield (f i)))))))))
+
+  (define __reversed__
+    (lambda (self)
+      ((mk-iterator
+	(lambda (yield)
+	  (let ((f (ref self '__getitem)))
+	    (for ((i : (range (len self) 0 -1)))
+		 (yield (f i)))))))))
+
+  (define index
+    (lambda (self x)
+      (let ((f (ref self '__getitem__)))
+	(for ((i : (range (len self))))
+	     (if (equal? x (f i))
+		 (break y))
+	     (raise IndexError)))))
+
+  (define count
+    (lambda (self x)
+      (let ((f (ref self '__getitem__)))
+	(for ((i : (range (len self)))) ((n 0))
+	     (if (equal? x (f i))
+		 (+ n 1)
+		 n)
+	     #:final n))))
+      
+			   
+  ;; Abstract
+  (define __getitem__
+    (lambda x (error "not implemented"))))
+
+(define-python-class MutableSequence (Sequence)
+  ;; Mixin
+  (define append
+    (lambda (self x)
+      ((ref self 'insert) (len self) x)))
+
+  (define extend
+    (lambda (self it)
+      (let ((f (ref self 'insert)))
+	(for ((x : it)) ((i (len self)))
+	  (f i x)
+	  (+ i 1)))
+      (values)))
+
+  (define pop
+    (lambda (self)
+      (let* ((i (- (len self) 1))
+	     (x ((ref self '__getitem__) i)))
+	((ref self '__delitem__) i)
+	x)))
+
+  (define remove
+    (lambda (self x)
+      (let ((f (ref self '__getitem__)))
+	(for ((i : (range (len self))))
+	     (if (equal? x (f i))
+		 (begin
+		   ((ref self '__delitem__) i)
+		   (break)))))
+      (values)))
+
+	     
+  (define __iadd__
+    (lambda (self seq)
+      (let ((f (ref self 'insert)))
+	(for ((x : seq)) ((i (len self)))
+	     (f i x)
+	     (+ i 1)))
+      (values)))
+	   
+  
+  ;; Abstract
+  (define __setitem__
+    (lambda x (error "not implemented")))
+  (define __delitem__
+    (lambda x (error "not implemented")))
+  (define insert
+    (lambda x (error "not implemented"))))
+
+(define-python-class ByteString (Sequence))
+
+(define-python-class Set (Collection)
+  ;; Mixins
+  (define __le__
+    (lambda (self o)
+      (let ((f (ref o '__contains__)))
+	(for ((x : ((ref self '__iter__))))
+	     (if (not (f x))
+		 (break #f))))))
+  
+  (define __lt__
+    (lambda (self o)
+      (if (equal? (len self) (len o))
+	  #f
+	  (let ((f (ref o '__contains__)))
+	    (for ((x : ((ref self '__iter__))))
+		 (if (not (f x))
+		     (break #f)))))))
+
+  (define __eq__
+    (lambda (self o)
+      (if (not (equal? (len self) (len o)))
+	  #f
+	  (let ((f (ref o '__contains__)))
+	    (for ((x : ((ref self '__iter__))))
+		 (if (not (f x))
+		     (break #f)))))))
+
+  (define __ne__
+    (lambda (self o) (not ((ref self '__eq__) o))))
+  
+  (define __gt__
+    (lambda (self o)
+      (if (equal? (len self) (len o))
+	  #f
+	  (let ((f (ref self '__contains__)))
+	    (for ((x : ((ref o '__iter__))))
+		 (if (not (f x))
+		     (break #f)))))))
+    
+  (define __ge__
+    (lambda (self o)
+      (let ((f (ref self '__contains__)))
+	(for ((x : ((ref o '__iter__))))
+	     (if (not (f x))
+		 (break #f))))))
+
+  (define __and__
+    (lambda (self o)
+      (let ((f (ref o '__contains__))
+	    (s (set))
+	    (a (ref s 'add)))
+	(for ((x : ((ref self '__iter__)))) ()
+	     (if (f x)
+		 (a x)))
+	s)))
+  
+  (define __or__
+    (lambda (self o)
+      (let ((s (set))
+	    (a (ref s 'add)))
+	(for ((x : ((ref self '__iter__)))) ()
+	     (a x))
+	(for ((x : ((ref o '__iter__)))) ()
+	     (a x))
+	s)))
+      
+  (define __sub__
+    (lambda (self o)
+      (let ((f (ref o '__contains__))
+	    (s (set))
+	    (a (ref s 'add)))
+	(for ((x : ((ref self '__iter__)))) ()
+	     (if (not (f x))
+		 (a x)))
+	s)))
+
+  (define __xor__
+    (lambda (self o)
+      (let ((fo (ref o    '__contains__))
+	    (fs (ref self '__contains__))
+	    (s (set))
+	    (a (ref s 'add)))
+	(for ((x : ((ref self '__iter__)))) ()
+	     (if (not (fo x))
+		 (a x)))
+	(for ((x : ((ref o '__iter__)))) ()
+	     (if (not (fs x))
+		 (a x)))
+	s)))
+
+  (define disjoint
+    (lambda (self o)
+      (let ((f (ref o '__contains__))
+	    (s (set))
+	    (a (ref s 'add)))
+	(for ((x : ((ref self '__iter__)))) ()
+	     (if (f x)
+		 (break #f))
+	     #:final #t)))))
+ 
+(define-python-class MutableSet (Set)
+  ;; Abstract methods
+  (define add
+    (lambda x (error "not implemented")))
+  (define discard
+    (lambda x (error "not implemented")))
+
+  ;; Mixins
+  (define clear)
+  (define pop)
+  (define remove)
+  (define __ior__)
+  (define __iand__)
+  (define __ixor__)
+  (define __isub__))
+
+(define-python-class Mapping (Collection)
+  ;; Mixins
+  (define __contains__)
+  (define keys)
+  (define items)
+  (define values)
+  (define get)
+  (define __eq__)
+  (define __ne__))
+
+(define-python-class MutableMapping (Mapping)
+  ;; Abstracts
+  (define __setitem__)
+  (define __delitem__)
+
+  ;; Mixins
+  (define pop)
+  (define popitem)
+  (define clear)
+  (define update)
+  (define setdefault))
+
+(define-python-class MappingView (Sized)
+  ;; Mixins
+  (define __init__
+    (lambda (self m)
+      (set self '_mapping m)))
+  
+  (define __len__
+    (lambda (self) (len (ref self '_mapping)))))
+		    
+(define-python-class ItemsView   (MappingView Set)
+  ;; Mixins
+  (define __contains__
+    (lambda (self x)))
+  (define __iter__
+    (lambda (self)
+      ((ref (ref self '_mapping) 'items)))))
+      
+(define-python-class KeysView    (MappingView Set)
+  ;; Mixins
+  (define __contains__
+    (lambda (self k)))
+      
+  (define __iter__
+    (lambda (self)
+      ((ref (ref self '_mapping) 'keys)))))
+
+(define-python-class ValuesView  (MappingView)
+    ;; Mixins
+  (define __contains__
+    (lambda (self x)))
+  
+  (define __iter__
+    (lambda (self)
+      ((ref (ref self '_mapping) 'values)))))
+
+
+(name-object Container Hashable Iterable Iterator Reversable Generator
+	     Sized Callable Collection Sequence MutableSequence
+	     ByteString Set MutableSet Mapping MutableMapping
+	     MappingView ItemsView KeysView ValuesView)
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)
diff --git a/modules/language/python/number.scm b/modules/language/python/number.scm
index c81570d..6d93435 100644
--- a/modules/language/python/number.scm
+++ b/modules/language/python/number.scm
@@ -8,14 +8,39 @@
   #: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-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-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)
diff --git a/modules/language/python/persist.scm b/modules/language/python/persist.scm
index 4005220..4ee46fc 100644
--- a/modules/language/python/persist.scm
+++ b/modules/language/python/persist.scm
@@ -112,7 +112,3 @@
 	     (cons*
 	      (cons lam a)
 	      (next-method))))))))
-
-
-
-
diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm
index 74eb0d7..d4cb74b 100644
--- a/modules/language/python/string.scm
+++ b/modules/language/python/string.scm
@@ -17,10 +17,13 @@
                       py-partition py-replace py-strip py-title
                       py-rpartitio py-rindex py-split py-rsplit py-splitlines
                       py-startswith py-swapcase py-translate py-zfill
-                      pystring-listing <py-string> pystring))
+                      pystring-listing <py-string> pystring py-string?))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
+(define (py-string? x)
+  (or (string? x)
+      (is-a? x <py-string>)))
 
 (define-class <py-string> () str)
 (name-object <py-string>)