diff options
Diffstat (limited to 'modules/language')
-rw-r--r-- | modules/language/python/compile.scm | 78 |
1 files changed, 64 insertions, 14 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index 10320f5..75ceba1 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -519,23 +519,58 @@ (cons v addings))) (v (car v.add)) (addings (cdr v.add)) - (addings (get-addings vs addings))) + (addings (get-addings vs addings)) + (p.a (match kind + (#f (cons #f '())) + ((v add) + (if (is-prefix? v) + (let ((w (symbol->string (exp vs (car add))))) + (cons (string-append (symbol->string v) "." w) + (cdr add))) + (cons (exp vs v) add))))) + (p (car p.a)) + (pa (cdr p.a)) + (pa (get-addings vs pa))) (define q (lambda (x) `',x)) (if kind - (if (null? addings) - (if op - `(,s/d ,v (,(C 'setwrap) (,(tr-op op) ,v ,u))) - `(,s/d ,v (,(C 'setwrap) ,u))) - (if op - `(,s/d ,(exp vs kind) - (,(C 'fset-x) ,v ,addings - (,(C 'setwrap) - (,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u)))) + (if (not p) + (if (null? addings) + (if op + `(,s/d ,v (,(C 'setwrap) (,(tr-op op) ,v ,u))) + `(,s/d ,v (,(C 'setwrap) ,u))) + (if op + `(,s/d ,(exp vs kind) + (,(C 'fset-x) ,v ,addings + (,(C 'setwrap) + (,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u)))) - `(,s/d ,(exp vs kind) - (,(C 'fset-x) ,v ,addings - (,(C 'setwrap) ,u))))) - + `(,s/d ,(exp vs kind) + (,(C 'fset-x) ,v ,addings + (,(C 'setwrap) ,u))))) + + (let ((pre (if (equal? p v) + (let lp ((pa pa) (ad addings) (r '())) + (if (and (pair? pa) (pair? ad)) + (let ((px (car pa)) (ax (car ad))) + (if (equal? px ax) + (lp (cdr pa) (cdr ad) (cons px r)) + #f)) + (if (pair? pa) + #f + (reverse r)))) + #f))) + (if (null? addings) + (if op + `(,s/d ,v (,(C 'setwrap) (,(tr-op op) ,v ,u))) + `(,s/d ,v (,(C 'setwrap) ,u))) + (if op + `(,(C 'set-x) ,v ,pre ,p ,pa ,addings + (,(C 'setwrap) + (,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u))) + + `(,(C 'set-x) ,v ,pre ,p ,pa ,addings + (,(C 'setwrap) ,u)))))) + (if (null? addings) (if op `(,s/d ,v (,(C 'setwrap) @@ -1734,8 +1769,23 @@ (define-syntax set-x (syntax-rules () ((_ v (a ... b) val) + (set-x-2 (ref-x v a ...) b val)) + ((_ v #f p pa a val) + (set-x p pa (fset-x v a val))) + ((_ v pre p pa a val) + (set-c v pre a val)) + ((_ v (a ... b) val) (set-x-2 (ref-x v a ...) b val)))) +(define-syntax set-c + (syntax-rules () + ((_ v (a) (b) val) + (set v a val)) + ((_ v () as val) + (tr v (fset-x v as val))) + ((_ v ((#:identifier a) . as) (b . bs) val) + (set-c (ref v a) as bs val)))) + (define-syntax fset-x (syntax-rules () ((_ v ((#:identifier x) ...) val) |