diff options
Diffstat (limited to 'modules')
-rw-r--r-- | modules/language/python/compile.scm | 72 | ||||
-rw-r--r-- | modules/language/python/exceptions.scm | 6 | ||||
-rw-r--r-- | modules/language/python/for.scm | 2 | ||||
-rw-r--r-- | modules/language/python/list.scm | 110 |
4 files changed, 171 insertions, 19 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index 0919f1b..332c22e 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -164,6 +164,20 @@ (define-syntax-rule (<< x y) (ash x y)) (define-syntax-rule (>> x y) (ash x (- y))) +(define (fastfkn x) + (case x + ;; Lists + ((append) (L 'pylist-apbpend!)) + ((count) (L 'pylist-count!)) + ((extend) (L 'pylist-extend!)) + ((index) (L 'pylist-index)) + ((pop) (L 'pylist-pop!)) + ((insert) (L 'pylist-insert!)) + ((remove) (L 'pylist-remove!)) + ((reverse) (L 'pylist-reverse!)) + ((sort) (L 'pylist-sort!)) + (else #f))) + (define (make-set vs op x u) (define (tr-op op) (match op @@ -192,11 +206,11 @@ `(,s/d ,v ,u)) (if op `(,s/d ,(exp vs kind) - (,(O 'fset-x) ,v (list ,@(map q addings)) - (,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u))) + (,(O 'fset-x) ,v (list ,@(map q addings)) + (,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u))) `(,s/d ,(exp vs kind) - (,(O 'fset-x) ,v (list ,@(map q addings)) ,u))))) + (,(O 'fset-x) ,v (list ,@(map q addings)) ,u))))) (let ((v (string->symbol v))) (if (null? addings) @@ -234,11 +248,13 @@ (gen-table x vs (#:power - ((#:power _ (x) () . #f) + ((_ _ (x) () . #f) (exp vs x)) - ((#:power _ x () . #f) + + ((_ _ x () . #f) (exp vs x)) - ((#:power #f vf trailer . **) + + ((_ #f vf trailer . **) (let () (define (pw x) (if ** @@ -252,9 +268,22 @@ ((#f) (list e)) ((x . trailer) - (match (pr x) + (let ((is-fkn? (match trailer + (((#:arglist . _) . _) + #t) + (_ + #f)))) + (match (pr x) ((#:identifier . _) - (lp `(,(O 'refq) ,e ',(exp vs x) #f) trailer)) + (let* ((tag (exp vs x)) + (xs (gensym "xs")) + (is-fkn? (aif it (and is-fkn? (fastfkn tag)) + `(lambda ,xs (apply ,it ,e ,xs)) + #f))) + (lp (if is-fkn? + is-fkn? + `(,(O 'refq) ,e ',tag #f)) + trailer))) ((#:arglist args apply #f) (if apply @@ -264,7 +293,7 @@ trailer) (lp `(,e ,@(map (g vs exp) args)) trailer))) - (_ (error "unhandled trailer")))))))))) + (_ (error "unhandled trailer"))))))))))) (#:identifier ((#:identifier x . _) @@ -640,7 +669,19 @@ (#:global ((_ . _) '(values))) - + + (#:list + ((_ . l) + (list (L 'to-pylist) (let lp ((l l)) + (match l + (() ''()) + (((#:starexpr #:power #f (#:list . l) . _) . _) + (lp l)) + (((#:starexpr . l) . _) + `(,(L 'to-list) ,(exp vs l))) + ((x . l) + `(cons ,(exp vs x) ,(lp l)))))))) + (#:lambdef ((_ v e) (list `lambda v (exp vs e)))) @@ -1105,9 +1146,10 @@ obj))))) (define-syntax ref-x - (syntax-rules () - ((_ v) - v) - ((_ v x . l) - (ref-x (ref v 'x) . l)))) + (lambda (x) + (syntax-case x () + ((_ v) + #'v) + ((_ v x . l) + #'(ref-x (refq v 'x) . l))))) diff --git a/modules/language/python/exceptions.scm b/modules/language/python/exceptions.scm index 954f3b3..5b3b5ca 100644 --- a/modules/language/python/exceptions.scm +++ b/modules/language/python/exceptions.scm @@ -2,14 +2,16 @@ #:use-module (oop pf-objects) #:use-module (oop goops) #:export (StopIteration GeneratorExit RuntimeError - Exception)) + Exception + IndexError)) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) (define StopIteration 'StopIteration) (define GeneratorExit 'GeneratorExit) (define RuntimeError 'RuntimeError) - +(define IndexError 'IndexError) + (define-python-class Exception () (define __init__ (case-lambda diff --git a/modules/language/python/for.scm b/modules/language/python/for.scm index bb0afa4..fade3f2 100644 --- a/modules/language/python/for.scm +++ b/modules/language/python/for.scm @@ -4,7 +4,7 @@ #:use-module (language python exceptions) #:use-module (oop goops) #:use-module (ice-9 control) - #:export (for break next write)) + #:export (for break next)) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm index 64ff6e4..1935f02 100644 --- a/modules/language/python/list.scm +++ b/modules/language/python/list.scm @@ -1,11 +1,13 @@ (define-module (language python list) #:use-module (oop pf-objects) #:use-module (oop goops) + #:use-module (language python exceptions) #:use-module (language python yield) #:use-module (language python for) #:use-module (language python exceptions) - #:export (to-list)) + #:export (to-list pylist-ref pylist-set! pylist-append!)) +(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) (define-method (to-list x) (if (vector? x) @@ -15,6 +17,7 @@ (define-method (to-list (x <p>)) ((ref x '__tolist__ (lambda () (error "missing __tolist__ in object"))))) + (define-method (to-list (x <yield>)) (define l '()) (catch StopIteration @@ -24,3 +27,108 @@ (lp))) (lambda x (reverse l)))) + +(define-class <py-list> () vec n) + +(define-method (to-pylist (l <pair>)) + (let* ((n (length l)) + (vec (make-vector (* 2 n))) + (o (make <py-list>))) + + (let lp ((l l) (i 0)) + (if (pair? l) + (begin + (vector-set! vec i (car l)) + (lp (cdr l) (+ i 1))))) + + (slot-set! o 'n n) + (slot-set! o 'vec vec) + o)) + + +;;; REF +(define-method (pylist-ref (o <py-list>) n) + (if (< n (slot-ref o 'n)) + (vector-ref (slot-ref o 'vec) n) + (raise IndexError))) + +(define-method (pylist-ref (o <pair>) n) + (list-ref o n)) + +(define-method (pylist-ref (o <vector>) n) + (vector-ref o n)) + +(define-method (pylist-ref (o <p>) n) + ((ref o '__listref__) n)) + +;;; SET +(define-method (pylist-set! (o <py-list>) n val) + (if (< n (slot-ref o 'n)) + (vector-set! (slot-ref o 'vec) n val) + (raise IndexError))) + +(define-method (pylist-set! (o <pair>) n val) + (list-set! o n val)) + +(define-method (pylist-set! (o <vector>) n val) + (vector-set! o n val)) + +(define-method (pylist-set! (o <p>) n val) + ((ref o '__listset__) n val)) + +;;APPEND +(define-method (pylist-append! (o <py-list>) n val) + (let* ((n (slot-ref o 'n)) + (vec (slot-ref o 'vec)) + (N (vector-length vec))) + (if (< n N) + (begin + (vector-set! vec n val) + (slot-set! o 'n (+ n 1))) + (let* ((N (* 2 N)) + (vec2 (make-vector N))) + (let lp ((i 0)) + (if (< i n) + (begin + (vector-set! vec2 i (vector-ref vec i)) + (lp (+ i 1))))) + (vector-set! vec2 n val) + (slot-set! o 'vec vec2))) + (slot-set! o 'n (+ n 1)))) + +(define-method (pylist-append! o n) + (raise 'NotSupportedOP '__append__)) + +(define-method (pylist-append! (o <p>) n . l) + (aif it (ref o '__append__) + (it n) + (aif it (ref o 'append) + (apply it n l) + (error "no append")))) + + +(define-method (to-list (x <py-list>)) + (let ((vec (slot-ref x 'vec)) + (n (slot-ref x 'n))) + (let lp ((i 0)) + (if (< i n) + (cons (vector-ref vec i) (lp (+ i 1))) + '())))) + + +(define-method (write (o <py-list>) . l) + (define port (if (null? l) #t (car l))) + + (let* ((l (to-list o))) + (if (null? l) + (format port "[]") + (format port "[~a~{, ~a~}]" (car l) (cdr l))))) + +(define-method (display (o <py-list>) . l) + (define port (if (null? l) #t (car l))) + + (let* ((l (to-list o))) + (if (null? l) + (format port "[]") + (format port "[~a~{, ~a~}]" (car l) (cdr l))))) + |