adding missing files
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 4 Oct 2017 14:17:28 +0000 (16:17 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 4 Oct 2017 14:17:28 +0000 (16:17 +0200)
modules/language/python/hash.scm [new file with mode: 0644]
modules/language/python/module/python.scm [new file with mode: 0644]
modules/language/python/util.scm [new file with mode: 0644]

diff --git a/modules/language/python/hash.scm b/modules/language/python/hash.scm
new file mode 100644 (file)
index 0000000..ca5e32e
--- /dev/null
@@ -0,0 +1,48 @@
+(define-module (language python hash)
+  #:use-module (oop goops)
+  #:use-module (oop pf-objects)
+  #:export (py-hash complexity xy pyhash-N))
+
+(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
+
+(define N #xefffffffffffffff)
+(define pyhash-N N)
+
+(define-inlinable (xy v seed)
+  (modulo
+   (logxor seed
+           (+ (py-hash v)
+              #x9e3779b9
+              (ash seed 6)
+              (ash seed -2)))
+   N))
+
+(define complexity 10)
+
+;; The default is to use guile's hash function
+(define-method (py-hash x) (hash x N))
+
+(define-method (py-hash (x <pair>))
+  (define i 0)
+  (let lp ((x x))      
+    (if (< i complexity)
+        (begin
+          (set! i (+ i 1))
+          (if (pair? x)
+              (xy (lp (car x)) (lp (cdr x)))
+              (py-hash x)))
+        0)))
+         
+(define-method (py-hash (x <vector>))
+  (let ((n (min complexity (vector-length x))))
+    (let lp ((i 0) (s 0))
+      (if (< i n)
+          (lp (+ i 1)
+              (xy (py-hash (vector-ref x i)) s))
+          s))))
+
+(define-method (py-hash (x <p>))
+  (aif it (ref x '__hash__)
+       (it)
+       (hash x complexity)))
+
diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm
new file mode 100644 (file)
index 0000000..4159d91
--- /dev/null
@@ -0,0 +1,133 @@
+(define-module (language python module python)
+  #:use-module (oop goops)
+  #:use-module ((oop pf-objects) #:select
+                (<p> class-method static-method refq))
+  #:use-module (language python exceptions       )
+  #:use-module (language python for              )
+  #:use-module (language python try              )
+  #:use-module (language python yield            )
+  #:use-module (language python list             )
+  #:use-module (language python dict             )
+  #:use-module (language python set              )
+  #:use-module (language python compile          )
+  #:use-module (language python string           )
+  #:use-module (language python set              )
+  #:use-module (language python number           )
+  #:use-module (language python dir              )
+  #:use-module (language python hash             )
+
+  #:replace (list abs)
+  #:re-export (Exception StopIteration send sendException next
+                         GeneratorExit sendClose RuntimeError
+                         len dir next dict)
+  #:export (print repr complex float int round
+                  set all any bin callable
+                  chr classmethod staticmethod
+                  divmod enumerate filter format
+                  getattr hasattr hash hex isinstance
+                  iter map))
+
+(define print
+  (case-lambda
+    (()  (format #t "~%"))
+    ((x) (format #t "~s~%" x))
+    (l   (format #t "~s~%" l))))
+
+(define (repr x) (format #f "~a" x))
+(define abs     py-abs)
+(define list    pylist)
+(define string  pystring)
+(define complex py-complex)
+(define float   py-float)
+(define int     py-int)
+(define round   py-round)
+(define set     py-set)
+(define all     py-all)
+(define any     py-any)
+(define bin     py-bin)
+(define divmod  py-divmod)
+(define format  py-format)
+(define hash    py-hash)
+(define hex     py-hex)
+
+(define-method (callable  x                     ) #f)
+(define-method (callable (x <procedure>        )) #t)
+(define-method (callable (x <procedure-class>  )) #t)
+(define-method (callable (x <applicable>       )) #t)
+(define-method (callable (x <primitive-generic>)) #t)
+(define-method (callable (x <p>))
+  (ref x '__call__))
+                            
+(define chr integer->char)
+  
+(define classmethod  class-method)
+(define staticmethod static-method)
+
+(define (enumerate l)
+  (make-generator enumerate
+    (lambda (yield)
+      (for ((x : l)) ((i 0))
+           (yield i x)
+           (+ i 1)))))
+
+(define (filter f l)
+  (make-generator enumerate
+    (lambda (yield)
+      (for ((x : l)) ()
+           (if (f x)
+               (yield x))))))
+
+(define miss (list 'miss))
+
+(define* (getattr a b #:optional (k miss))
+  (let ((r (ref a (symbol->string b) k)))
+    (if (eq? r miss)
+        (raise AttributeError "object/class ~a is missing attribute ~a" a b)
+        r)))
+
+(define (hasattr a b)
+  (let ((r (ref a (symbol->string b) k)))
+    (not (eq? r miss))))
+  
+(define (isinstance o cl)
+  (if (pair? cl)
+      (or
+       (isinstance o (car cl))
+       (isinstance o (cdr cl)))
+      (is-a? o cl)))
+
+(define iter
+  (case-lambda
+    ((o) (aif it (wrap-in o)
+              it
+              (aif get (ref o '__getitem__)
+                   (make-generator iter
+                                   (lambda (yield)
+                                     (for () (i 0)
+                                          (yield (get i))
+                                          (+ i 1))))
+                   (raise TypeError "not iterable" o))))
+    ((f sent)
+     (make-generator iter
+                     (lambda (yield)
+                       (for () ()
+                            (let ((r (f)))
+                              (if (equal? r sent)
+                                  (break)
+                                  (yield r)))))))))
+                               
+                                      
+       
+(define-syntax map
+  (lambda (x)
+    (syntax-case x ()
+      ((map f a ...)
+       (with-syntax (((x ...) (generate-temporaries #'(a ...))))
+         #'(make-generator map
+             (lambda (yield)
+               (for ((x : a) ...) () (yield (f x ...))))))))))
+                    
+
+
+
+                             
diff --git a/modules/language/python/util.scm b/modules/language/python/util.scm
new file mode 100644 (file)
index 0000000..40206f0
--- /dev/null
@@ -0,0 +1,2 @@
+(define-module (language python util)
+  #:export ())