diff options
author | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2017-10-21 16:16:02 +0200 |
---|---|---|
committer | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2017-10-21 16:16:02 +0200 |
commit | 79f06168aa626017b56c67f7ea8f101f3d15e5d2 (patch) | |
tree | 66822e7b3bcda949a7455ae7bd56d8d39f39c637 /modules/language | |
parent | e89fa22f6521aeaa03954ae5a7dcb99ed608ff28 (diff) |
refactoring functional objects
Diffstat (limited to 'modules/language')
-rw-r--r-- | modules/language/python/compile.scm | 38 | ||||
-rw-r--r-- | modules/language/python/dir.scm | 73 | ||||
-rw-r--r-- | modules/language/python/eval.scm | 1 | ||||
-rw-r--r-- | modules/language/python/list.scm | 12 | ||||
-rw-r--r-- | modules/language/python/module/python.scm | 18 | ||||
-rw-r--r-- | modules/language/python/set.scm | 4 |
6 files changed, 67 insertions, 79 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index a040c7d..10320f5 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -407,7 +407,7 @@ '())))) (define (kw->li dict) - (for ((k v : dict) (l '())) + (for ((k v : dict)) ((l '())) (cons* v (symbol->keyword (string->symbol k)) l) #:final (reverse l))) @@ -528,12 +528,12 @@ `(,s/d ,v (,(C 'setwrap) ,u))) (if op `(,s/d ,(exp vs kind) - (,(O 'fset-x) ,v (list ,@(map q addings)) + (,(C 'fset-x) ,v ,addings (,(C 'setwrap) (,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u)))) `(,s/d ,(exp vs kind) - (,(O 'fset-x) ,v (list ,@(map q addings)) + (,(C 'fset-x) ,v ,addings (,(C 'setwrap) ,u))))) (if (null? addings) @@ -757,26 +757,24 @@ r)) (class (exp vs class)) (parents (match parents - (() - (cons '() '())) - (#f - (cons '() '())) + (() #f) + (#f #f) ((#:arglist . _) - (get-addings vs (list parents))))) - (is-func (is-functional parents)) - (parents (filt parents))) + (get-addings vs (list parents)))))) `(define ,class (,(C 'class-decor) ,decor (,(C 'with-class) ,class - (,(mk-p-class - ,class - (,(C 'ref-x) ,(C 'arglist->pkw) ,@parents) + (,(C 'mk-p-class) + ,class + ,(if parents + `(,(C 'ref-x) ,(C 'arglist->pkw) ,@parents) + `(,(G 'cons) '() '())) ,@(match (filter-defs (exp vs defs)) (('begin . l) l) ((('begin . l)) l) - (l l)))))))))))) + (l l))))))))))) (#:scm ((_ (#:string _ s)) (with-input-from-string s read))) @@ -1702,9 +1700,9 @@ ((_ v (#:fast-id f _) . l) (ref-x (f v) . l)) ((_ v (#:identifier x) . l) - (ref-x (refq v x) . l)) + (ref-x (ref v x) . l)) ((_ v (#:identifier x) . l) - (ref-x (refq v x) . l)) + (ref-x (ref v x) . l)) ((_ v (#:call-obj x) . l) (ref-x (x v) . l)) ((_ v (#:call x ...) . l) @@ -1721,7 +1719,7 @@ (define-syntax del-x (syntax-rules () ((_ v (#:identifier x)) - (ref-x (refq v 'x))) + (ref-x (ref v 'x))) ((_ v (#:call-obj x)) (values)) ((_ v (#:call x ...)) @@ -1738,6 +1736,11 @@ ((_ v (a ... b) val) (set-x-2 (ref-x v a ...) b val)))) +(define-syntax fset-x + (syntax-rules () + ((_ v ((#:identifier x) ...) val) + ((@ (oop pf-objects) fset-x) v (list x ...) val)))) + (define-syntax set-x-2 (syntax-rules () ((_ v (#:fastfkn-ref f id) val) @@ -1775,3 +1778,4 @@ (syntax-rules () ((_ s c) (syntax-parameterize ((*class* (lambda (x) #'s))) c)))) + diff --git a/modules/language/python/dir.scm b/modules/language/python/dir.scm index 30e47ac..da07642 100644 --- a/modules/language/python/dir.scm +++ b/modules/language/python/dir.scm @@ -15,23 +15,24 @@ (define-method (dir) (pylist)) -(define (get-from-class c f) - (let lp ((c c)) - (hash-for-each f (slot-ref c 'h)) - (let lpp ((pl (ref c '__parents__))) - (if (pair? pl) - (begin - (lp (car pl)) - (lpp (cdr pl))))))) +(define (chash-for-each f c) + (let ((h (slot-ref c 'h))) + (if (is-a? c <pf>) + (let ((hh (make-hash-table))) + (vhash-fold + (lambda (k v s) + (when (not (hash-ref hh k)) + (hash-set! hh k #t) + (f k v)) + s) #f h)) + (hash-for-each f h)))) -(define (get-from-class-f c f) - (let lp ((c c)) - (vhash-fold f 0 (slot-ref c 'h)) - (let lpp ((pl (ref c '__parents__))) - (if (pair? pl) - (begin - (lp (car pl)) - (lpp (cdr pl))))))) +(define (get-from-class c f) + (let lp ((pl (ref c '__mro__))) + (if (pair? pl) + (begin + (chash-for-each f (car pl)) + (lp (cdr pl)))))) (define-method (dir (o <p>)) (if (not (pyclass? o)) @@ -47,7 +48,7 @@ (c (ref o '__class__)) (l '()) (f (lambda (k v) (set! l (cons k l))))) - (hash-for-each f (slot-ref o 'h)) + (chash-for-each f o) (get-from-class c f) (hash-for-each (lambda (k v) (pylist-append! l k)) h) (to-pylist (map symbol->string (sort l <)))))) @@ -59,32 +60,6 @@ (hash-for-each (lambda (k v) (set! l (cons k l))) h) (to-pylist (map symbol->string (sort l <)))))) -(define-method (dir (o <pf>)) - (if (not (pyclass? o)) - (aif it (ref o '__dir__) - (it) - (aif it (ref o '__dict__) - (let ((l (pylist))) - (for ((k v : it)) () - (pylist-append! l k)) - (pylist-sort! l) - l) - (let* ((h (make-hash-table)) - (c (ref o '__class__)) - (l '()) - (f (lambda (k v s) (set! l (cons k l))))) - (vhash-fold f 0 (slot-ref o 'h)) - (get-from-class-f c f) - (hash-for-each (lambda (k v) (pylist-append! l k)) h) - (to-pylist (map symbol->string (sort l <)))))) - (let* ((h (make-hash-table)) - (c o) - (l '()) - (f (lambda (k v s) (pylist-append! h k #t)))) - (get-from-class-f c f) - (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>)) (let ((l1 (pk (pylist-listing)))) (if (is-a? o <p>) @@ -172,6 +147,16 @@ (let ((ret (to-pylist l))) (pylist-sort! ret) ret))) - + +(define-method (dir (o <procedure>)) + (let ((ret (to-pylist (map (lambda (x) + (let ((x (car x))) + (if (symbol? x) + (symbol->string x) + x))) + (procedure-properties o))))) + (pylist-sort! ret) + ret)) + diff --git a/modules/language/python/eval.scm b/modules/language/python/eval.scm index 999acc0..53b4bce 100644 --- a/modules/language/python/eval.scm +++ b/modules/language/python/eval.scm @@ -1,5 +1,4 @@ (define-module (language python eval) - #:use-module #:use-module (parser stis-parser lang python3-parser) #:use-module (language python exceptions) #:use-module ((ice-9 local-eval) #:select ((the-environment . locals))) diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm index ded6b15..34c9ba0 100644 --- a/modules/language/python/list.scm +++ b/modules/language/python/list.scm @@ -11,7 +11,7 @@ #:use-module (language python try) #:use-module (language python exceptions) #:export (to-list to-pylist <py-list> - pylist-ref pylist-set! pylist-append! + pylist-append! pylist-slice pylist-subset! pylist-reverse! pylist-pop! pylist-count pylist-extend! len in pylist-insert! pylist-remove! pylist-sort! @@ -822,11 +822,11 @@ (let ((n1 (len o1)) (n2 (len o2))) (for ((x1 : o1) (x2 : o2)) () - (if (> x1 x2) - (break #t)) - #:final - (>= n1 n2)))) - + (if (> x1 x2) + (break #t)) + #:final + (>= n1 n2)))) + (define-python-class list (<py-list>) (define __init__ (letrec ((__init__ diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm index bd68841..02f4e5e 100644 --- a/modules/language/python/module/python.scm +++ b/modules/language/python/module/python.scm @@ -3,8 +3,8 @@ #:use-module (ice-9 match) #:use-module (ice-9 readline) #:use-module ((oop pf-objects) #:select - (<p> <property> class-method static-method refq - py-super-mac)) + (<p> <property> class-method static-method ref + py-super-mac type object pylist-ref)) #:use-module (language python exceptions ) #:use-module (language python def ) #:use-module (language python for ) @@ -35,7 +35,7 @@ SyntaxError len dir next dict None property range tuple bytes bytearray eval locals globals - compile exec type + compile exec type object ) #:export (print repr complex float int @@ -76,7 +76,7 @@ (define-method (callable (x <applicable> )) #t) (define-method (callable (x <primitive-generic>)) #t) (define-method (callable (x <p>)) - (refq x '__call__)) + (ref x '__call__)) (define chr integer->char) @@ -100,17 +100,17 @@ (define miss ((@ (guile) list) 'miss)) (define* (getattr a b #:optional (k miss)) - (let ((r (refq a (symbol->string b) k))) + (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 (refq a (symbol->string b) miss))) + (let ((r (ref a (symbol->string b) miss))) (not (eq? r miss)))) (define-method (issubclass (sub <p>) (cls <p>)) - (aif it (ref cl '__subclasscheck__) + (aif it (ref cls '__subclasscheck__) (it sub) (is-a? (ref sub '__goops__) (ref cls '__goops__)))) @@ -121,13 +121,13 @@ (or (isinstance o (car cl)) (isinstance o (cdr cl))) - (is-a? (ref (ref o '__class__) '__goops__) cl))) + (is-a? (ref (ref o '__class__) '__goops__) cl)))) (define iter (case-lambda ((o) (aif it (wrap-in o) it - (aif get (refq o '__getitem__) + (aif get (ref o '__getitem__) (make-generator iter (lambda (yield) (for () ((i 0)) diff --git a/modules/language/python/set.scm b/modules/language/python/set.scm index ef4abe7..e9d7c63 100644 --- a/modules/language/python/set.scm +++ b/modules/language/python/set.scm @@ -23,7 +23,7 @@ (slot-set! self 'dict d) (for ((y : x)) () (pylist-set! d y #t)))))) - + (define pop (lambda (self) (call-with-values (lambda () (pylist-pop! (slot-ref self 'dict))) @@ -32,7 +32,7 @@ (define add (lambda (self k) (pylist-set! (slot-ref self 'dict) k #t))) - + (define copy (lambda (self) (let ((dict (py-copy (slot-ref self 'dict)))) |