tagbody using labels

[masinter.PA@Xerox.COM]

GO requires no more magic than return-from.

This was an interesting puzzle. This definition doesn't handle go's from
inside an inner tagbody to an outer one, but I couldn't figure out how
to do that without introducing a compiler-let. 

(defmacro tagbody (&rest rest)
  (labels
   ((parse (tail &aux (rest (member-if #'atom (cdr tail))))
       (if tail (cons (cons (gensym) (ldiff tail rest)) (parse rest)))))
   (let ((name (gensym))
        (bodies (parse (cons (gensym) rest))))
    `(block ,name
      (macrolet ((go (tag)
                   `(return-from ,(car (find tag ',bodies :key 'cadr))
nil)))
        (labels
          ,(maplist
            #'(lambda (tail)
             `(,(caar tail) ()
                  ,@(reduce #'(lambda (body tag)
                                 `((block ,(car tag) ,@body)
                                   (return-from ,name (,(car tag)))))
                            bodies
                            :initial-value
                            `(,@(cddar tail)
                              ,(if (cdr tail)
                                  `(return-from ,(caadr tail) nil))))))
            bodies)
           (,(caar bodies))))))))


Larry
<:-)