(let ((tags '())
      (forms '())
      (results '()))
  (dolist (element body)
    (cond ((not (tagbody-tag-p element))
           (push element forms))
          ((null forms)
           (push element tags))
          (t
           (push (cons tags (cons 'progn (nreverse forms))) results)
           (setf tags (list element))
           (setf forms '()))))
  (nreverse results))