equal magics
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 11 Oct 2017 18:07:51 +0000 (20:07 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 11 Oct 2017 18:07:51 +0000 (20:07 +0200)
modules/language/python/compile.scm
modules/language/python/dict.scm
modules/language/python/list.scm
modules/language/python/module/python.scm
modules/language/python/number.scm
modules/language/python/set.scm
modules/language/python/string.scm
modules/language/python/tuple.scm
modules/oop/pf-objects.scm

index 3e16386a2a1c8bcea553703c4d1b75baf58385ed..b7a52b27e6a014d43443b7eb671375772aa91e6a 100644 (file)
                 (letrec ((,f
                           (case-lambda
                             ((,q)
                 (letrec ((,f
                           (case-lambda
                             ((,q)
-                             (apply ,f ,q))
+                             (if (pair? ,q)
+                                 (apply ,f ,q)
+                                 (apply ,f (,(L 'to-list) ,q))))
                             (,vars
                              ,@(map (lambda (l v) (make-set vs op l v))
                                     l vars)))))
                             (,vars
                              ,@(map (lambda (l v) (make-set vs op l v))
                                     l vars)))))
      (match op
        ((or "<" ">" "<=" ">=")
         (list (G (string->symbol op)) x y))
      (match op
        ((or "<" ">" "<=" ">=")
         (list (G (string->symbol op)) x y))
-       ("!="    (list (G 'not) (list (G 'equal?) x y)))
-       ("=="    (list (G 'equal?) x y))
+       ("!="    (list (G 'not) (list (O 'equal?) x y)))
+       ("=="    (list (O 'equal?) x y))
        ("is"    (list (G 'eq?) x y))
        ("isnot" (list (G 'not) (list (G 'eq?)    x y)))
        ("in"    (list (L 'in) x y))
        ("notin" (list (G 'not) (list (L 'in)     x y)))
        ("is"    (list (G 'eq?) x y))
        ("isnot" (list (G 'not) (list (G 'eq?)    x y)))
        ("in"    (list (L 'in) x y))
        ("notin" (list (G 'not) (list (L 'in)     x y)))
-       ("<>"    (list (G 'not) (list (G 'equal?) x y)))))
+       ("<>"    (list (G 'not) (list (O 'equal?) x y)))))
    (tr op (exp vs x) (exp vs y)))))
 
 (define (exp vs x)
    (tr op (exp vs x) (exp vs y)))))
 
 (define (exp vs x)
index f4d13a5d6d50d9a3a9784dd9a194639b2b823ade..b9ab1164e14f9adfc1781008133bfffa2d0df64b 100644 (file)
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
 (define (h x n) (modulo (py-hash x) n))
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
 (define (h x n) (modulo (py-hash x) n))
+(define (py-assoc k l)
+  (if (pair? l)
+      (if (equal? (caar l) k)
+          (car l)
+          (py-assoc k (cdr l)))
+      #f))
 
 (define (py-hash-ref . l)
 
 (define (py-hash-ref . l)
-  (apply hashx-ref h assoc l))
+  (apply hashx-ref h py-assoc l))
 (define (py-hash-set! . l)
 (define (py-hash-set! . l)
-  (apply hashx-set! h assoc l))
+  (apply hashx-set! h py-assoc l))
 (define (py-hash-remove! . l)
 (define (py-hash-remove! . l)
-  (apply hashx-remove! h assoc l))
+  (apply hashx-remove! h py-assoc l))
 
 (set! (@@ (language python def) hset!) py-hash-set!)
 
 
 (set! (@@ (language python def) hset!) py-hash-set!)
 
       (format port "{}") 
       (format port "{~a: ~a~{, ~a: ~a~}}" (car li) (cadr li) (cddr li))))
 
       (format port "{}") 
       (format port "{~a: ~a~{, ~a: ~a~}}" (car li) (cadr li) (cddr li))))
 
-(define-method (equal? (o1 <py-hashtable>) (o2 <py-hashtable>))
+(define-method (py-equal? (o1 <py-hashtable>) (o2 <py-hashtable>))
   (and
    (equal? (slot-ref o1 'n) (slot-ref o2 'n))
    (equal? (slot-ref o1 'h) (slot-ref o2 'h))
   (and
    (equal? (slot-ref o1 'n) (slot-ref o2 'n))
    (equal? (slot-ref o1 'h) (slot-ref o2 'h))
index e9c301c521ee7a56cb1d30623eca62162ae37455..a35ceae6519b6624708a226717bc137fdc6a545f 100644 (file)
        (next-method)))
 
 ;; equal?
        (next-method)))
 
 ;; equal?
-(define-method (equal? (o1 <py-list>) (o2 <py-list>))
+(define-method (py-equal? (o1 <py-list>) (o2 <py-list>))
+  (equal o1 o2))
+
+(define (equal o1 o2)
   (let ((n1   (slot-ref o1 'n))
         (n2   (slot-ref o2 'n))
         (vec1 (slot-ref o1 'vec))
   (let ((n1   (slot-ref o1 'n))
         (n2   (slot-ref o2 'n))
         (vec1 (slot-ref o1 'vec))
            (and (equal? (vector-ref vec1 i) (vector-ref vec2 i))
                 (lp (+ i 1)))
            #t)))))
            (and (equal? (vector-ref vec1 i) (vector-ref vec2 i))
                 (lp (+ i 1)))
            #t)))))
-           
-(define-method (equal? (o1 <py-list>) o2)             #f)
-(define-method (equal? o1             (o2 <py-list>)) #f)
-
 
 (define-class <py-seq-iter>  () o i n d)
 (define-class <py-list-iter> (<py-list>) i d)
 
 (define-class <py-seq-iter>  () o i n d)
 (define-class <py-list-iter> (<py-list>) i d)
                  (__init__ self)
                  (for ((i : it)) () (pylist-append! self i))))))
       __init__)))
                  (__init__ self)
                  (for ((i : it)) () (pylist-append! self i))))))
       __init__)))
-
+  
 (define pylist list)
 
 (define pylist list)
 
-
 (define-method (py-class (o <py-list>) list))
 
 (define (pylist-listing)
 (define-method (py-class (o <py-list>) list))
 
 (define (pylist-listing)
index 418c3252006a481ce9c6209a22691b24b6490a2c..492e013d1522da5c818d127a61ec3d9b68b41a5e 100644 (file)
                   (lambda z
                     (lp2 (cdr l) (append (reverse z) r))))
                 (begin
                   (lambda z
                     (lp2 (cdr l) (append (reverse z) r))))
                 (begin
-                  (apply yield (reverse r))
+                  (yield (reverse r))
                   (lp))))))))))
   
 
                   (lp))))))))))
   
 
