diff options
author | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2017-09-28 00:33:12 +0200 |
---|---|---|
committer | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2017-09-28 00:33:12 +0200 |
commit | 4deff738d3727dbe71a66f6f052822ea7cb10963 (patch) | |
tree | afb7819e28737a2c7897dbb84107446a9f906a01 /modules/language | |
parent | 67b8025ea15e5df03671bef9ebe48c00e121983a (diff) |
set theory
Diffstat (limited to 'modules/language')
-rw-r--r-- | modules/language/python/compile.scm | 72 | ||||
-rw-r--r-- | modules/language/python/dict.scm | 3 | ||||
-rw-r--r-- | modules/language/python/exceptions.scm | 3 | ||||
-rw-r--r-- | modules/language/python/list.scm | 5 | ||||
-rw-r--r-- | modules/language/python/set.scm | 135 |
5 files changed, 112 insertions, 106 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index 8007449..fdc6309 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -11,12 +11,27 @@ #:use-module (language python list) #:use-module (language python string) #:use-module (language python def) - #:use-module (language python set) #:use-module (ice-9 pretty-print) #:export (comp)) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) +(define-inlinable (C x) `(@@ (language python compile) ,x)) +(define-inlinable (Y x) `(@@ (language python yield) ,x)) +(define-inlinable (T x) `(@@ (language python try) ,x)) +(define-inlinable (F x) `(@@ (language python for) ,x)) +(define-inlinable (E x) `(@@ (language python exceptions) ,x)) +(define-inlinable (L x) `(@@ (language python list) ,x)) +(define-inlinable (A x) `(@@ (language python array) ,x)) +(define-inlinable (S x) `(@@ (language python string) ,x)) +(define-inlinable (Se x) `(@@ (language python set) ,x)) +(define-inlinable (D x) `(@@ (language python def) ,x)) +(define-inlinable (Di x) `(@@ (language python dict) ,x)) +(define-inlinable (O x) `(@@ (oop pf-objects) ,x)) +(define-inlinable (G x) `(@ (guile) ,x)) + + + (define s/d 'set!) (define-syntax clear-warning-data @@ -78,34 +93,13 @@ (define (gen-sel vs e item) (match e + (#f item) ((#:cfor for-e in-e cont) - `(,(F 'for) ((,@(map (g vs exp) for-e) : ,(exp vs in))) - ,(if cont - (gen-sel vs cont item) - item))) + `(,(F 'for) ((,@(map (g vs exp) for-e) : ,(exp vs in-e))) () + ,(gen-sel vs cont item))) ((#:cif cif cont) `(if ,(exp vs cif) - ,(if cont - (gen-sel vs cont item) - item))))) - -(define (gen-sel vs e item) - (match e - ((#:cif . l) - (gen-cif vs e item - -(define-inlinable (C x) `(@@ (language python compile) ,x)) -(define-inlinable (Y x) `(@@ (language python yield) ,x)) -(define-inlinable (T x) `(@@ (language python try) ,x)) -(define-inlinable (F x) `(@@ (language python for) ,x)) -(define-inlinable (E x) `(@@ (language python exceptions) ,x)) -(define-inlinable (L x) `(@@ (language python list) ,x)) -(define-inlinable (A x) `(@@ (language python array) ,x)) -(define-inlinable (S x) `(@@ (language python string) ,x)) -(define-inlinable (D x) `(@@ (language python def) ,x)) -(define-inlinable (Di x) `(@@ (language python dict) ,x)) -(define-inlinable (O x) `(@@ (oop pf-objects) ,x)) -(define-inlinable (G x) `(@ (guile) ,x)) + ,(gen-sel vs cont item))))) (define (union as vs) (let lp ((as as) (vs vs)) @@ -396,7 +390,7 @@ (cdr addings))) (cons v addings))) (v (car v.add)) - (addings (cdr addings)) + (addings (cdr v.add)) (addings (get-addings vs addings))) (define q (lambda (x) `',x)) (if kind @@ -947,8 +941,8 @@ (#:list ((_ x (and e (#:cfor . _))) (let ((l (gensym "l"))) - `(let ((,l ,((L 'to-pylist) '()))) - ,(gen-sel vs e `(pylist-append ,l ,(exp vs x))) + `(let ((,l (,(L 'to-pylist) '()))) + ,(gen-sel vs e `(,(L 'pylist-append!) ,l ,(exp vs x))) ,l))) ((_ . l) @@ -965,7 +959,7 @@ `(cons ,(exp vs x) ,(lp l)))))))) (#:tuple ((_ x (and e (#:cfor . _))) - (let ((l (gensym "l"))) + (let ((l (gensym "l"))) `(let ((,l '())) ,(gen-sel vs e `(set! ,l (cons ,(exp vs x) ,l))) (reverse ,l)))) @@ -1042,7 +1036,7 @@ ((_ (#:e k . v) (and e (#:cfor . _))) (let ((dict (gensym "dict"))) `(let ((,dict (,(Di 'make-py-hashtable)))) - ,(gen-sel vs e `(pylist-set! ,dict ,(exp vs k) ,(exp vs v))) + ,(gen-sel vs e `(,(L 'pylist-set!) ,dict ,(exp vs k) ,(exp vs v))) ,dict))) ((_ (#:e k . v) ...) @@ -1051,21 +1045,21 @@ ,@(map (lambda (k v) `(,(L 'pylist-set!) ,dict ,(exp vs k) ,(exp vs v))) k v) - ,dict)))) + ,dict))) - ((_ k (and e (#:cfor . _))) + ((_ k (and e (#:cfor . _))) (let ((dict (gensym "dict"))) `(let ((,dict (,(Se 'set)))) - ,(gen-sel vs e `(,(O 'ref) ,dict 'add) ,(exp vs k)) + ,(gen-sel vs e `((,(O 'ref) ,dict 'add) ,(exp vs k))) ,dict))) - ((_ k ...) + ((_ k ...) (let ((set (gensym "dict"))) `(let ((,set (,(Se 'set)))) - ,@(map (lambda (k v) - `((,(O 'ref) 'add) ,set ,(exp vs k))) - k v) - ,dict)))) + ,@(map (lambda (k) + `((,(O 'ref) ,set 'add) ,(exp vs k))) + k) + ,set)))) (#:comp diff --git a/modules/language/python/dict.scm b/modules/language/python/dict.scm index b24031b..6c88ee4 100644 --- a/modules/language/python/dict.scm +++ b/modules/language/python/dict.scm @@ -10,10 +10,11 @@ #:use-module (ice-9 control) #:use-module (oop goops) #:use-module (oop pf-objects) - #:export (make-py-hashtable + #:export (make-py-hashtable <py-hashtable> 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 )) (define (h x n) (modulo (py-hash x) n)) diff --git a/modules/language/python/exceptions.scm b/modules/language/python/exceptions.scm index a9b2c14..4fffdab 100644 --- a/modules/language/python/exceptions.scm +++ b/modules/language/python/exceptions.scm @@ -2,7 +2,7 @@ #:use-module (oop pf-objects) #:use-module (oop goops) #:export (StopIteration GeneratorExit RuntimeError - Exception ValueError + Exception ValueError TypeError IndexError KeyError None)) @@ -15,6 +15,7 @@ (define ValueError 'ValueError) (define None 'None) (define KeyError 'KeyError) +(define TypeError 'TypeError) (define-python-class Exception () (define __init__ diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm index 8514310..f74e2b1 100644 --- a/modules/language/python/list.scm +++ b/modules/language/python/list.scm @@ -8,7 +8,7 @@ #:use-module (language python for) #:use-module (language python try) #:use-module (language python exceptions) - #:export (to-list to-pylist + #:export (to-list to-pylist <py-list> pylist-ref pylist-set! pylist-append! pylist-slice pylist-subset! pylist-reverse! pylist-pop! pylist-count pylist-extend! len in @@ -630,3 +630,6 @@ #t (lp (+ i 1))) #f))) + +(define-method (in x (o <p>)) + ((ref o '__contains__) x)) diff --git a/modules/language/python/set.scm b/modules/language/python/set.scm index 5a9cddc..3164c8f 100644 --- a/modules/language/python/set.scm +++ b/modules/language/python/set.scm @@ -1,15 +1,19 @@ -(define-module (language prolog set) +(define-module (language python set) #:use-module (oop pf-objects) #:use-module (oop goops) - #:use-module (language prolog dict) - #:use-module (language prolog for) - #:use-module (language prolog try) - #:use-module (language prolog list) - #:(set)) + #:use-module (language python exceptions) + #:use-module (language python dict) + #:use-module (language python for) + #:use-module (language python try) + #:use-module (language python list) + #:use-module (language python yield) + #:export(set)) -(define-class <set> () 'dict) +(define-class <set> () dict) -(define-class set (<set>) +(define miss (list 'miss)) + +(define-python-class set (<set>) (define __init__ (case-lambda ((self) @@ -20,38 +24,38 @@ (cond ((or (is-a? x <py-list>) (pair? x) (string? x)) (for ((y : x)) () - (pyhash-set! d y #t))) - ((is-a? x <py-hash>) + (pylist-set! d y #t))) + ((is-a? x <py-hashtable>) (slot-set! self 'dict x)) (else (raise TypeError))))))) (define pop (lambda (self) - (call-with-values (lambda () (pyhash-pop! (slot-ref self 'dict))) + (call-with-values (lambda () (pylist-pop! (slot-ref self 'dict))) (lambda (k v) k)))) (define add (lambda (self k) - (pyhash-set! (slot-ref self 'dict) k #t))) + (pylist-set! (slot-ref self 'dict) k #t))) (define copy (lambda (self) - (let ((dict (pyhash-copy (slot-ref self 'dict)))) + (let ((dict (py-copy (slot-ref self 'dict)))) (set dict)))) (define difference (lambda (self . l) (let* ((d (slot-ref self 'dict)) - (r (pyhash-copy d))) + (r (py-copy d))) (let lp ((l l)) (if (pair? l) (begin (for ((x : (car l))) () - (when (not (eq? miss (pyhash-ref d x miss))) - (pyhash-remove! r x))) + (when (in x d) + (pylist-delete! r x))) (lp (cdr l))))) - r))) + (set r)))) (define difference_update (lambda (self . l) @@ -60,8 +64,8 @@ (if (pair? l) (begin (for ((x : (car l))) () - (when (not (eq? miss (pyhash-ref d x miss))) - (pyhash-remove! r x))) + (when (in x r) + (pylist-delete! r x))) (lp (cdr l))))) (values)))) @@ -71,28 +75,28 @@ (let lp ((l l)) (if (pair? l) (begin - (pyhash-remove! d (car l)) + (pylist-delete! r (car l)) (lp (cdr l)))))))) (define intersection (lambda (self . l) (let* ((d (slot-ref self 'dict)) - (r (pyhash-copy d))) + (r (py-copy d))) (let lp ((l l)) (if (pair? l) (let ((y (car l))) - (for ((k : r)) ((dels '())) - (if (not (eq? miss (pylist-ref y k miss))) - (cons k dels) - dels) - #:finally + (for ((k v : r)) ((dels '())) + (if (not (__contains__ y k)) + (cons k dels) + dels) + #:final (let lp ((dels dels)) (if (pair? dels) (begin - (pylist-remove! r (car dels)) + (pylist-delete! r (car dels)) (lp (cdr dels)))))) (lp (cdr l))))) - r))) + (set r)))) (define intersection_update (lambda (self . l) @@ -100,15 +104,15 @@ (let lp ((l l)) (if (pair? l) (let ((y (car l))) - (for ((k : r)) ((dels '())) - (if (not (eq? miss (pylist-ref y k miss))) + (for ((k v : r)) ((dels '())) + (if (not (__contains__ y k)) (cons k dels) dels) - #:finally + #:final (let lp ((dels dels)) (if (pair? dels) (begin - (pylist-remove! r (car dels)) + (pylist-delete! r (car dels)) (lp (cdr dels)))))) (lp (cdr l)))))))) @@ -121,34 +125,34 @@ (let ((xx x)) (set! x r) (set! r xx))) - (for ((k : r)) () - (if (not (eq? miss (pylist-ref x 'k miss))) + (for ((k v : r)) () + (if (in k x) (break #f)) - #:finally + #:final #t)))) (define issubset (lambda (self x) (let* ((r (slot-ref self 'dict))) - (for ((k : r)) - (if (eq? miss (pylist-ref x 'k miss)) + (for ((k v : r)) () + (if (not (__contains__ x k)) (break #f)) - #:finally + #:final #t)))) (define issuperset (lambda (self x) - (let* ((r (slot-ref self 'dict))) - (for ((x : r)) - (if (eq? miss (pylist-ref r 'k miss)) + (let* ((r (slot-ref self 'dict))) + (for ((x v : r)) () + (if (not (in x r)) (break #f)) - #:finally + #:final #t)))) (define remove (lambda (self x) (let* ((r (slot-ref self 'dict))) - (if (eq? miss (pylist-ref r x miss)) + (if (not (in x r)) (raise KeyError "missing key in set at remove") (pylist-delete! r x))))) @@ -164,14 +168,14 @@ (define union (lambda (self . l) (let* ((d (slot-ref self 'dict)) - (r (pyhash-copy d))) + (r (py-copy d))) (let lp ((l l)) (if (pair? l) (begin (for ((k : (car l))) () (pylist-set! r k #t)) (lp (cdr l))) - r))))) + (set r)))))) (define update (lambda (self . l) @@ -179,28 +183,31 @@ (let lp ((l l)) (if (pair? l) (begin - (for ((k : (car l))) () + (for ((k v : (car l))) () (pylist-set! r k #t)) (lp (cdr l))) (values)))))) + + (define __repr__ + (lambda (self) + (let* ((r (py-keys (slot-ref self 'dict))) + (n (len r)) + (l (to-list r))) + (cond + ((= n 0) + (format #f "set([])")) + (else + (format #f "set([~a~{, ~a~}])" (car l) (cdr l))))))) - (define __repr__(self): - (let ((r (py-keys (slot-ref self 'dicy))) - (n (len r)) - (l (to-list r))) - (cond - ((= n 0) - (format #f "set([])")) - (else - (format #f "set([~a ~{, ~a~}])" (car l) (cdr l)))))) - + (define __contains__ + (lambda (self x) + (let* ((d (slot-ref self 'dict)) + (t (slot-ref d 't))) + (not (eq? miss (py-hash-ref t x miss)))))) + (define __iter__ (make-generator (self) - (lambda (yield self) - (for ((k : (slot-ref self 'dict))) () - (yield k) - (values)))))) - - - - + (lambda (yield self) + (for ((k v : (slot-ref self 'dict))) () + (yield k) + (values)))))) |