diff options
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) |