anchor.diff:      new-grammar))
   
   
  - 
  -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  -;;;
  -;;; Regexp Portability Layer.
  -;;;
  -;;; Used by the code generated by the Lisp generator below.
  -;;;
  -;;; On clisp, the user can choose to use the REGEXP package instead of
  -;;; CL-PPCRE, by adjoining :use-regexp instead of :use-ppcre to
  -;;; *features* (see the beginning of this file). 
  -
  -
  -
  -;; (:export "SPLIT-STRING"
  -;;          "STRING-MATCH" "MATCH-STRING" "MATCH-BEGINNING" "MATCH-END"
  -;;          "REGEXP-MATCh-ANY" "REGEXP-COMPILE" "REGEXP-QUOTE-EXTENDED")
  -
  -
  -(defun split-string (string regexp)
  -  #-(or use-ppcre (and clisp use-regexp))
  -  (error "Please implement ~S (perhaps push :use-ppcre on *features*)." 'split-string)
  -  #+(and clisp use-regexp) (regexp:regexp-split regexp string)
  -  #+use-ppcre (cl-ppcre:split regexp string))
  -
  -
  -(defvar *string-match-results* '())
  -
  -#+(and clisp use-regexp)
  -(defun nsubseq (sequence start &optional (end nil))
  -  "
  -RETURN:  When the SEQUENCE is a vector, the SEQUENCE itself, or a dispaced
  -         array to the SEQUENCE.
  -         When the SEQUENCE is a list, it may destroy the list and reuse the
  -         cons cells to make the subsequence.
  -"
  -  (if (vectorp sequence)
  -      (if (and (zerop start) (or (null end) (= end (length sequence))))
  -          sequence
  -          (make-array (- (if end
  -                             (min end (length sequence))
  -                             (length sequence))
  -                         start)
  -                      :element-type (array-element-type sequence)
  -                      :displaced-to sequence
  -                      :displaced-index-offset start))
  -      (let ((result (nthcdr start sequence)))
  -        (when end
  -          (setf (cdr (nthcdr (- end start -1) sequence)) nil))
  -        result)))
  -
  -(defun string-match (regexp string &key (start 0) (end nil))
  -  #-(or use-ppcre (and clisp use-regexp))
  -  (error "Please implement ~S (perhaps push :use-ppcre on *features*)." 'split-match)
  -  #+(and clisp use-regexp)
  -  (setf *string-match-results*
  -         (let ((results (if (stringp regexp)
  -                           (multiple-value-list
  -                            (regexp:match regexp string :start start :end end :extended t :ignore-case nil :newline t :nosub nil))
  -                           (regexp:regexp-exec (cdr regexp) string :start start :end end :return-type 'list))))
  -          (if (equal '(nil) results)
  -              nil
  -              results)))
  -  #+use-ppcre
  -  (setf *string-match-results*
  -        (let ((results (multiple-value-list
  -                        (if (stringp regexp)
  -                            (cl-ppcre:scan regexp       string :start start :end (or end (length string)))
  -                            (cl-ppcre:scan (cdr regexp) string :start start :end (or end (length string)))))))
  -          (if (equal '(nil) results)
  -              nil
  -              (destructuring-bind (as ae ss es) results
  -                  (list as ae
  -                        (concatenate 'vector (vector as) ss)
  -                        (concatenate 'vector (vector ae) es)))))))
  -
  -(defun match-string (index string &optional (match-results *string-match-results*))
  -  #-(or use-ppcre (and clisp use-regexp))
  -  (error "Please implement ~S (perhaps push :use-ppcre on *features*)." 'match-string)
  -  #+(and clisp use-regexp)
  -  (let ((m (elt match-results index)))
  -    (when m (regexp:match-string string m)))
  -  #+use-ppcre
  -  (let ((start (ignore-errors (aref (elt match-results 2) index)))
  -        (end   (ignore-errors (aref (elt match-results 3) index))))
  -    (when (and start end)
  -      (subseq string start end))))
  -
  -(defun match-beginning (index &optional (match-results *string-match-results*))
  -  #-(or use-ppcre (and clisp use-regexp))
  -  (error "Please implement ~S (perhaps push :use-ppcre on *features*)." 'match-beginning)
  -  #+(and clisp use-regexp)
  -  (let ((m (elt match-results index)))
  -    (when m (regexp:match-start m)))
  -  #+use-ppcre
  -  (ignore-errors (aref (elt match-results 2) index)))
  -
  -(defun match-end (index &optional (match-results *string-match-results*))
  -  #-(or use-ppcre (and clisp use-regexp))
  -  (error "Please implement ~S (perhaps push :use-ppcre on *features*)." 'match-end)
  -  #+(and clisp use-regexp)
  -  (let ((m (elt match-results index)))
  -    (when m (regexp:match-end m)))
  -  #+use-ppcre
  -  (ignore-errors (aref (elt match-results 3) index)))
  -
  -(defun regexp-match-any (groupsp)
  -  #- (or use-ppcre (and clisp use-regexp))
  -  (error "Please implement ~S (perhaps push :use-ppcre on *features*)." 'regexp-match-any)
  -  #+(and clisp use-regexp) (if groupsp "(.*)" ".*")
  -  #+use-ppcre              (if groupsp "(.*)" ".*"))
  -
  -(defun regexp-compile (regexp)
  -  #- (or use-ppcre (and clisp use-regexp))
  -  (error "Please implement ~S (perhaps push :use-ppcre on *features*)." 'regexp-compile)
  -  #+(and clisp use-regexp) (regexp:regexp-compile regexp
  -                                                  :extended t
  -                                                  :ignore-case nil
  -                                                  :newline t
  -                                                  :nosub nil)
  -  #+use-ppcre (cl-ppcre:create-scanner regexp
  -                                       :case-insensitive-mode nil
  -                                       :multi-line-mode nil
  -                                       :extended-mode nil
  -                                       :destructive nil))
  -
  -(defun regexp-quote-extended (string)
  -  ;; #+clisp regexp:regexp-quote doesn't quote extended regexps...
  -  ;;        (regexp:regexp-quote "(abc .*" t) --> "(abc \\.\\*"  instead of "\\(abc \\.\\*"
  -  #-use-ppcre
  -  (let* ((special-characters "^.[$()|*+?{\\")
  -         (increase (count-if (lambda (ch) (find ch special-characters)) string)))
  -     (if (zerop increase)
  -         string
  -         (let ((result (make-array (+ (length string) increase)
  -                                    :element-type 'character)))
  -           (loop
  -              :with i = -1
  -              :for ch :across string
  -              :do (if (find ch special-characters)
  -                      (setf (aref result (incf i)) #\\
  -                            (aref result (incf i)) ch)
  -                      (setf (aref result (incf i)) ch)))
  -           result)))
  -  #+use-ppcre
  -  (cl-ppcre:quote-meta-chars string))
  -
   
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;;
  
positive.code:      `',(grammar-scanner grammar))))
  
  
  (defmethod gen-parse-function-name ((target (eql :lisp)) (grammar grammar) non-terminal)
    (intern (format nil "~:@(~A/PARSE-~A~)" (grammar-name grammar) non-terminal)))
  
  (defmethod gen-in-firsts ((target (eql :lisp)) firsts)
    (if (null (cdr firsts))
        `(word-equal (scanner-current-token scanner) ',(car firsts))
        `(member  (scanner-current-token scanner) ',firsts
                  :test (function word-equal))))
  
  
  
  
  ;; (com.informatimago.rdp::find-rules (grammar-named 'normalized-encoding) 'request)
  (defstruct sentence-node word attribute)
  
  ;; Not finished.
  ;; (defun attribute-rule (grammar nt item)
  ;;   (ecase item
  
negative.code: ;;                                                                    (sentence-node-attribute (first rest-sentence))))
  ;;                                                 (first-set grammar (first sentence))))
  ;;              rest-sentence))))
  ;;
  ;; (defun process-sentence (grammar nt sentence)
  ;;   (if (null sentence)
  ;;       (list (make-sentence-node :word nil :attribute (follow-set grammar nt)))
  ;;       (let ((rest-sentence (process-sentence grammar nt (rest sentence))))
  ;;        (cons (make-sentence-node :word (first sentence)
  ;;                                  :attribute (if (nullablep grammar (first sentence))
  ;;                                                 (remove nil (union (first-set grammar (first sentence))
  ;;                                                                    (sentence-node-attribute (first rest-sentence))))
  ;;                                                 (first-set grammar (first sentence))))
  ;;              rest-sentence))))
  
  
  ;;;------------------------------------------------------------
  ;;; RDP Parser Generator
  ;;;------------------------------------------------------------
  
  (defvar *non-terminal-stack* '()
    "For error reporting.")
  
  (defmacro with-non-terminal (non-terminal &body body)
    `(let ((*non-terminal-stack* (cons ',non-terminal *non-terminal-stack*)))
       ;; (print *non-terminal-stack*)
       ,@body))
  
  (defmethod gen-parse-function-name ((target (eql :lisp)) (grammar grammar) non-terminal)
    (intern (format nil "~:@(~A/PARSE-~A~)" (grammar-name grammar) non-terminal)))
  
  (defmethod gen-in-firsts ((target (eql :lisp)) firsts)
    (if (null (cdr firsts))
        `(word-equal (scanner-current-token scanner) ',(car firsts))
        `(member  (scanner-current-token scanner) ',firsts
                  :test (function word-equal))))
  
  (defmethod gen-parsing-statement ((target (eql :lisp)) (grammar grammar) item)
    ;; If we want to generate the parser directly from the grammar with
  