This is the mail archive of the
kawa@sources.redhat.com
mailing list for the Kawa project.
and-let* (= SRFI-2) for Kawa
I asked some hours ago:
> Does anybody have a a SRFI-2 implementation for Kawa?
Found it myself :-)
One can use the file below "srfi2defm.scm".
Could this be included in Kawa? (function syntax-error needs to be modified,
the author should be asked for permission,
all validation tests (expect) should be run (I only tried 10 of them by hand).)
Greetings
Sven
; srfi2defm.scm
; posted as a SRFI-2 implementation for Guile on 1999-03-07 by Dale Jordan.
; http://sources.redhat.com/ml/guile/1999-03/msg00094.html
(defmacro and-let* (claws . body)
(let* ((new-vars '())
(result (cons 'and '()))
(growth-point result))
(define (syntax-error msg arg)
(scm-error 'syntax-error "and-let*" msg (list arg) #f))
(define (andjoin! clause)
(let ((prev-point growth-point)
(clause-cell (cons clause '())))
(set-cdr! growth-point clause-cell)
(set! growth-point clause-cell)))
(if (not (list? claws))
(syntax error "Bindings are not a list: %s" claws))
(for-each
(lambda (claw)
(cond
((symbol? claw) ; BOUND-VARIABLE form
(andjoin! claw))
((and (pair? claw) (null? (cdr claw))) ; (EXPRESSION) form
(andjoin! (car claw)))
((and (pair? claw) (symbol? (car claw)) ; (VARIABLE EXPRESSION) form
(pair? (cdr claw)) (null? (cddr claw)))
(let* ((var (car claw))
(var-cell (cons var '())))
(if (memq var new-vars)
(syntax-error "Duplicate variable in bindings: %s" var))
(set! new-vars (cons var new-vars))
(set-cdr! growth-point `((let (,claw) (and . ,var-cell))))
(set! growth-point var-cell)))
(else
(syntax-error "Ill-formed binding: %s" claw))))
claws)
(if (not (null? body))
(if (null? (cdr body))
(andjoin! (car body))
(andjoin! `(begin ,@body))))
; (newline) (display result) (newline) ; uncomment to show expansion
result))