OSCL/cl-ppcre
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Rewrite SEQ without using recursion.

Browse Source 
Allows for very long regexes to be processed.
Doesn't require the result to be reversed afterwards.
This commit is contained in:
Stas Boukarev
2013-02-13 21:29:23 +04:00
parent 7ad13f568e
commit 7d64a90203
2 changed files with 40 additions and 70 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
lexer.lisp
View File

@ -290,8 +290,7 @@ handled elsewhere."
(return)) (return))
(write-char char out)))))) (write-char char out))))))
(list (if (char= first-char #\p) :property :inverted-property) (list (if (char= first-char #\p) :property :inverted-property)
;; we must reverse here because of what PARSE-STRING does name)))
(nreverse name))))
(defun collect-char-class (lexer) (defun collect-char-class (lexer)
"Reads and consumes characters from regex string until a right "Reads and consumes characters from regex string until a right
@ -571,7 +570,7 @@ closing #\> will also be consumed."
;; back-referencing a named register ;; back-referencing a named register
(incf (lexer-pos lexer)) (incf (lexer-pos lexer))
(list :back-reference (list :back-reference
(nreverse (parse-register-name-aux lexer)))) (parse-register-name-aux lexer)))
(t (t
;; false alarm, just unescape \k ;; false alarm, just unescape \k
#\k))) #\k)))

105
parser.lisp
View File

@ -128,10 +128,7 @@ Will return <parse-tree> or \(<grouping-type> <parse-tree>) where
;; have been the "(?:"<regex>")" production ;; have been the "(?:"<regex>")" production
(cons :group (nconc flags (list reg-expr))) (cons :group (nconc flags (list reg-expr)))
(if (eq open-token :open-paren-less-letter) (if (eq open-token :open-paren-less-letter)
(list :named-register (list :named-register register-name
;; every string was reversed, so we have to
;; reverse it back to get the name
(nreverse register-name)
reg-expr) reg-expr)
(list (case open-token (list (case open-token
((:open-paren) ((:open-paren)
@ -201,54 +198,42 @@ Will return <parse-tree> or (:SEQUENCE <parse-tree> <parse-tree>)."
;; to parse a <seq> or <quant> in order to catch empty regular ;; to parse a <seq> or <quant> in order to catch empty regular
;; expressions ;; expressions
(if (start-of-subexpr-p lexer) (if (start-of-subexpr-p lexer)
(let ((quant (quant lexer))) (loop with seq-is-sequence-p = nil
(if (start-of-subexpr-p lexer) with last-cdr
(let* ((seq (seq lexer)) for quant = (quant lexer)
(quant-is-char-p (characterp quant)) for quant-is-char-p = (characterp quant)
(seq-is-sequence-p (and (consp seq) for seq = quant
(eq (first seq) :sequence)))) then
(cond ((and quant-is-char-p (cond ((and quant-is-char-p (characterp seq))
(characterp seq)) (make-array-from-two-chars seq quant))
(make-array-from-two-chars seq quant)) ((and quant-is-char-p (stringp seq))
((and quant-is-char-p (vector-push-extend quant seq)
(stringp seq)) seq)
(vector-push-extend quant seq) ((not seq-is-sequence-p)
seq) (setf last-cdr (list quant)
((and quant-is-char-p seq-is-sequence-p t)
seq-is-sequence-p (list* :sequence seq last-cdr))
(characterp (second seq))) ((and quant-is-char-p
(cond ((cddr seq) (characterp (car last-cdr)))
(setf (cdr seq) (setf (car last-cdr)
(cons (make-array-from-two-chars (car last-cdr)
(make-array-from-two-chars (second seq) quant))
quant) seq)
(cddr seq))) ((and quant-is-char-p
seq) (stringp (car last-cdr)))
(t (make-array-from-two-chars (second seq) quant)))) (vector-push-extend quant (car last-cdr))
((and quant-is-char-p seq)
seq-is-sequence-p (t
(stringp (second seq))) ;; if <seq> is also a :SEQUENCE parse tree we merge
(cond ((cddr seq) ;; both lists into one
(setf (cdr seq) (let ((cons (list quant)))
(cons (psetf last-cdr cons
(progn (cdr last-cdr) cons))
(vector-push-extend quant (second seq)) seq))
(second seq)) while (start-of-subexpr-p lexer)
(cddr seq))) finally (return seq))
seq) :void)))
(t
(vector-push-extend quant (second seq))
(second seq))))
(seq-is-sequence-p
;; if <seq> is also a :SEQUENCE parse tree we merge
;; both lists into one to avoid unnecessary consing
(setf (cdr seq)
(cons quant (cdr seq)))
seq)
(t (list :sequence quant seq))))
quant))
:void)))
(defun reg-expr (lexer) (defun reg-expr (lexer)
"Parses and consumes a <regex>, a complete regular expression. "Parses and consumes a <regex>, a complete regular expression.
The productions are: <regex> -> <seq> | <seq>\"|\"<regex>. The productions are: <regex> -> <seq> | <seq>\"|\"<regex>.
@ -294,25 +279,11 @@ Will return <parse-tree> or (:ALTERNATION <parse-tree> <parse-tree>)."
(setf (lexer-pos lexer) pos) (setf (lexer-pos lexer) pos)
seq))))))) seq)))))))
(defun reverse-strings (parse-tree)
"Recursively walks through PARSE-TREE and destructively reverses all
strings in it."
(declare #.*standard-optimize-settings*)
(cond ((stringp parse-tree)
(nreverse parse-tree))
((consp parse-tree)
(loop for parse-tree-rest on parse-tree
while parse-tree-rest
do (setf (car parse-tree-rest)
(reverse-strings (car parse-tree-rest))))
parse-tree)
(t parse-tree)))
(defun parse-string (string) (defun parse-string (string)
"Translate the regex string STRING into a parse tree." "Translate the regex string STRING into a parse tree."
(declare #.*standard-optimize-settings*) (declare #.*standard-optimize-settings*)
(let* ((lexer (make-lexer string)) (let* ((lexer (make-lexer string))
(parse-tree (reverse-strings (reg-expr lexer)))) (parse-tree (reg-expr lexer)))
;; check whether we've consumed the whole regex string ;; check whether we've consumed the whole regex string
(if (end-of-string-p lexer) (if (end-of-string-p lexer)
parse-tree parse-tree