diff options
Diffstat (limited to 'modules/language')
-rw-r--r-- | modules/language/python/compile.scm | 63 | ||||
-rw-r--r-- | modules/language/python/dict.scm | 42 | ||||
-rw-r--r-- | modules/language/python/list.scm | 93 | ||||
-rw-r--r-- | modules/language/python/module/python.scm | 8 | ||||
-rw-r--r-- | modules/language/python/number.scm | 42 | ||||
-rw-r--r-- | modules/language/python/string.scm | 11 |
6 files changed, 165 insertions, 94 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index c9acea1..c3a6493 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -223,7 +223,7 @@ (define fasthash (mkfast ;; General - ((__init__) (O 'init)) + ((__init__) (O 'py-init)) ((__getattr__) (O 'getattr)) ((__setattr__) (O 'setattr)) ((__delattr__) (O 'delattr)) @@ -722,18 +722,19 @@ (parents (filt parents))) `(define ,class (,(C 'class-decor) ,decor - (,(O kind) - ,class - ,(map (lambda (x) `(,(O 'get-class) ,x)) parents) - #:const - () - #:dynamic - ,(match (filter-defs (exp vs defs)) - (('begin . l) - l) - ((('begin . l)) - l) - (l l)))))))))) + (,(C 'with-class) ,class + (,(O kind) + ,class + ,(map (lambda (x) `(,(O 'get-class) ,x)) parents) + #:const + () + #:dynamic + ,(match (filter-defs (exp vs defs)) + (('begin . l) + l) + ((('begin . l)) + l) + (l l))))))))))) (#:scm ((_ (#:string _ s)) (with-input-from-string s read))) @@ -968,34 +969,38 @@ (,(D 'lam) (,@args ,@*f ,@**f) (,(C 'with-return) ,r ,(mk `(let ,(map (lambda (x) (list x #f)) ls) - ,(with-fluids ((return r)) - (exp ns code))))))))) + (,(C 'with-self) ,c? ,args + ,(with-fluids ((return r)) + (exp ns code)))))))))) `(define ,f (,(C 'def-decor) ,decor (,(D 'lam) (,@args ,@*f ,@**f) (,(C 'with-return) ,r ,(mk `(let ,(map (lambda (x) (list x #f)) ls) + (,(C 'with-self) ,c? ,args ,(with-fluids ((return r)) - (exp ns code))))))))) + (exp ns code)))))))))) (if y? `(define ,f (,(C 'def-decor) ,decor (,(C 'def-wrap) ,y? ,f ,ab (,(D 'lam) (,@args ,@*f ,@**f) - (,(C 'with-return) ,r + (,(C 'with-return) ,r (let ,(map (lambda (x) (list x #f)) ls) - ,(with-fluids ((return r)) - (mk - (exp ns code))))))))) + (,(C 'with-self) ,c? ,args + ,(with-fluids ((return r)) + (mk + (exp ns code)))))))))) `(define ,f (,(C 'def-decor) ,decor (,(D 'lam) (,@args ,@*f ,@**f) - (,(C 'with-return) ,r + (,(C 'with-return) ,r (let ,(map (lambda (x) (list x #f)) ls) - ,(with-fluids ((return r)) - (exp ns code))))))))))))) + (,(C 'with-self) ,c? ,args + ,(with-fluids ((return r)) + (exp ns code)))))))))))))) (#:global ((_ . _) @@ -1691,5 +1696,15 @@ ((_ () x) x) ((_ (f ... r) y) (def-decor (f ...) (r y))))) - +(define-syntax with-self + (syntax-rules () + ((_ #f _ c) + c) + ((_ _ (s . b) c) + (syntax-parameterize ((*self* (lambda (x) #'s))) c)))) + +(define-syntax with-class + (syntax-rules () + ((_ s c) + (syntax-parameterize ((*class* (lambda (x) #'s))) c)))) diff --git a/modules/language/python/dict.scm b/modules/language/python/dict.scm index 5b6567b..f4d13a5 100644 --- a/modules/language/python/dict.scm +++ b/modules/language/python/dict.scm @@ -17,6 +17,8 @@ py-hash-ref dict pyhash-listing )) +(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-hash-ref . l) @@ -155,15 +157,19 @@ (define-method (nm (o class) l ...) code ...) ... (define-method (nm (o <p>) l ...) - ((ref o 'n) l ...)))) + (aif it (ref o 'n) + (it l ...) + (next-method))))) ((_ (nm n o l ... . u) (class code ...) ...) (begin (define-method (nm (o class) l ... . u) code ...) ... (define-method (nm (o <p>) l ... . u) - (apply (ref o 'n) l ... u)))))) - - + (aif it (ref o 'n) + (apply it l ... u) + (next-method))))))) + + (define-py (py-copy copy o) (<hashtable> @@ -475,19 +481,21 @@ (define-python-class dict (<py-hashtable>) (define __init__ - (case-lambda - ((self) - (let ((r (make-py-hashtable))) - (slot-set! self 't (slot-ref r 't)) - (slot-set! self 'h (slot-ref r 'h)) - (slot-set! self 'n (slot-ref r 'n)))) - ((self x) - (__init__ self) - (if (is-a? x <py-hashtable>) - (hash-for-each - (lambda (k v) - (pylist-set! self k v)) - (slot-ref x 't))))))) + (letrec ((__init__ + (case-lambda + ((self) + (let ((r (make-py-hashtable))) + (slot-set! self 't (slot-ref r 't)) + (slot-set! self 'h (slot-ref r 'h)) + (slot-set! self 'n (slot-ref r 'n)))) + ((self x) + (__init__ self) + (if (is-a? x <py-hashtable>) + (hash-for-each + (lambda (k v) + (pylist-set! self k v)) + (slot-ref x 't))))))) + __init__))) (define (pyhash-listing) (let ((l (to-pylist diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm index 1a3e7c5..5b4daf0 100644 --- a/modules/language/python/list.scm +++ b/modules/language/python/list.scm @@ -29,7 +29,9 @@ (pylist-subset! o k (+ k 1) None pylist-null))) (define-method (pylist-delete! (o <p>) k) - ((ref o '__delitem__) k)) + (aif it (ref o '__delitem__) + (it k) + (next-method))) (define pylist-null (let ((o (make <py-list>))) @@ -53,7 +55,9 @@ x)) (define-method (to-list (x <p>)) - ((ref x '__tolist__ (lambda () (error "missing __tolist__ in object"))))) + (aif it (ref x '__tolist__) + (it) + (next-method))) (define-method (to-list (x <pair>)) @@ -125,7 +129,9 @@ (vector-ref o n)) (define-method (pylist-ref (o <p>) n) - ((ref o '__getitem__) n)) + (aif it (ref o '__getitem__) + (it n) + (next-method))) ;;; SET (define-method (pylist-set! (o <py-list>) nin val) @@ -143,11 +149,15 @@ (vector-set! o n val)) (define-method (pylist-set! (o <p>) n val) - ((ref o '__setitem__) n val)) + (aif it (ref o '__setitem__) + (it n val) + (next-method))) ;;SLICE (define-method (pylist-slice (o <p>) n1 n2 n3) - ((ref o '__getslice__) n1 n2 n3)) + (aif it (ref o '__getslice__) + (it n1 n2 n3) + (next-method))) (define-method (pylist-slice (o <py-list>) n1 n2 n3) (define N (slot-ref o 'n)) @@ -181,7 +191,9 @@ ;;SUBSET (define-method (pylist-subset! (o <p>) n1 n2 n3 val) - ((ref o '__setslice__) n1 n2 n3 val)) + (aif it (ref o '__setslice__) + (it n1 n2 n3 val) + (next-method))) (define-method (pylist-subset! (o <py-list>) n1 n2 n3 val) (define N (slot-ref o 'n)) @@ -247,7 +259,7 @@ (define-method (pylist-append! (o <p>) n . l) (aif it (ref o 'append) (apply it n l) - (error "no append"))) + (next-method))) @@ -368,7 +380,9 @@ (define-method (pylist-reverse! (o <p>) . l) - (apply (ref o 'reverse) l)) + (aif it (ref o 'reverse) + (apply it l) + (next-method))) ;;POP! (define-method (pylist-pop! (o <py-list>)) @@ -383,7 +397,9 @@ (raise IndexError "pop from empty list")))) (define-method (pylist-pop! (o <p>) . l) - (apply (ref o 'pop) l)) + (aif it (ref o 'pop) + (apply it l) + (next-method))) ;;COUNT (define-method (pylist-count (o <py-list>) q) @@ -416,7 +432,9 @@ sum))) (define-method (pylist-count (o <p>) . l) - (apply (ref o 'count) l)) + (aif it (ref o 'count) + (apply it l) + (next-method))) ;; extend! (define-method (pylist-extend! (o <py-list>) iter) @@ -424,7 +442,9 @@ (pylist-append! o x))) (define-method (pylist-extend! (o <p>) . l) - (apply (ref o 'extend) l)) + (aif it (ref o 'extend) + (apply it l) + (next-method))) ;; equal? (define-method (equal? (o1 <py-list>) (o2 <py-list>)) @@ -497,7 +517,10 @@ (pylist-append! o v))) (raise IndexError "Wrong index in insert")))) -(define-method (pylist-insert! (o <p>) . l) (apply (ref o 'insert) l)) +(define-method (pylist-insert! (o <p>) . l) + (aif it (ref o 'insert) + (apply it l) + (next-method))) ;;REMOVE @@ -512,7 +535,10 @@ (lp (+ i 1)))) (raise ValueError "list removal has no element to remove"))))) -(define-method (pylist-remove! (o <p>) . l) (apply (ref o 'remove) l)) +(define-method (pylist-remove! (o <p>) . l) + (aif it (ref o 'remove) + (apply it l) + (next-method))) ;; SORT! (define (id x) id) @@ -526,7 +552,10 @@ (lp (cdr l) (+ i 1)))))) l)) -(define-method (pylist-sort! (o <p>) . l) (apply (ref o 'sort) l)) +(define-method (pylist-sort! (o <p>) . l) + (aif it (ref o 'sort) + (apply it l) + (next-method))) ;; INDEX (define-method (pylist-index (o <py-list>) val . l) @@ -602,7 +631,10 @@ (raise ValueError "could not find value in index fkn"))) (raise IndexError "index out of scop in index fkn")))))) -(define-method (pylist-index (o <p>) . l) (apply (ref o 'index) l)) +(define-method (pylist-index (o <p>) . l) + (aif it (ref o 'index) + (apply it l) + (next-method))) #:len @@ -611,7 +643,10 @@ (define-method (len (v <vector>)) (vector-length v)) (define-method (len (s <string>)) (string-length s)) (define-method (len (o <py-list>)) (slot-ref o 'n)) -(define-method (len (o <p>)) ((ref o '__len__))) +(define-method (len (o <p>)) + (aif it (ref o '__len__) + (it) + (next-method))) (define-method (in x (l <pair>)) (member x l)) (define-method (in x (l <vector>)) @@ -644,13 +679,19 @@ #f))) (define-method (in x (o <p>)) - ((ref o '__contains__) x)) + (aif it (ref o '__contains__) + (it x) + (next-method))) (define-syntax-rule (defgen (op o1 o2) code ...) (begin (define-method (op (o1 <py-list>) (o2 <py-list>)) code ...) (define-method (op (o1 <pair>) (o2 <pair> )) code ...) - (define-method (op (o1 <vector>) (o2 <vector>)) code ...))) + (define-method (op (o1 <vector>) (o2 <vector>)) code ...) + (define-method (op (o1 <p>) o2) + (aif it (ref o1 'r) + (it o2) + (next-method))))) (defgen (< o1 o2) (let ((n1 (len o1)) @@ -690,13 +731,15 @@ (define-python-class list (<py-list>) (define __init__ - (case-lambda - ((self) - (slot-set! self 'vec (make-vector 30)) - (slot-set! self 'n 0)) - ((self it) - (__init__ self) - (for ((i : it)) () (pylist-append self i)))))) + (letrec ((__init__ + (case-lambda + ((self) + (slot-set! self 'vec (make-vector 30)) + (slot-set! self 'n 0)) + ((self it) + (__init__ self) + (for ((i : it)) () (pylist-append! self i)))))) + __init__))) (define pylist list) diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm index 1b8973f..4103c4d 100644 --- a/modules/language/python/module/python.scm +++ b/modules/language/python/module/python.scm @@ -3,7 +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)) + (<p> <property> class-method static-method refq + py-super-mac)) #:use-module (language python exceptions ) #:use-module (language python def ) #:use-module (language python for ) @@ -29,7 +30,7 @@ chr classmethod staticmethod divmod enumerate filter format getattr hasattr hash hex isinstance - iter map sum id input oct ord pow)) + iter map sum id input oct ord pow super)) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) @@ -191,9 +192,8 @@ ((x y z) (py-mod (expt x y) z)))) - +(define-syntax-rule (super . l) (py-super-mac . l)) (define min py-min) (define max py-max) (define list pylist) - diff --git a/modules/language/python/number.scm b/modules/language/python/number.scm index efab4e4..45a3cf4 100644 --- a/modules/language/python/number.scm +++ b/modules/language/python/number.scm @@ -38,7 +38,7 @@ (begin (mk-biop0 op) (define-method (op v (o <p>)) - (aif it (ref o 'r2) + (aif it (ref o 'r1) (it v) (next-method))))) @@ -211,26 +211,28 @@ (define-python-class int (<py-int>) (define __init__ - (case-lambda - ((self) - (__init__ self 0)) - - ((self n) - (let lp ((n n)) - (cond - ((and (number? n) (integer? n)) - (slot-set! self 'x n)) - ((number? n) - (lp (py-floor n))) - ((string? n) - (lp (string->number n))) - (else - (aif it (slot-ref n '__int__) - (slot-set! self 'x it) - (raise ValueError "could not make int from " n)))))) + (letrec ((__init__ + (case-lambda + ((self) + (__init__ self 0)) + + ((self n) + (let lp ((n n)) + (cond + ((and (number? n) (integer? n)) + (slot-set! self 'x n)) + ((number? n) + (lp (py-floor n))) + ((string? n) + (lp (string->number n))) + (else + (aif it (slot-ref n '__int__) + (slot-set! self 'x it) + (raise ValueError "could not make int from " n)))))) - ((self n k) - (__init__ self (string->number n k)))))) + ((self n k) + (__init__ self (string->number n k)))))) + __init__))) (define (proj? x) (if (number? x) diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm index 4b22716..6ac8874 100644 --- a/modules/language/python/string.scm +++ b/modules/language/python/string.scm @@ -22,10 +22,13 @@ (define-class <py-string> () str) (define-syntax-rule (define-py (f n o . u) code ...) - (begin - (define-method (f (o <string>) . u) code ...) - (define-method (f (o <py-string>) . l) (apply f (slot-ref o 'str) l)) - (define-method (f (o <p>) . l) ((ref o 'n) l)))) + (begin + (define-method (f (o <string>) . u) code ...) + (define-method (f (o <py-string>) . l) (apply f (slot-ref o 'str) l)) + (define-method (f (o <p>) . l) + (aif it (ref o 'n) + (apply it l) + (next-method))))) (define-py (py-capitalize capitalize s) (let* ((n (len s)) |