diff options
| -rw-r--r-- | modules/language/python/hash.scm | 48 | ||||
| -rw-r--r-- | modules/language/python/module/python.scm | 133 | ||||
| -rw-r--r-- | modules/language/python/util.scm | 2 |
3 files changed, 183 insertions, 0 deletions
diff --git a/modules/language/python/hash.scm b/modules/language/python/hash.scm new file mode 100644 index 0000000..ca5e32e --- /dev/null +++ b/modules/language/python/hash.scm @@ -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 index 0000000..4159d91 --- /dev/null +++ b/modules/language/python/module/python.scm @@ -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 index 0000000..40206f0 --- /dev/null +++ b/modules/language/python/util.scm @@ -0,0 +1,2 @@ +(define-module (language python util) + #:export ()) |