diff options
author | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2018-08-24 22:23:23 +0200 |
---|---|---|
committer | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2018-08-24 22:23:23 +0200 |
commit | 582d1c6f0be332ad4cb9f421bea5c2be56a12408 (patch) | |
tree | 3c0f8e487d1c57b509ae19ee4d858a90728ea7b3 /modules/oop | |
parent | 333a82328a53024f341a74a0f738ce0d6f0f6d4f (diff) |
socket.py
Diffstat (limited to 'modules/oop')
-rw-r--r-- | modules/oop/pf-objects.scm | 28 |
1 files changed, 26 insertions, 2 deletions
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm index 4b11202..5eea799 100644 --- a/modules/oop/pf-objects.scm +++ b/modules/oop/pf-objects.scm @@ -1081,7 +1081,7 @@ explicitly tell it to not update etc. #'(let () (define name - (letruc ((dname (make-up dval)) ...) + (letruc2 ((dname (make-up dval)) ...) body (let ((ret (make-p-class 'name doc @@ -1302,7 +1302,31 @@ explicitly tell it to not update etc. (reverse r)) #,x)) u))))) #`(letrec #,(reverse u) code ...))))))) - + +(define-syntax letruc2 + (lambda (x) + (syntax-case x () + ((_ ((x v) ...) code ...) + (let lp ((a #'(x ...)) (b #'(v ...)) (u '())) + (if (pair? a) + (let* ((x (car a)) + (s (syntax->datum x))) + (let lp2 ((a2 (cdr a)) (b2 (cdr b)) (a3 '()) (b3 '()) + (r (list (car b)))) + (if (pair? a2) + (if (eq? (syntax->datum a2) s) + (lp2 (cdr a2) (cdr b2) a3 b3 (cons (car b2) r)) + (lp2 (cdr a2) (cdr b2) + (cons (car a2) a3) + (cons (car b2) b3) + r)) + (lp (reverse a3) (reverse b3) + (cons + (list x #`(let* #,(map (lambda (v) (list x v)) + (reverse r)) #,x)) + u))))) + #`(let #,(reverse u) code ...))))))) + (define-method (py-init . l) |