index d0218d360c91c1e583d211b23c0c81127b39d903..2d90554c154cf70796c4a0621da9312f75c02230 100644 (file)
@@ -67,7 +67,7 @@
 (mk-biop1 b0 <= __lt__)
 (mk-biop1 b0 >= __gt__)
 (mk-biop2 b0 rexpt expt __pow__ __rpow__)
 (mk-biop1 b0 <= __lt__)
 (mk-biop1 b0 >= __gt__)
 (mk-biop2 b0 rexpt expt __pow__ __rpow__)
-(b0 equal?)
+(b0 py-equal?)
 
 (define-method (py-lshift (o1 <integer>) (o2 <integer>))
   (ash o1 o2))
 
 (define-method (py-lshift (o1 <integer>) (o2 <integer>))
   (ash o1 o2))
index d69b7c9e4ec7aa5dad7365068df3a5a654c76460..ef4abe7cb66b41d32ddf7fa5189f253d31555f5e 100644 (file)
       (let* ((d (slot-ref self 'dict))
              (t (slot-ref d    't)))
         (not (eq? miss (py-hash-ref t x miss))))))
       (let* ((d (slot-ref self 'dict))
              (t (slot-ref d    't)))
         (not (eq? miss (py-hash-ref t x miss))))))
-                
+
+  (define __eq__
+    (lambda (self x)
+      (and
+       (is-a? x <p>)
+       (eq? (ref self '__class__ 1) (ref x '__class__ 2))
+       (equal? (ref self 'd 1)      (ref x 'd 2)))))
+                 
   (define __iter__
     (make-generator (self)
         (lambda (yield self)
   (define __iter__
     (make-generator (self)
         (lambda (yield self)
index d8f4da71bbce9983927ae4499b2d8510d1be28c8..16d9d0b9cdfd17eded563d76618b0cb3e46cfca7 100644 (file)
 
 (define-method (pyhash (o <py-string>)) (hash (slot-ref o 'str) pyhash-N))
 
 
 (define-method (pyhash (o <py-string>)) (hash (slot-ref o 'str) pyhash-N))
 
-(define-method (equal? (o <py-string>) x)
+(define-method (py-equal? (o <py-string>) x)
   (equal? (slot-ref o 'str) x))
   (equal? (slot-ref o 'str) x))
-(define-method (equal? x (o <py-string>))
+(define-method (py-equal? x (o <py-string>))
   (equal? (slot-ref o 'str) x))
 
 (define-class <string-iter> (<py-string>) str i d)
   (equal? (slot-ref o 'str) x))
 
 (define-class <string-iter> (<py-string>) str i d)
index 87a6ed0599143497caa4fea1e11cf9eef06bc8d3..5362cc9f640de9f4b2b7c24f3c530f9713eed8f1 100644 (file)
@@ -9,8 +9,8 @@
 (define-class <py-tuple> () l)
 (define-method (py-hash (o <py-tuple>)) (py-hash (slot-ref o 'l)))
 (define-method (py-class (o <py-tuple>) tuple))
 (define-class <py-tuple> () l)
 (define-method (py-hash (o <py-tuple>)) (py-hash (slot-ref o 'l)))
 (define-method (py-class (o <py-tuple>) tuple))
-(define-method (equal? (o1 <py-tuple>) o2) (equal? (slot-ref o1 'l) o2))
-(define-method (equal? o1 (o2 <py-tuple>)) (equal? o1 (slot-ref o2 'l)))
+(define-method (py-equal? (o1 <py-tuple>) o2) (equal? (slot-ref o1 'l) o2))
+(define-method (py-equal? o1 (o2 <py-tuple>)) (equal? o1 (slot-ref o2 'l)))
 (define-method (wrap-in (o <py-tuple>))
   (wrap-in (slot-ref o 'l)))
 
 (define-method (wrap-in (o <py-tuple>))
   (wrap-in (slot-ref o 'l)))
 
index c0dae32797b593c3347ea7162efbc9e21ca789bb..d7ca1a3d3eed9c4b7a2cf06d644abffd8ae1c93c 100644 (file)
@@ -2,6 +2,7 @@
   #:use-module (oop goops)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
   #:use-module (oop goops)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
+  #:replace (equal?)
   #:export (set ref make-pf <p> <py> <pf> <pyf> <property>
                 call with copy fset fcall make-p put put!
                 pcall pcall! get fset-x pyclass? refq
   #:export (set ref make-pf <p> <py> <pf> <pyf> <property>
                 call with copy fset fcall make-p put put!
                 pcall pcall! get fset-x pyclass? refq
@@ -11,7 +12,7 @@
                 def-py-class  mk-py-class  make-py-class
                 define-python-class get-type py-class
                 object-method class-method static-method
                 def-py-class  mk-py-class  make-py-class
                 define-python-class get-type py-class
                 object-method class-method static-method
-                py-super-mac py-super
+                py-super-mac py-super py-equal?
                 *class* *self*
                 ))
 #|
                 *class* *self*
                 ))
 #|
@@ -891,3 +892,17 @@ explicitly tell it to not update etc.
              (lp n r)
              (lp n (cons x r))))
        (reverse r))))
              (lp n r)
              (lp n (cons x r))))
        (reverse r))))
+
+(define-method (py-equal? (x <p>)  y)
+  (aif it (ref x '__eq__)
+       (it y)
+       (next-method)))
+
+(define-method (py-equal? y (x <p>))
+  (aif it (ref x '__eq__)
+       (it y)
+       (next-method)))
+
+(define-method (py-equal? x y) ((@ (guile) equal?) x y))
+
+(define (equal? x y) (or (eq? x y) (py-equal? x y)))