diff options
Diffstat (limited to 'modules')
-rw-r--r-- | modules/language/python/compile.scm | 125 | ||||
-rw-r--r-- | modules/language/python/list.scm | 64 |
2 files changed, 159 insertions, 30 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index 4aa67ec..46a9199 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -179,6 +179,60 @@ ((sort) (L 'pylist-sort!)) (else #f))) +(define (get-addings vs x) + (match x + (() '()) + ((x . l) + (let ((is-fkn? (match l + (((#:arglist . _) . _) + #t) + (_ + #f)))) + + (cons + (match x + ((#:identifier . _) + (let* ((tag (exp vs x)) + (xs (gensym "xs")) + (is-fkn? (aif it (and is-fkn? (fastfkn tag)) + `(#:call-obj (lambda (e) + `(lambda ,xs + (apply ,it ,e ,xs)))) + #f))) + (if is-fkn? + is-fkn? + `(#:identifier ',tag)))) + + ((#:arglist args apply #f) + (if apply + `(#:apply ,@(map (g vs exp) args) + ,`(,(L 'to-list) ,(exp vs apply))) + `(#:call ,@(map (g vs exp) args)))) + + ((#:subscripts (n #f #f)) + `(#:vecref ,(exp vs n))) + + ((#:subscripts (n1 n2 n3)) + (let ((w (lambda (x) (if (eq? x 'None) ''None x)))) + `(#:vecsub + ,(w (exp vs n1)) ,(w (exp vs n2)) ,(w (exp vs n3))))) + + ((#:subscripts (n #f #f) ...) + `(#:array-ref ,@ (map (lambda (n) + (exp vs n)) + n))) + + ((#:subscripts (n1 n2 n3) ...) + (let ((w (lambda (x) (if (eq? x 'None) ''None x)))) + `(#:arraysub + ,@(map (lambda (x y z) + `(,(exp vs x) ,(exp vs y) ,(exp vs z))) + n1 n2 n3)))) + + (_ (error "unhandled addings"))) + (get-addings vs l)))))) + + (define (make-set vs op x u) (define (tr-op op) (match op @@ -197,7 +251,7 @@ (match x ((#:test (#:power kind (#:identifier v . _) addings . _) . _) - (let ((addings (map (lambda (x) (exp vs x)) addings))) + (let ((addings (get-addings vs addings))) (define q (lambda (x) `',x)) (if kind (let ((v (string->symbol v))) @@ -218,18 +272,12 @@ (if op `(,s/d ,v (,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u)) `(,s/d ,v ,u)) - (let* ((rev (reverse addings)) - (las (car rev)) - (new (reverse (cdr rev)))) - `(,(O 'set) ,(let lp ((v v) (new new)) - (match new - ((x . new) - (lp `(,(O 'refq) ,v 'x) ',new)) - (() v))) - ',(exp vs las) - ,(if op - `(,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u) - u)))))))))) + `(,(C 'set-x) + ,v + ,addings + ,(if op + `(,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u) + u))))))))) (define is-class? (make-fluid #f)) (define (gen-yargs vs x) @@ -357,6 +405,14 @@ ((_ x) (list 'lognot (exp vs x)))) + (#:u- + ((_ x) + (list '- (exp vs x)))) + + (#:u+ + ((_ x) + (list '+ (exp vs x)))) + (#:band ((_ . l) (cons 'logand (map (g vs exp) l)))) @@ -694,8 +750,8 @@ (#:list ((_ . l) (list (L 'to-pylist) (let lp ((l l)) - (match l - (() ''()) + (match l + ((or () #f) ''()) (((#:starexpr #:power #f (#:list . l) . _) . _) (lp l)) (((#:starexpr #:power #f (#:tuple . l) . _) . _) @@ -1183,10 +1239,37 @@ obj))))) (define-syntax ref-x - (lambda (x) - (syntax-case x () - ((_ v) - #'v) - ((_ v x . l) - #'(ref-x (refq v 'x) . l))))) + (syntax-rules () + ((_ v) + v) + ((_ v (#:identifier x) . l) + (ref-x (refq v 'x) . l)) + ((_ v (#:identifier x) . l) + (ref-x (refq v 'x) . l)) + ((_ v (#:call-obj x) . l) + (ref-x (x v) . l)) + ((_ v (#:call x ...) . l) + (ref-x (v x ...) . l)) + ((_ v (#:apply x ...) . l) + (ref-x (apply v x ...) . l)) + ((_ v (#:apply x ...) . l) + (ref-x (apply v x ...) . l)) + ((_ v (#:vecref x) . l) + (ref-x (pylist-ref v x) . l)) + ((_ v (#:vecsub . x) . l) + (ref-x (pylist-slice v . x) . l)))) + +(define-syntax set-x + (syntax-rules () + ((_ v (a ... b) val) + (set-x-2 (ref-x v a ...) b val)))) + +(define-syntax set-x-2 + (syntax-rules () + ((_ v (#:identifier x) val) + (set v 'x val)) + ((_ v (#:vecref n) val) + (pylist-set! v n val)) + ((_ v (#:vecsub x ...) val) + (pylist-subset! v x ... val)))) diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm index b8f1860..8b25077 100644 --- a/modules/language/python/list.scm +++ b/modules/language/python/list.scm @@ -7,7 +7,7 @@ #:use-module (language python try) #:use-module (language python exceptions) #:export (to-list pylist-ref pylist-set! pylist-append! - pylist-slice)) + pylist-slice pylist-subset!)) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) @@ -32,6 +32,9 @@ (define-class <py-list> () vec n) +(define-method (to-pylist (l <py-list>)) + l) + (define-method (to-pylist (l <pair>)) (let* ((n (length l)) (vec (make-vector (* 2 n))) @@ -57,14 +60,17 @@ (slot-set! o 'n 0) o) (error "not able to make a pylist"))) - + ;;; REF -(define-method (pylist-ref (o <py-list>) n) - (if (< n (slot-ref o 'n)) +(define-method (pylist-ref (o <py-list>) nin) + (define N (slot-ref o 'n)) + (define n (if (< nin 0) (+ N nin) nin)) + (if (and (>= n 0) (< n (slot-ref o 'n))) (vector-ref (slot-ref o 'vec) n) (raise IndexError))) (define-method (pylist-ref (o <pair>) n) + (define n (if (< n 0) (+ (length o) n))) (list-ref o n)) (define-method (pylist-ref (o <vector>) n) @@ -74,8 +80,11 @@ ((ref o '__listref__) n)) ;;; SET -(define-method (pylist-set! (o <py-list>) n val) - (if (< n (slot-ref o 'n)) +(define-method (pylist-set! (o <py-list>) nin val) + (define N (slot-ref o 'n)) + (define n (if (< nin 0) (+ N nin) nin)) + + (if (and (>= n 0) (< n (slot-ref o 'n))) (vector-set! (slot-ref o 'vec) n val) (raise IndexError))) @@ -90,9 +99,12 @@ ;;SLICE (define-method (pylist-slice (o <py-list>) n1 n2 n3) - (let* ((n1 (if (eq? n1 'None) 0 n1)) - (n2 (if (eq? n2 'None) (slot-ref o 'n) n2)) - (n3 (if (eq? n3 'None) 1 n3)) + (define N (slot-ref o 'n)) + (define (f n) (if (< n 0) (+ N n) n)) + + (let* ((n1 (f (if (eq? n1 'None) 0 n1))) + (n2 (f (if (eq? n2 'None) (slot-ref o 'n) n2))) + (n3 (f (if (eq? n3 'None) 1 n3))) (vec (slot-ref o 'vec)) (l (let lp ((i n1)) @@ -104,6 +116,40 @@ (define-method (pylist-slice o n1 n2 n3) (pylist-slice (to-pylist o) n1 n2 n3)) +;;SUBSET +(define-method (pylist-subset! (o <py-list>) n1 n2 n3 val) + (define N (slot-ref o 'n)) + (define (f n) (if (< n 0) (+ N n) n)) + + (let* ((n1 (f (if (eq? n1 'None) 0 n1))) + (n2 (f (if (eq? n2 'None) (slot-ref o 'n) n2))) + (n3 (f (if (eq? n3 'None) 1 n3))) + (vec (slot-ref o 'vec)) + (o2 (to-pylist val)) + (N2 (slot-ref o2 'n)) + (vec2 (slot-ref o2 'vec))) + (if (<= n2 N) + (let lp ((i 0) (j n1)) + (if (< j n2) + (if (< i N2) + (begin + (vector-set! vec j (vector-ref vec2 i)) + (lp (+ i 1) (+ j n3))) + (let lp ((j2 j)) + (if (< j2 n2) + (lp (+ j2 n3)) + (let lp ((k1 j) (k2 j2)) + (if (< k2 N) + (begin + (vector-set! vec k1 (vector-ref vec k2)) + (lp (+ k1 1) (+ k2 1))) + (slot-set! o 'n k1)))))))) + + + (raise IndexError)) + (values))) + + ;;APPEND (define-method (pylist-append! (o <py-list>) val) (let* ((n (slot-ref o 'n)) |