anchor.diff:          (t    attr)))
   
   
  -(defun encase (tag-list)
  +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  +;;;
  +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  +
  +;; (defstruct comment data)
  +;; (defstruct foreign data)
  +;; (defstruct attribute name value)
  +;; (defstruct definition name attributes)
  +;; (defstruct open-tag name attributes closed)
  +;; (defstruct close-tag name attributes)
  +
  +(defstruct element name attributes contents closed)
  +(defparameter *newline* (string #\newline) "A string containing only a newline.")
  +
  +(defgeneric unwrap-attribute (attribute)
  +  (:method ((attribute attribute))
  +    (list (attribute-name attribute) (attribute-value attribute))))
  +
  +(defgeneric unwrap-element (element)
  +  (:method ((element t))
  +    element)
  +  (:method ((element foreign))
  +    (list :foreign () (foreign-data element)))
  +  (:method ((element comment))
  +    (list :comment () (comment-data element)))
  +  (:method ((element definition))
  +    (list* :definition ()  (definition-attributes element)))
  +  (:method ((element element))
  +    (list* (element-name element)
  +           (mapcar (function unwrap-attribute) (element-attributes element))
  +           (remove *newline* (mapcar (function unwrap-element) (element-contents element))
  +                   :test (function equal)))))
  +
  +
  +(defun encase (tok-list)
     "
  -Transform a list of tags and content strings, into a :document sexp tree
  -according to the :open and (optional) :close elements.
  +Transform a list of tokens and content strings, into a :document sexp tree
  +structured according to the OPEN-TAG and (optional) CLOSE-TAG tokens.
   "
  -  ;;     content-list-reversed
  -  ;;     ( (tag (attributes)) content-list-reversed)
  -  ;;     ( (tag (attributes)) content-list-reversed)
  -  ;;     ( (tag (attributes)) content-list-reversed)
  -  ;;     ( (tag (attributes)) )
  -  (do* ((stack    (list nil))
  -        (tag-list tag-list       (cdr tag-list))
  -        (tag      (car tag-list) (car tag-list)))
  -       ((null tag-list)      `(:document () ,@(nreverse (pop stack))))
  -    (cond
  -      ((or (atom tag) (member (car tag) '(:comment :foreign :definition)))
  -       (push tag (car stack)))
  -      ((eq (car tag) :open)
  -       (push (cons (second tag)
  -                   (list
  -                    (mapcan (lambda (kv)
  -                              (list (first kv)
  -                                    (clean-attribute (second kv))))
  -                            (third tag)))) (car stack))
  -       (unless (element-end-forbidden-p (second tag))
  -         (push nil stack)))
  -      ((and (eq (car tag) :close)
  -            (position (cadr tag) stack :key (lambda (item)  (and (consp item) 
  -                                                                 (consp (car item)) 
  -                                                                 (caar item)))))
  -       (until (and (consp (caar stack)) (eq (cadr tag) (caaar stack)))
  -         (let ((attributes (nreverse (pop stack))))
  -           (setf (caar stack) (append (caar stack) attributes))))))))
  -;; (eq (car tag) :close) and no corresponding open )))
  -
  -(defparameter *newline* (string #\newline) "A string containing only a newline.")
  +  (loop
  +    :with stack := (list (make-element :name :document))
  +    :for tok :in tok-list
  +    :do (etypecase tok
  +          ((or string comment foreign definition)
  +           (push tok (element-contents (car stack))))
  +          (open-tag
  +           (let ((element (make-element :name (open-tag-name tok)
  +                                        :attributes (open-tag-attributes tok)
  +                                        :closed (open-tag-closed tok))))
  +            (if (element-closed element)
  +                (push element (element-contents (car stack)))
  +                (push element stack))))
  +          (close-tag
  +           (if (position (close-tag-name tok) stack :key (function element-name))
  +               (loop
  +                 :for top := (pop stack)
  +                 :do (setf (element-closed top) t
  +                           (element-contents top) (nreverse (element-contents top)))
  +                     (push top (element-contents (car stack)))
  +                 :until (eq (close-tag-name tok) (element-name top)))
  +               #|else ignore the unbalanced close tag|#)))
  +    :finally (return (loop
  +                       :for top := (pop stack)
  +                       :do (setf (element-closed top) t
  +                                 (element-contents top) (nreverse (element-contents top)))
  +                       :while stack
  +                       :do (push top (element-contents (car stack)))
  +                       :finally (return top)))))
  +
  +
   
   (defun parse-html-stream (stream &key (verbose nil))
     "
  
positive.code:                       (advance parser)
                        (parse-file parser)))
      (when verbose (format *trace-output* "~&file ~S parsed~%" name))
      (setf walked  (remove *newline* (parse-tree-to-sexp synthetic) :test (function equal)))
      (when verbose (format *trace-output* "~&file ~S walked~%" name))
      (setf encased (encase walked))
      (when verbose (format *trace-output* "~&file ~S encased -- done.~%" name))
      encased))
  
  
negative.code:                        ((:open-tag)  (parse-open-tag parser))
                         ((:close-tag) (parse-close-tag parser))
                         (otherwise   (report-error parser "Unexpected token")))
      :while synthetic
      :collect synthetic))
  
  
  (defun parse-definition (parser)
  