From 582d1c6f0be332ad4cb9f421bea5c2be56a12408 Mon Sep 17 00:00:00 2001 From: Stefan Israelsson Tampe Date: Fri, 24 Aug 2018 22:23:23 +0200 Subject: socket.py --- modules/oop/pf-objects.scm | 28 ++++++++++++++++++++++++++-- 1 file changed, 26 insertions(+), 2 deletions(-) (limited to 'modules/oop') 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) -- cgit v1.2.3