diff options
| author | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2017-10-05 00:56:12 +0200 |
|---|---|---|
| committer | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2017-10-05 00:56:12 +0200 |
| commit | 16ff956cec889303fea7f8e235eba6876fb46c68 (patch) | |
| tree | 8205e2dcff040d702ac77548ac4415891047444c /modules/language/python/compile.scm | |
| parent | 5f8089beb5d77a186f4f00053edf45f1985bdb63 (diff) | |
super
Diffstat (limited to 'modules/language/python/compile.scm')
| -rw-r--r-- | modules/language/python/compile.scm | 63 |
1 files changed, 39 insertions, 24 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index c9acea1..c3a6493 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -223,7 +223,7 @@ (define fasthash (mkfast ;; General - ((__init__) (O 'init)) + ((__init__) (O 'py-init)) ((__getattr__) (O 'getattr)) ((__setattr__) (O 'setattr)) ((__delattr__) (O 'delattr)) @@ -722,18 +722,19 @@ (parents (filt parents))) `(define ,class (,(C 'class-decor) ,decor - (,(O kind) - ,class - ,(map (lambda (x) `(,(O 'get-class) ,x)) parents) - #:const - () - #:dynamic - ,(match (filter-defs (exp vs defs)) - (('begin . l) - l) - ((('begin . l)) - l) - (l l)))))))))) + (,(C 'with-class) ,class + (,(O kind) + ,class + ,(map (lambda (x) `(,(O 'get-class) ,x)) parents) + #:const + () + #:dynamic + ,(match (filter-defs (exp vs defs)) + (('begin . l) + l) + ((('begin . l)) + l) + (l l))))))))))) (#:scm ((_ (#:string _ s)) (with-input-from-string s read))) @@ -968,34 +969,38 @@ (,(D 'lam) (,@args ,@*f ,@**f) (,(C 'with-return) ,r ,(mk `(let ,(map (lambda (x) (list x #f)) ls) - ,(with-fluids ((return r)) - (exp ns code))))))))) + (,(C 'with-self) ,c? ,args + ,(with-fluids ((return r)) + (exp ns code)))))))))) `(define ,f (,(C 'def-decor) ,decor (,(D 'lam) (,@args ,@*f ,@**f) (,(C 'with-return) ,r ,(mk `(let ,(map (lambda (x) (list x #f)) ls) + (,(C 'with-self) ,c? ,args ,(with-fluids ((return r)) - (exp ns code))))))))) + (exp ns code)))))))))) (if y? `(define ,f (,(C 'def-decor) ,decor (,(C 'def-wrap) ,y? ,f ,ab (,(D 'lam) (,@args ,@*f ,@**f) - (,(C 'with-return) ,r + (,(C 'with-return) ,r (let ,(map (lambda (x) (list x #f)) ls) - ,(with-fluids ((return r)) - (mk - (exp ns code))))))))) + (,(C 'with-self) ,c? ,args + ,(with-fluids ((return r)) + (mk + (exp ns code)))))))))) `(define ,f (,(C 'def-decor) ,decor (,(D 'lam) (,@args ,@*f ,@**f) - (,(C 'with-return) ,r + (,(C 'with-return) ,r (let ,(map (lambda (x) (list x #f)) ls) - ,(with-fluids ((return r)) - (exp ns code))))))))))))) + (,(C 'with-self) ,c? ,args + ,(with-fluids ((return r)) + (exp ns code)))))))))))))) (#:global ((_ . _) @@ -1691,5 +1696,15 @@ ((_ () x) x) ((_ (f ... r) y) (def-decor (f ...) (r y))))) - +(define-syntax with-self + (syntax-rules () + ((_ #f _ c) + c) + ((_ _ (s . b) c) + (syntax-parameterize ((*self* (lambda (x) #'s))) c)))) + +(define-syntax with-class + (syntax-rules () + ((_ s c) + (syntax-parameterize ((*class* (lambda (x) #'s))) c)))) |