diff options
Diffstat (limited to 'modules/language/python/compile.scm')
| -rw-r--r-- | modules/language/python/compile.scm | 72 |
1 files changed, 57 insertions, 15 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))))) |