anchor.diff:        (values ok r p))))
   
   (defun tracemsg (fmt &rest args)
  +  "Output an arbitrary but properly indented trace message."
     (when (plusp *trace*)
       (let ((indent (make-string (* 2 *trace-level*) :initial-element #\Space)))
         (format t "~&~a" indent)
         (apply #'format t fmt args))))
  -
  -(defun value (x) x)
  
positive.code: 
  (in-package :com.gigamonkeys.yamp)
  
  (defmacro defparser (name (&rest args) &body body)
    `(progn
       (eval-when (:compile-toplevel :load-toplevel :execute)
         (setf (get ',name 'parser-function) t))
       ,(compile-parser name args body)))
  
  (defun decompile (p)
    "Mostly for debugging. Essentially the same as macro expanding."
    (destructuring-bind (defparser name (&rest args) &rest body) p
      (declare (ignore defparser))
      (compile-parser name args body)))
  
  
  (defun compile-parser (name arglist body)
    (let* ((productions (mapcar #'normalize-production body))
           (names (mapcar #'caar productions)))
      (multiple-value-bind (args state-vars) (extract-state-variables arglist)
        (let ((state (append args (mapcar #'just-name state-vars))))
          (with-gensyms (txt pos)
            `(defun ,name (,txt ,pos ,@args)
               (let (,@state-vars)
                 (labels ((show-state (&optional label)
                            (tracemsg "~a: ~@{~(~a~): ~a~^; ~}"
                                      (or label "STATE")
                                      ,@(loop for n in state collect `(quote ,n) collect n)
                                      "pos" ,pos))
                          ,@(mapcar
                             #'(lambda (p) (compile-production p names state))
                             productions))
                   (,(first names) ,txt ,pos)))))))))
  
  (defun compile-production (p names state)
    (with-gensyms (txt pos)
      (destructuring-bind ((name &rest args) &rest body) p
        `(,name (,@args ,txt ,pos)
                (declare (ignorable ,txt))
                ,(compile-progn body txt pos names (gensym "R") state)))))
  
  (defun just-name (x)
    (typecase x
      (symbol x)
      (cons (first x))))
  
  (defun extract-state-variables (args)
    (let ((state (member `&state args)))
      (if state
          (values (ldiff args state) (cdr state))
          (values args nil))))
  
  (defun save-state-bindings (names)
    (mapcar #'(lambda (x) `(,(gensym (symbol-name x)) ,x)) names))
  
  (defun restore-state (bindings)
    (mapcar #'(lambda (x) `(setf ,@(reverse x))) bindings))
  
  (defun normalize-production (p)
    (destructuring-bind (x &rest body) p
      `(,(typecase x
           (cons x)
           (symbol (list x)))
         ,@body)))
  
  (defun grammar-p (name names)
    (or (member name names) (get name 'parser-function)))
  
  (defun good (result position) (values t result position))
  
  (defun bad (position) (values nil nil position))
  
  
  (defun compile-progn (body txt pos names result state)
    "Compile the forms in an PROGN so that the PROGN matches if each of
  
negative.code: 
  (defparserfun many (parser text position)
    "Match P as many times as possible. Always succeeds as zero is an
  acceptable number of times to match. Returns a list of the values
  returned by P."
    (loop with r = nil
       while t do
         (multiple-value-bind (ok result new-position) (funcall parser text position)
  