anchor.diff:                  ,(compile-expression else names))))
   
           ((stringp exp)
  -         (thunk (compile-string exp text state position)))
  +         (thunk (compile-string exp text position)))
   
           ((characterp exp)
  -         (thunk (compile-character exp text state position)))
  +         (thunk (compile-character exp text position)))
   
           (t exp)))))
   
  -(defun compile-string (str text state position)
  -  `(matching ,str ,(length str) ,text ,state ,position))
  -
  -(defun compile-character (char text state position)
  -  `(matching-char ,char ,text ,state ,position))
  -
  -(defun matching (s len text state position)
  +(defun compile-string (str text position)
  +  `(matching ,str ,(length str) ,text ,position))
  +
  +(defun compile-character (char text position)
  +  `(matching-char ,char ,text ,position))
  +
  +(defun matching (s len text position)
     (let* ((end (+ len position))
  -         (ok (string= s text :start2 position :end2 end)))
  -    (if ok
  -        (values t s state end)
  -        (values nil nil state position))))
  -
  -(defun matching-char (c text state position)
  -  (if (char= c (char text position))
  -      (values t c state (1+ position))
  -      (values nil nil state position)))
  -
  -(defun compile-match (parser txt s p)
  -  `(funcall ,parser ,txt ,s ,p))
  -
  -(defun compile-parser-call (exp names txt s p)
  +         (ok (if (<= end (length text)) (string= s text :start2 position :end2 end))))
  +    (if ok
  +        (good s end)
  +        (bad position))))
  +
  +(defun matching-char (c text position)
  +  (if (< position (length text))
  +      (if (char= c (char text position))
  +          (good c (1+ position))
  +          (bad position))
  +      (bad position)))
  +
  +
  +(defun compile-match (parser txt p)
  +  `(funcall ,parser ,txt ,p))
  +
  +(defun compile-parser-call (exp names txt p)
     (destructuring-bind (name &rest args) (rewrite-form exp names)
       (flet ((comp (x) (compile-expression x names)))
  -      `(,name ,@(mapcar #'comp args) ,txt ,s ,p))))
  +      `(,name ,@(mapcar #'comp args) ,txt ,p))))
   
   (defun rewrite-form (form names)
     "Rewrite bare symbols naming parser productions or parser functions
  
positive.code: (defun grammar-p (name names)
    (or (member name names) (get name 'parser-function)))
  
  (defun compile-progn (body txt st pos names result)
    "Compile the forms in an PROGN so that the PROGN matches if each of
  the elements matches in sequence."
    (unless (null body)
      (with-gensyms (s p)
        (compile-wrapped-form
         #'progn-wrapper
         (first body)
         txt st pos s p names result
         (compile-progn (rest body) txt s p names (gensym "R"))))))
  
  (defun progn-wrapper (expr ok result s p continuation failure)
    (if (null continuation)
        expr
        `(multiple-value-bind (,ok ,result ,s ,p) ,expr
           (if ,ok
               ,(or continuation `(values t ,result ,s ,p))
               ,failure))))
  
  (defun compile-or (body txt st pos names result)
    "Compile the forms in an OR so that the OR matches if any of the
  elements matches, returning the result from the first match."
    (unless (null body)
      (with-gensyms (s p)
        (compile-wrapped-form
         #'or-wrapper
         (first body)
         txt st pos s p names result
         (compile-or (rest body) txt s p names (gensym "R"))))))
  
  (defun or-wrapper (expr ok result s p continuation failure)
    `(multiple-value-bind (,ok ,result ,s ,p) ,expr
       (if ,ok
           (values t ,result ,s ,p)
           ,(or continuation failure))))
  
  (defun compile-wrapped-form (wrapper form text s-in p-in s p names r continuation)
    (with-gensyms (ok)
      (let ((failure `(values nil nil ,s-in ,p-in)))
        (labels ((wrap (expr) (funcall wrapper expr ok r s p continuation failure))
                 (self (expr) (compile-wrapped-form wrapper expr text s-in p-in s p names (gensym "R") nil)))
            (cond
  
              ((parser-function-invocation-p form names)
               (wrap (compile-parser-call form names text s-in p-in)))
  
              ((form-p '-> form)
               (destructuring-bind (expr var) (cdr form)
                 (funcall wrapper (self expr) ok var s p continuation failure)))
  
              ((form-p 'progn form)
               (wrap (compile-progn (rest form) text s-in p-in names r)))
  
              ((form-p 'or form)
               (wrap (compile-or (rest form) text s-in p-in names r)))
  
              ((form-p 'match form)
               (wrap (compile-match (cadr form) text s-in p-in)))
  
              ((form-p 'if form)
               (destructuring-bind (test then else) (cdr form)
                 (wrap `(if ,test ,(self then) ,(self else)))))
  
              ((stringp form)
               (wrap (compile-string form text s-in p-in)))
  
              ((characterp form)
               (wrap (compile-character form text s-in p-in)))
  
              (t `(values t ,form ,s-in ,p-in)))))))
  
  (defun compile-expression (exp names)
    (with-gensyms (text state position)
      (labels ((thunk (exp)
                 (if (and (consp exp) (grammar-p (car exp) names) (= (length exp) 4))
                     `(function ,(car exp))
                     `(lambda (,text ,state ,position) ,exp))))
        (cond
          ((parser-function-invocation-p exp names)
           (thunk (compile-parser-call exp names text state position)))
  
          ((form-p 'progn exp)
           (thunk (compile-progn (rest exp) text state position names (gensym "R"))))
  
          ((form-p 'or exp)
           (thunk (compile-or (rest exp) text state position names (gensym "R"))))
  
          ((form-p 'if exp)
           (destructuring-bind (test then else) (cdr exp)
  
negative.code:      (setf (get ',name 'parser-function) t)
       (defun ,name (,@args) ,@body)))
  
  (defparserfun any-char (text position)
    "Match a single character. Succeeds everywhere except at the EOF."
    (if (< position (length text))
        (good (char text position) (1+ position))
        (bad position)))
  
  (defparserfun try (p text position)
    "Attempt to parse using p, moving forward if it succeeds. However if
  it fails, it does not consume any input."
    (multiple-value-bind (ok r np) (funcall p text position)
      (if ok
          (good r np)
          (bad position))))
  
  (defparserfun many (parser text position)
    "Match P as many times as possible. Always succeeds as zero is an
  acceptable number of times to match."
    (loop with r = nil
       while t do
         (multiple-value-bind (ok result new-position) (funcall parser text position)
           (cond
             (ok
              (push result r)
              (setf position new-position))
             (t
              (return (good (nreverse r) position)))))))
  
  (defparserfun many1 (parser text position)
    "Match P as many times as possible but at least once."
    (multiple-value-bind (ok r p) (funcall parser text position)
      (if ok
          (multiple-value-bind (ok r2 p) (many parser text p)
            (if ok
                (good (cons r r2) p)
                (bad position))))))
  
  (defparserfun not-followed-by (p text position)
    "Match only if not followed by P."
    (values (not (funcall p text position)) text position))
  
  (defparserfun optional (p text position)
    "Match P if we can. Doesn't return anything. Only fails if P
  consumes input before failing."
    (multiple-value-bind (ok r pos) (funcall p text position)
      (declare (ignore r))
      (values (or ok (= pos position)) nil pos)))
  
  (defparserfun counted (n p text position)
    "Match P N times."
    (if (zerop n)
        (good text position)
        (multiple-value-bind (ok r pos) (funcall p text position)
          (declare (ignore r))
          (if ok
              (counted (1- n) p text pos)
              (bad position)))))
  
  (defparserfun look-ahead (p text position)
    (multiple-value-bind (ok r pos) (funcall p text position)
      (declare (ignore r pos))
      (if ok
          (good nil position)
          (bad position))))
  
  (defparserfun eod (text position)
    (if (<= (length text) position)
        (good t position)
        (bad position)))
  
  (defparserfun epsilon (text position)
    (declare (ignore text))
    (good nil position))
  
  (defparserfun text (p text position)
    "Capture the text matched by P."
    (multiple-value-bind (ok r pos) (funcall p text position)
      (declare (ignore r))
      (if ok
          (good (subseq text position pos) pos)
          (bad position))))
  