diff options
Diffstat (limited to 'modules/language/python/compile.scm')
| -rw-r--r-- | modules/language/python/compile.scm | 90 |
1 files changed, 28 insertions, 62 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index a338bf9..610546f 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -30,6 +30,7 @@ (define-inlinable (Di x) `(@@ (language python dict) ,x)) (define-inlinable (O x) `(@@ (oop pf-objects) ,x)) (define-inlinable (G x) `(@ (guile) ,x)) +(define-inlinable (H x) `(@ (language python hash) ,x)) @@ -215,6 +216,11 @@ ... h)) +(define (fast-ref x) + (aif it (assoc x `((__class__ . ,(O 'py-class)))) + (cdr it) + #f)) + (define fasthash (mkfast ;; General @@ -225,7 +231,7 @@ ((__ne__) (O 'ne)) ((__eq__) (O 'equal?)) ((__repr__) (O 'repr)) - + ;;iterators ((__iter__) (F 'wrap-in)) ((__next__) (F 'next)) @@ -309,7 +315,9 @@ ((popitem) (Di 'py-popitem)) ((setdefault) (Di 'py-setdefault)) ((update) (Di 'py-update)) - ((clear) (Di 'py-clear)))) + ((clear) (Di 'py-clear)) + ((__hash__) (H 'py-hash)))) + (define (fastfkn x) (hash-ref fasthash x)) @@ -357,14 +365,19 @@ ((#:identifier . _) (let* ((tag (exp vs x)) (xs (gensym "xs")) - (is-fkn? (aif it (and is-fkn? (fastfkn tag)) + (fast (fastfkn tag)) + (is-fkn? (aif it (and is-fkn? fast) `(#:call-obj (lambda (e) `(lambda ,xs (apply ,it ,e ,xs)))) #f))) (if is-fkn? is-fkn? - `(#:identifier ',tag)))) + (if fast + `(#:fastfkn-ref ,fast ',tag) + (aif it (fast-ref tag) + `(#:fast-id ,it ',tag) + `(#:identifier ',tag)))))) ((#:arglist args apply #f) (call-with-values (lambda () (get-kwarg vs args)) @@ -493,64 +506,9 @@ `(expt ,x ,(exp vs **)) x)) (pw - (let lp ((e vf) (trailer trailer)) - (match trailer - (() - e) - ((#f) - (list e)) - ((x . trailer) - (let ((is-fkn? (match trailer - ((#f) #t) - (((#:arglist . _) . _) - #t) - (_ - #f)))) - (match (pr x) - ((#:identifier . _) - (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) - (call-with-values (lambda () (get-kwarg vs args)) - (lambda (args kwarg) - (if apply - (lp `(apply ,e - ,@args - ,@kwarg - ,`(,(L 'to-list) ,(exp vs apply))) - trailer) - (lp `(,e ,@args ,@kwarg) trailer))))) - - ((#:subscripts (n #f #f)) - `(,(L 'pylist-ref) ,e ,(exp vs n))) - - ((#:subscripts (n1 n2 n3)) - (let ((w (lambda (x) (if (eq? x None) (E 'None) x)))) - `(,(L 'pylist-slice) ,e - ,(w (exp vs n1)) ,(w (exp vs n2)) ,(w (exp vs n3))))) - - ((#:subscripts (n #f #f) ...) - `(,(A 'pyarray-ref) ,e (list ,@ (map (lambda (n) - (exp vs n)) - n)))) - - ((#:subscripts (n1 n2 n3) ...) - (let ((w (lambda (x) (if (eq? x None) (E 'None) x)))) - `(,(A 'pyarray-slice) ,e - (list ,@(map (lambda (x y z) - `(list ,(exp vs x) ,(exp vs y) ,(exp vs z))) - n1 n2 n3))))) - - (_ (error "unhandled trailer"))))))))))) - + (let ((trailer (get-addings vs trailer))) + `(,(C 'ref-x) ,vf ,@trailer)))))) + (#:identifier ((#:identifier x . _) (string->symbol x))) @@ -1594,6 +1552,10 @@ (syntax-rules () ((_ v) v) + ((_ v (#:fastfkn-ref f _) . l) + (ref-x (lambda x (if (py-class? v) (apply f x) (apply f v x))) . l)) + ((_ v (#:fast-id f _) . l) + (ref-x (f v) . l)) ((_ v (#:identifier x) . l) (ref-x (refq v 'x) . l)) ((_ v (#:identifier x) . l) @@ -1633,6 +1595,10 @@ (define-syntax set-x-2 (syntax-rules () + ((_ v (#:fastfkn-ref f id) val) + (set v id val)) + ((_ v (#:fastid-ref f id) val) + (set v id val)) ((_ v (#:identifier x) val) (set v x val)) ((_ v (#:vecref n) val) |