Practical Common Lisp

    (t                  (embed-value processor form))))

Now let's look at the compiler code. First you should define two functions that slightly abstract the vector you'll use to save ops in the first two phases of compilation.

(defun make-op-buffer () (make-array 10 :adjustable t :fill-pointer 0))
(defun push-op (op ops-buffer) (vector-push-extend op ops-buffer))

Next you can define the html-compiler class and the methods specialized on it to implement the backend interface.

(defclass html-compiler ()
  ((ops :accessor ops :initform (make-op-buffer))))
(defmethod raw-string ((compiler html-compiler) string &optional newlines-p)
  (push-op `(:raw-string ,string ,newlines-p) (ops compiler)))
(defmethod newline ((compiler html-compiler))
  (push-op '(:newline) (ops compiler)))
(defmethod freshline ((compiler html-compiler))
  (push-op '(:freshline) (ops compiler)))
(defmethod indent ((compiler html-compiler))
  (push-op `(:indent) (ops compiler)))
(defmethod unindent ((compiler html-compiler))
  (push-op `(:unindent) (ops compiler)))
(defmethod toggle-indenting ((compiler html-compiler))
  (push-op `(:toggle-indenting) (ops compiler)))
(defmethod embed-value ((compiler html-compiler) value)
  (push-op `(:embed-value ,value ,*escapes*) (ops compiler)))
(defmethod embed-code ((compiler html-compiler) code)
  (push-op `(:embed-code ,code) (ops compiler)))

With those methods defined, you can implement the first phase of the compiler, sexp- >ops.

(defun sexp->ops (body)
  (loop with compiler = (make-instance 'html-compiler)
     for form in body do (process compiler form)
     finally (return (ops compiler))))

During this phase you don't need to worry about the value of *pretty*: just record all the functions called by process. Here's what sexp->ops makes of a simple FOO form:

HTML> (sexp->ops '((:p 'Foo')))
#((:FRESHLINE) (:RAW-STRING '<p' NIL) (:RAW-STRING '>' NIL)
  (:RAW-STRING 'Foo' T) (:RAW-STRING '</p>' NIL) (:FRESHLINE))

The next phase, optimize-static-output, takes a vector of ops and returns a new vector containing the optimized version. The algorithm is simple—for each :raw-string op, it writes the string to a temporary string buffer. Thus, consecutive :raw-string ops will build up a single string containing the concatenation of the strings that need to be emitted. Whenever you encounter an op other than a :raw-string op, you convert the built-up string into a sequence of alternating :raw- string and :newline ops with the helper function compile-buffer and then add the next op. This function is also where you strip out the pretty printing ops if *pretty* is NIL.

(defun optimize-static-output (ops)
  (let ((new-ops (make-op-buffer)))
    (with-output-to-string (buf)
      (flet ((add-op (op)
               (compile-buffer buf new-ops)
               (push-op op new-ops)))
        (loop for op across ops do
             (ecase (first op)
               (:raw-string (write-sequence (second op) buf))
               ((:newline :embed-value :embed-code) (add-op op))
               ((:indent :unindent :freshline :toggle-indenting)
                (when *pretty* (add-op op)))))
        (compile-buffer buf new-ops)))
    new-ops))
(defun compile-buffer (buf ops)
  (loop with str = (get-output-stream-string buf)
     for start = 0 then (1+ pos)
     for pos = (position #Newline str :start start)
     when (< start (length str))
     do (push-op `(:raw-string ,(subseq str start pos) nil) ops)
     when pos do (push-op '(:newline) ops)
     while pos))

The last step is to translate the ops into the corresponding Common Lisp code. This phase also pays attention to the value of *pretty*. When *pretty* is true, it generates code that invokes the backend generic functions on *html-pretty-printer*, which will be bound to an instance of html-pretty-printer. When *pretty* is NIL, it generates code that writes directly to *html-output*, the stream to which the pretty printer would send its output.

The actual function, generate-code, is trivial.

(defun generate-code (ops)
  (loop for op across ops collect (apply #'op->code op)))

All the work is done by methods on the generic function op->code specializing the op argument with an EQL specializer on the name of the op.

(defgeneric op->code (op &rest operands))
(defmethod op->code ((op (eql :raw-string)) &rest operands)
  (destructuring-bind (string check-for-newlines) operands
    (if *pretty*
      `(raw-string *html-pretty-printer* ,string ,check-for-newlines)
      `(write-sequence ,string *html-output*))))
(defmethod op->code ((op (eql :newline)) &rest operands)
  (if *pretty*