generic function addition to property lookup
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sun, 1 Oct 2017 11:49:42 +0000 (13:49 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sun, 1 Oct 2017 11:49:42 +0000 (13:49 +0200)
modules/language/python/compile.scm
modules/language/python/dict.scm
modules/language/python/dir.scm
modules/language/python/list.scm
modules/language/python/string.scm
modules/oop/pf-objects.scm

index a338bf9ccbe45710486eff23cda058d80cc8eb99..610546f91660a94aa219086d3ecf2c0e40e6c61a 100644 (file)
@@ -30,6 +30,7 @@
 (define-inlinable (Di x) `(@@ (language python dict)    ,x))
 (define-inlinable (O  x) `(@@ (oop pf-objects)          ,x))
 (define-inlinable (G  x) `(@  (guile)                   ,x))
+(define-inlinable (H  x) `(@  (language python hash)    ,x))
 
 
 
     ...
     h))
 
+(define (fast-ref x)
+  (aif it (assoc x `((__class__ . ,(O 'py-class))))
+       (cdr it)
+       #f))
+
 (define fasthash
   (mkfast
    ;; General
    ((__ne__)      (O 'ne))
    ((__eq__)      (O 'equal?))
    ((__repr__)    (O 'repr))
-
+   
    ;;iterators
    ((__iter__)      (F 'wrap-in))
    ((__next__)      (F 'next))
    ((popitem)    (Di 'py-popitem))
    ((setdefault) (Di 'py-setdefault))
    ((update)     (Di 'py-update))
-   ((clear)      (Di 'py-clear))))
+   ((clear)      (Di 'py-clear))
+   ((__hash__)   (H  'py-hash))))
+  
 
 (define (fastfkn x) (hash-ref fasthash x))
 
           ((#:identifier . _)
            (let* ((tag     (exp vs x))
                   (xs      (gensym "xs"))
-                  (is-fkn? (aif it (and is-fkn? (fastfkn tag))
+                  (fast    (fastfkn tag))
+                  (is-fkn? (aif it (and is-fkn? fast)
                                 `(#:call-obj (lambda (e)
                                                `(lambda ,xs
                                                   (apply ,it ,e ,xs))))
                                 #f)))
              (if is-fkn?
                  is-fkn?
-                 `(#:identifier ',tag))))
+                 (if fast
+                     `(#:fastfkn-ref ,fast ',tag)
+                     (aif it (fast-ref tag)
+                          `(#:fast-id ,it ',tag)
+                          `(#:identifier ',tag))))))
           
           ((#:arglist args apply #f)
            (call-with-values (lambda () (get-kwarg vs args))
            `(expt ,x ,(exp vs **))
            x))
      (pw
-      (let lp ((e vf) (trailer trailer))
-        (match trailer
-          (()
-           e)
-          ((#f)          
-           (list e))
-          ((x . trailer)
-           (let ((is-fkn? (match trailer
-                            ((#f) #t)
-                            (((#:arglist . _) . _)
-                             #t)
-                            (_
-                             #f))))
-             (match (pr x)
-               ((#:identifier . _)
-                (let* ((tag     (exp vs x))
-                       (xs      (gensym "xs"))
-                       (is-fkn? (aif it (and is-fkn? (fastfkn tag))
-                                     `(lambda ,xs (apply ,it ,e ,xs))
-                                     #f)))
-                  (lp (if is-fkn?
-                          is-fkn?
-                          `(,(O 'refq) ,e ',tag #f))
-                      trailer)))
-               
-               ((#:arglist args apply  #f)
-                (call-with-values (lambda () (get-kwarg vs args))
-                  (lambda (args kwarg)
-                    (if apply
-                        (lp `(apply ,e 
-                                    ,@args
-                                    ,@kwarg
-                                    ,`(,(L 'to-list) ,(exp vs apply)))
-                            trailer)
-                        (lp `(,e ,@args ,@kwarg) trailer)))))
-               
-               ((#:subscripts (n #f #f))
-                `(,(L 'pylist-ref) ,e ,(exp vs n)))
-               
-               ((#:subscripts (n1 n2 n3))
-                (let ((w (lambda (x) (if (eq? x None) (E 'None) x))))
-                  `(,(L 'pylist-slice) ,e
-                    ,(w (exp vs n1)) ,(w (exp vs n2)) ,(w (exp vs n3)))))
-
-               ((#:subscripts (n #f #f) ...)
-                `(,(A 'pyarray-ref) ,e (list ,@ (map (lambda (n)
-                                                       (exp vs n))
-                                                     n))))
-
-               ((#:subscripts (n1 n2 n3) ...)
-                (let ((w (lambda (x) (if (eq? x None) (E 'None) x))))
-                  `(,(A 'pyarray-slice) ,e
-                    (list ,@(map (lambda (x y z)
-                                   `(list ,(exp vs x) ,(exp vs y) ,(exp vs z)))
-                                 n1 n2 n3)))))
-                 
-               (_ (error "unhandled trailer")))))))))))
-
+      (let ((trailer (get-addings vs trailer)))
+        `(,(C 'ref-x) ,vf ,@trailer))))))
  (#:identifier
   ((#:identifier x . _)
    (string->symbol x)))
   (syntax-rules ()
     ((_ v)
      v)
+    ((_ v (#:fastfkn-ref f _) . l)
+     (ref-x (lambda x (if (py-class? v) (apply f x) (apply f v x))) . l))
+    ((_ v (#:fast-id f _) . l)
+     (ref-x (f v) . l))
     ((_ v (#:identifier x) . l)
      (ref-x (refq v 'x) . l))
     ((_ v (#:identifier x) . l)
 
 (define-syntax set-x-2
   (syntax-rules ()
+    ((_ v (#:fastfkn-ref f id) val)
+     (set v id val))
+    ((_ v (#:fastid-ref f id) val)
+     (set v id val))
     ((_ v (#:identifier x) val)
      (set v x val)) 
     ((_ v (#:vecref n) val)
index 6c88ee49a225a56d6471003f53432dde0f38a0c6..5b6567b0496077309f504f9abf8e4d67ea095657 100644 (file)
@@ -14,7 +14,7 @@
             py-copy py-fromkeys py-get py-has_key py-items py-iteritems
             py-iterkeys py-itervalues py-keys py-values
             py-popitem py-setdefault py-update py-clear
-            py-hash-ref
+            py-hash-ref dict pyhash-listing
             ))
 
 (define (h x n) (modulo (py-hash x) n))
 (define-method (in key (o <py-hashtable>))
   (py-has_key o key))
 
+(define-python-class dict (<py-hashtable>)
+  (define __init__
+    (case-lambda
+      ((self)
+       (let ((r (make-py-hashtable)))
+         (slot-set! self 't (slot-ref r 't))
+         (slot-set! self 'h (slot-ref r 'h))
+         (slot-set! self 'n (slot-ref r 'n))))
+      ((self x)
+       (__init__ self)
+       (if (is-a? x <py-hashtable>)
+           (hash-for-each
+            (lambda (k v)
+              (pylist-set! self k v))
+            (slot-ref x 't)))))))
+
+(define (pyhash-listing)
+  (let ((l (to-pylist
+            (map symbol->string
+                 '(__class__ __cmp__ __contains__ __delattr__
+                             __delitem__ __doc__ __eq__ __format__
+                             __ge__ __getattribute__ __getitem__
+                             __gt__ __hash__ __init__ __iter__
+                             __le__ __len__ __lt__ __ne__ __new__
+                             __reduce__ __reduce_ex__ __repr__
+                             __setattr__ __setitem__ __sizeof__
+                             __str__ __subclasshook__
+                             clear copy fromkeys get has_key
+                             items iteritems iterkeys itervalues
+                             keys pop popitem setdefault update
+                             values viewitems viewkeys viewvalues)))))
+    (pylist-sort! l)
+    l))
+       
+  
+(define-method (py-class (o <hashtable>))    dict)
+(define-method (py-class (o <py-hashtable>)) dict)
index 2f23e3582e5432495851ed29316390552095f380..36b4f02d9d00ebc23af8667848e01e7ccb1a39e3 100644 (file)
         (hash-for-each (lambda (k v) (set! l (cons k l))) h)
         (to-pylist (map symbol->string (sort l <))))))
 
-(define-method (dir (o <py-list>     ))
+(define-method (dir (o <py-list>))
   (let ((l1 (pylist-listing)))
     (if (is-a? o <p>)
-        (let* ((l2 (next-method))
+        (let* ((l2 (pk (next-method)))
                (l  (+ l1 l2)))
           (pylist-sort! l)
-          l))))
+          l)
+        l1)))
+
+(define-method (dir (o <py-hashtable>))
+  (let ((l1 (pyhash-listing)))
+    (if (is-a? o <p>)
+        (let* ((l2 (pk (next-method)))
+               (l  (+ l1 l2)))
+          (pylist-sort! l)
+          l)
+        l1)))
+
+(define-method (dir (o <py-string>))
+  (let ((l1 (pystring-listing)))
+    (if (is-a? o <p>)
+        (let* ((l2 (pk (next-method)))
+               (l  (+ l1 l2)))
+          (pylist-sort! l)
+          l)
+        l1)))
           
     
-(define-method (dir (o <hashtable>   )) pyhash-listing)
-(define-method (dir (o <py-hashtable>)) pyhash-listing)
-(define-method (dir (o <string>      )) string-listing)
-      
+(define-method (dir (o <hashtable>   )) (pyhash-listing))
+(define-method (dir (o <string>      )) (pystring-listing))
+
+(define-method (dir)
+  (let ((l '()))
+    (module-for-each (lambda (m . u)
+                       (set! l (cons (symbol->string m) l)))
+                     (current-module))
+    (let ((ret (to-pylist l)))
+      (pylist-sort! ret)
+      ret)))
+  
                   
                           
index 779ed7350f63339ef8a2095f7a26776e0a151c1a..1afa56f18e0c424f8dbccc4262aa83d560e2fbcd 100644 (file)
 (define-method (+ (o1 <string>) (o2 <string>))
   (string-append o1 o2))
 
+(define-method (+ (o1 <symbol>) (o2 <symbol>))
+  (string->symbol
+   (string-append
+    (symbol->string o1)
+    (symbol->string o2))))
+
+(define-method (* (x <integer>) (o1 <py-list>)) (* o1 x))
 (define-method (* (o1 <py-list>) (x <integer>))
   (let* ((vec  (slot-ref o1 'vec))
          (n    (slot-ref o1 'n))
     (slot-set! o 'vec vec2)
     o))
 
+(define-method (* (x <integer>) (vec <string>)) (* vec x))
 (define-method (* (vec <string>) (x <integer>))
   (let* ((n    (string-length vec))
          (n2   (* n x))
                 (lp1 (+ i 1) j)))))
     vec2))
 
+(define-method (* (x <integer>) (l <pair>)) (* l x))
 (define-method (* (l <pair>) (x <integer>))
   (let lp1 ((i 0))
     (if (< i x)
         '())))
 
 
-(define-method (+ (o1 <pair>) (o2 <pair>))
-  (append o1 o2))
-
-(define-method (+ (o1 <string>) (o2 <string>))
-  (string-append o1 o2))
-
 ;;REVERSE
 (define-method (pylist-reverse! (o <py-list>))
   (let* ((N   (slot-ref o 'n))
 (define pylist list)
 
 
+(define-method (py-class (o <py-list>) list))
+
 (define (pylist-listing)
   (let ((l
          (to-pylist
index 27dd8b87f5f09577256510d1d8bdd1ab3e27f9ec..4b227165282341c9621e4ca6997a628465dcf7c6 100644 (file)
@@ -1,6 +1,7 @@
 (define-module (language python string)
   #:use-module (oop goops)
   #:use-module (oop pf-objects)
+  #:use-module (language python hash)
   #:use-module (ice-9 match)
   #:use-module (language python list)
   #:use-module (language python exceptions)
                       py-rljust py-lower py-upper py-lstrip py-rstrip
                       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))
+                      py-startswith py-swapcase py-translate py-zfill
+                      pystring-listing <py-string> pystring))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
+
+(define-class <py-string> () str)
+
 (define-syntax-rule (define-py (f n o . u) code ...)
-  (begin
-    (define-method (f (o <string>) . u) code ...)
-    (define-method (f (o <p>) . l) (apply (ref o 'n) l))))
+    (begin
+      (define-method (f (o <string>)    . u) code ...)
+      (define-method (f (o <py-string>) . l) (apply f (slot-ref o 'str) l))
+      (define-method (f (o <p>)         . l) ((ref o 'n) l))))
 
 (define-py (py-capitalize capitalize s)
   (let* ((n (len s))
 
 (define-syntax-rule (a b x y) (b (symbol->string x) (symbol->string y)))
 
+(define-syntax-rule (mkop op)
+ (begin
+   (define-method (op (s1 <string>) (s2 <py-string>))
+     (op s1 (slot-ref s2 'str)))
+   (define-method (op (s2 <py-string>) (s1 <string>))
+     (op s1 (slot-ref s2 'str)))))
+
+(mkop <)
+(mkop <=)
+(mkop >)
+(mkop >=)
+(mkop +)
+(mkop *)
+
 (define-method (<  (s1 <string>) (s2 <string>)) (string-ci<  s1 s2))
 (define-method (<= (s1 <string>) (s2 <string>)) (string-ci<= s1 s2))
 (define-method (>  (s1 <string>) (s2 <string>)) (string-ci>  s1 s2))
                       w))
                 (lp (+ i 1))))
           s))))
+
+(define-python-class string (<py-string>)
+  (define __init__
+    (case-lambda
+      ((self s)
+       (cond
+        ((is-a? s <py-string>)
+         (slot-set! self 'str (slot-ref s 'src)))
+        ((is-a? s <string>)
+         (slot-set! self 'str s)))))))
+
+(define pystring string)
+
+(define-method (py-class (o <string>))    string)
+(define-method (py-class (o <py-string>)) string)
+
+(define-method (pyhash (o <py-string>)) (hash (slot-ref o 'str) pyhash-N))
+
+(define-method (equal? (o <py-string>) x)
+  (equal? (slot-ref o 'str) x))
+(define-method (equal? x (o <py-string>))
+  (equal? (slot-ref o 'str) x))
+
+(define (pystring-listing)
+  (let ((l (to-pylist
+            (map symbol->string
+                 '(__add__ __class__ __contains__ __delattr__ __doc__
+                           __eq__ __format__ __ge__ __getattribute__
+                           __getitem__ __getnewargs__ __getslice__ __gt__
+                           __hash__ __init__ __le__ __len__ __lt__ __mod__
+                           __mul__ __ne__ __new__ __reduce__ __reduce_ex__
+                           __repr__ __rmod__ __rmul__ __setattr__ __sizeof__
+                           __str__ __subclasshook__
+                           _formatter_field_name_split _formatter_parser
+                           capitalize center count decode encode endswith
+                           expandtabs find format index isalnum isalpha
+                           isdigit islower isspace istitle isupper join
+                           ljust lower lstrip partition replace rfind rindex
+                           rjust rpartition rsplit rstrip split splitlines
+                           startswith strip swapcase
+                           title translate upper zfill)))))
+    (pylist-sort! l)
+    l))
+
index 68475243fc085c84f0c819d67455f4269da1ad16..62c522b631748b064c637fb75a000394556aac29 100644 (file)
@@ -9,7 +9,7 @@
                 def-p-class   mk-p-class   make-p-class
                 def-pyf-class mk-pyf-class make-pyf-class
                 def-py-class  mk-py-class  make-py-class
-                define-python-class get-type
+                define-python-class get-type py-class
                 ))
 #|
 Python object system is basically syntactic suger otop of a hashmap and one
@@ -686,5 +686,9 @@ explicitly tell it to not update etc.
                  (code ...))))
 
 (define (pyclass? x)
-  (and (is-a? x <p>) (not (ref x '__class__))))
+  (and (is-a? x <p>)
+       (not (ref x '__class__))))
 
+
+(define-method (py-class (o <p>))
+  (ref o '__class__ 'type))