+ (defmacro psetq (&rest pairs)
+ (let ( ;; For each pair, we store here a list of the form
+ ;; (VARIABLE GENSYM VALUE).
+ (assignments '()))
+ (while t
+ (cond
+ ((null pairs) (return))
+ ((null (cdr pairs))
+ (error "Odd paris in PSETQ"))
+ (t
+ (let ((variable (car pairs))
+ (value (cadr pairs)))
+ (push `(,variable ,(gensym) ,value) assignments)
+ (setq pairs (cddr pairs))))))
+ (setq assignments (reverse assignments))
+ ;;
+ `(let ,(mapcar #'cdr assignments)
+ (setq ,@(!reduce #'append (mapcar #'butlast assignments) '())))))
+
+ (defmacro do (varlist endlist &body body)
+ `(block nil
+ (let ,(mapcar (lambda (x) (list (first x) (second x))) varlist)
+ (while t
+ (when ,(car endlist)
+ (return (progn ,(cdr endlist))))
+ (tagbody ,@body)
+ (psetq
+ ,@(apply #'append
+ (mapcar (lambda (v)
+ (and (consp (cddr v))
+ (list (first v) (third v))))
+ varlist)))))))
+
+ (defmacro do* (varlist endlist &body body)
+ `(block nil
+ (let* ,(mapcar (lambda (x) (list (first x) (second x))) varlist)
+ (while t
+ (when ,(car endlist)
+ (return (progn ,(cdr endlist))))
+ (tagbody ,@body)
+ (setq
+ ,@(apply #'append
+ (mapcar (lambda (v)
+ (and (consp (cddr v))
+ (list (first v) (third v))))
+ varlist)))))))
+