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*
`(newline *html-pretty-printer*)
`(write-char #\Newline *html-output*)))
(defmethod op->code ((op (eql :freshline)) &rest operands)
(if *pretty*
`(freshline *html-pretty-printer*)
(error "Bad op when not pretty-printing: ~a" op)))
(defmethod op->code ((op (eql :indent)) &rest operands)
(if *pretty*
`(indent *html-pretty-printer*)
(error "Bad op when not pretty-printing: ~a" op)))
(defmethod op->code ((op (eql :unindent)) &rest operands)
(if *pretty*
`(unindent *html-pretty-printer*)
(error "Bad op when not pretty-printing: ~a" op)))
(defmethod op->code ((op (eql :toggle-indenting)) &rest operands)
(if *pretty*
`(toggle-indenting *html-pretty-printer*)
(error "Bad op when not pretty-printing: ~a" op)))
The two most interesting op->code methods are the ones that generate code for the :embed-value and :embed-code ops. In the :embed-value method, you can generate slightly different code depending on the value of the escapes operand since if escapes is NIL, you don't need to generate a call to escape. And when both *pretty* and escapes are NIL, you can generate code that uses PRINC to emit the value directly to the stream.
(defmethod op->code ((op (eql :embed-value)) &rest operands)
(destructuring-bind (value escapes) operands
(if *pretty*
(if escapes
`(raw-string *html-pretty-printer* (escape (princ-to-string ,value) ,escapes) t)
`(raw-string *html-pretty-printer* (princ-to-string ,value) t))
(if escapes
`(write-sequence (escape (princ-to-string ,value) ,escapes) *html-output*)
`(princ ,value *html-output*)))))
Thus, something like this:
HTML> (let ((x 10)) (html (:p x)))
<p>10</p>
NIL
works because html translates (:p x) into something like this:
(progn
(write-sequence "<p>" *html-output*)
(write-sequence (escape (princ-to-string x) "<>&") *html-output*)
(write-sequence "</p>" *html-output*))
When that code replaces the call to html in the context of the LET, you get the following:
(let ((x 10))
(progn
(write-sequence "<p>" *html-output*)
(write-sequence (escape (princ-to-string x) "<>&") *html-output*)
(write-sequence "</p>" *html-output*)))
and the reference to x in the generated code turns into a reference to the lexical variable from the LET surrounding the html form.
The :embed-code method, on the other hand, is interesting because it's so trivial. Because process passed the form to embed-code, which stashed it in the :embed-code op, all you have to do is pull it out and return it.
(defmethod op->code ((op (eql :embed-code)) &rest operands)
(first operands))
This allows code like this to work:
HTML> (html (:ul (dolist (x '(foo bar baz)) (html (:li x)))))
<ul>
<li>FOO</li>
<li>BAR</li>