This is the mail archive of the kawa@sources.redhat.com mailing list for the Kawa project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

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


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]