diff --git api.lisp api.lisp index 9b0d451..617d2eb 100644 --- api.lisp +++ api.lisp @@ -29,12 +29,14 @@ ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +(declaim (optimize (debug 3) (safety 3))) (in-package :cl-ppcre) (defgeneric create-scanner (regex &key case-insensitive-mode multi-line-mode single-line-mode extended-mode + ub8-mode destructive) (:documentation "Accepts a regular expression - either as a parse-tree or as a string - and returns a scan closure which will scan @@ -49,6 +51,7 @@ (defmethod create-scanner ((regex-string string) &key case-insensitive-mode multi-line-mode single-line-mode extended-mode + ub8-mode destructive) (declare #.*standard-optimize-settings*) (declare (ignore destructive)) @@ -65,6 +68,7 @@ (defmethod create-scanner ((regex-string string) &key case-insensitive-mode :case-insensitive-mode case-insensitive-mode :multi-line-mode multi-line-mode :single-line-mode single-line-mode + :ub8-mode ub8-mode :destructive t))) #-:use-acl-regexp2-engine @@ -72,10 +76,11 @@ (defmethod create-scanner ((scanner function) &key case-insensitive-mode multi-line-mode single-line-mode extended-mode + ub8-mode destructive) (declare #.*standard-optimize-settings*) (declare (ignore destructive)) - (when (or case-insensitive-mode multi-line-mode single-line-mode extended-mode) + (when (or case-insensitive-mode multi-line-mode single-line-mode extended-mode ub8-mode) (signal-invocation-error "You can't use the keyword arguments to modify an existing scanner.")) scanner) @@ -84,6 +89,7 @@ (defmethod create-scanner ((parse-tree t) &key case-insensitive-mode multi-line-mode single-line-mode extended-mode + ub8-mode destructive) (declare #.*standard-optimize-settings*) (when extended-mode @@ -125,10 +131,12 @@ (defmethod create-scanner ((parse-tree t) &key case-insensitive-mode (if (= 1 (len end-string)) (create-char-searcher (schar (str end-string) 0) - (case-insensitive-p end-string)) + (case-insensitive-p end-string) + ub8-mode) (create-bmh-matcher (str end-string) - (case-insensitive-p end-string))))) + (case-insensitive-p end-string) + ub8-mode)))) ;; initialize the counters for CREATE-MATCHER-AUX (*rep-num* 0) (*zero-length-num* 0) @@ -144,10 +152,12 @@ (defmethod create-scanner ((parse-tree t) &key case-insensitive-mode (if (= 1 (len starts-with)) (create-char-searcher (schar (str starts-with) 0) - (case-insensitive-p starts-with)) + (case-insensitive-p starts-with) + ub8-mode) (create-bmh-matcher (str starts-with) - (case-insensitive-p starts-with)))))) + (case-insensitive-p starts-with) + ub8-mode))))) (declare (special end-string-offset end-anchored-p end-string)) ;; now create the scanner and return it (values (create-scanner-aux match-fn @@ -173,7 +183,8 @@ (defmethod create-scanner ((parse-tree t) &key case-insensitive-mode end-string-offset *rep-num* *zero-length-num* - reg-num) + reg-num + ub8-mode) reg-names)))))) #+:use-acl-regexp2-engine @@ -183,10 +194,11 @@ (defmethod create-scanner ((scanner regexp::regular-expression) &key case-insens multi-line-mode single-line-mode extended-mode + ub8-mode destructive) (declare #.*standard-optimize-settings*) (declare (ignore destructive)) - (when (or case-insensitive-mode multi-line-mode single-line-mode extended-mode) + (when (or case-insensitive-mode multi-line-mode single-line-mode extended-mode ub8-mode) (signal-invocation-error "You can't use the keyword arguments to modify an existing scanner.")) scanner) @@ -195,6 +207,7 @@ (defmethod create-scanner ((parse-tree t) &key case-insensitive-mode multi-line-mode single-line-mode extended-mode + ub8-mode destructive) (declare #.*standard-optimize-settings*) (declare (ignore destructive)) @@ -220,33 +233,36 @@ (defgeneric scan (regex target-string &key start end real-start-pos) (defmethod scan ((regex-string string) target-string &key (start 0) (end (length target-string)) + (ub8-mode) ((:real-start-pos *real-start-pos*) nil)) (declare #.*standard-optimize-settings*) ;; note that the scanners are optimized for simple strings so we ;; have to coerce TARGET-STRING into one if it isn't already - (funcall (create-scanner regex-string) - (maybe-coerce-to-simple-string target-string) + (funcall (create-scanner regex-string :ub8-mode ub8-mode) + (maybe-coerce-to-simple-string target-string ub8-mode) start end)) #-:use-acl-regexp2-engine (defmethod scan ((scanner function) target-string &key (start 0) (end (length target-string)) + (ub8-mode) ((:real-start-pos *real-start-pos*) nil)) (declare #.*standard-optimize-settings*) (funcall scanner - (maybe-coerce-to-simple-string target-string) - start end)) + (maybe-coerce-to-simple-string target-string ub8-mode) + start end :ub8-mode ub8-mode)) #-:use-acl-regexp2-engine (defmethod scan ((parse-tree t) target-string &key (start 0) (end (length target-string)) + (ub8-mode) ((:real-start-pos *real-start-pos*) nil)) (declare #.*standard-optimize-settings*) - (funcall (create-scanner parse-tree) - (maybe-coerce-to-simple-string target-string) - start end)) + (funcall (create-scanner parse-tree :ub8-mode ub8-mode) + (maybe-coerce-to-simple-string target-string ub8-mode) + start end :ub8-mode ub8-mode)) #+:use-acl-regexp2-engine (declaim (inline scan)) @@ -254,6 +270,7 @@ (defmethod scan ((parse-tree t) target-string (defmethod scan ((parse-tree t) target-string &key (start 0) (end (length target-string)) + (ub8-mode) ((:real-start-pos *real-start-pos*) nil)) (declare #.*standard-optimize-settings*) (when (< end start) @@ -277,15 +294,16 @@ (defmethod scan ((parse-tree t) target-string (values (car match) (cdr match) reg-starts reg-ends)))))) #-:cormanlisp -(define-compiler-macro scan (&whole form &environment env regex target-string &rest rest) +(define-compiler-macro scan (&whole form &environment env regex target-string &rest rest &key ub8-mode &allow-other-keys) "Make sure that constant forms are compiled into scanners at compile time." (cond ((constantp regex env) - `(scan (load-time-value (create-scanner ,regex)) + `(scan (load-time-value (create-scanner ,regex :ub8-mode ,ub8-mode)) ,target-string ,@rest)) (t form))) (defun scan-to-strings (regex target-string &key (start 0) (end (length target-string)) + (ub8-mode) sharedp) "Like SCAN but returns substrings of TARGET-STRING instead of positions, i.e. this function returns two values on success: the whole @@ -294,7 +312,7 @@ (defun scan-to-strings (regex target-string &key (start 0) share structure with TARGET-STRING." (declare #.*standard-optimize-settings*) (multiple-value-bind (match-start match-end reg-starts reg-ends) - (scan regex target-string :start start :end end) + (scan regex target-string :start start :end end :ub8-mode ub8-mode) (unless match-start (return-from scan-to-strings nil)) (let ((substr-fn (if sharedp #'nsubseq #'subseq))) @@ -311,10 +329,10 @@ (defun scan-to-strings (regex target-string &key (start 0) #-:cormanlisp (define-compiler-macro scan-to-strings - (&whole form &environment env regex target-string &rest rest) + (&whole form &environment env regex target-string &rest rest &key ub8-mode &allow-other-keys) "Make sure that constant forms are compiled into scanners at compile time." (cond ((constantp regex env) - `(scan-to-strings (load-time-value (create-scanner ,regex)) + `(scan-to-strings (load-time-value (create-scanner ,regex :ub8-mode ,ub8-mode)) ,target-string ,@rest)) (t form))) @@ -358,7 +376,7 @@ (defmacro register-groups-bind (var-list (regex target-string (defmacro do-scans ((match-start match-end reg-starts reg-ends regex target-string &optional result-form - &key start end) + &key start end ub8-mode) &body body &environment env) "Iterates over TARGET-STRING and tries to match REGEX as often as @@ -389,7 +407,7 @@ (defmacro do-scans ((match-start match-end reg-starts reg-ends regex ;; coerce TARGET-STRING to a simple string unless it is one ;; already (otherwise SCAN will do this on each iteration) (setq ,target-string - (maybe-coerce-to-simple-string ,target-string)) + (maybe-coerce-to-simple-string ,target-string ,ub8-mode)) (loop ;; invoke SCAN and bind the returned values to the ;; provided variables diff --git closures.lisp closures.lisp index a275078..aeb57a2 100644 --- closures.lisp +++ closures.lisp @@ -30,6 +30,8 @@ ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +(declaim (optimize (debug 3) (safety 3))) + (in-package :cl-ppcre) (declaim (inline *string*= *string*-equal)) diff --git lexer.lisp lexer.lisp index 71c2642..2625b31 100644 --- lexer.lisp +++ lexer.lisp @@ -68,7 +68,7 @@ (defstruct (lexer (:constructor make-lexer-internal)) (defun make-lexer (string) (declare (inline make-lexer-internal) #-:genera (string string)) - (make-lexer-internal :str (maybe-coerce-to-simple-string string) + (make-lexer-internal :str (maybe-coerce-to-simple-string string 'nil) :len (length string))) (declaim (inline end-of-string-p)) diff --git scanner.lisp scanner.lisp index ea43443..bd59a92 100644 --- scanner.lisp +++ scanner.lisp @@ -52,7 +52,7 @@ (defmacro bmh-matcher-aux (&key case-insensitive-p) finally (if (minusp j) (return-from bmh-matcher (1+ i))))))))) -(defun create-bmh-matcher (pattern case-insensitive-p) +(defun create-bmh-matcher (pattern case-insensitive-p ub8-p) "Returns a Boyer-Moore-Horspool matcher which searches the (special) simple-string *STRING* for the first occurence of the substring PATTERN. The search starts at the position START-POS within *STRING* @@ -64,16 +64,31 @@ (defun create-bmh-matcher (pattern case-insensitive-p) ;; see for ;; details (unless *use-bmh-matchers* - (let ((test (if case-insensitive-p #'char-equal #'char=))) - (return-from create-bmh-matcher - (lambda (start-pos) - (declare (fixnum start-pos)) - (and (not (minusp start-pos)) - (search pattern - *string* - :start2 start-pos - :end2 *end-pos* - :test test)))))) + (return-from create-bmh-matcher + (let ((test (if ub8-p + (if case-insensitive-p + (lambda (b c) (char-equal (code-char b) c)) + (lambda (b c) (char= (code-char b) c))) + (if case-insensitive-p + #'char-equal + #'char=)))) + (if ub8-p + (lambda (start-pos) + (declare (fixnum start-pos)) + (and (not (minusp start-pos)) + (search pattern + *byte-vec* + :start2 start-pos + :end2 *end-pos* + :test test))) + (lambda (start-pos) + (declare (fixnum start-pos)) + (and (not (minusp start-pos)) + (search pattern + *string* + :start2 start-pos + :end2 *end-pos* + :test test))))))) (let* ((m (length pattern)) (skip (make-array *regex-char-code-limit* :element-type 'fixnum @@ -89,25 +104,31 @@ (defun create-bmh-matcher (pattern case-insensitive-p) (bmh-matcher-aux :case-insensitive-p t) (bmh-matcher-aux)))) -(defmacro char-searcher-aux (&key case-insensitive-p) - "Auxiliary macro used by CREATE-CHAR-SEARCHER." - (let ((char-compare (if case-insensitive-p 'char-equal 'char=))) - `(lambda (start-pos) - (declare (fixnum start-pos)) - (and (not (minusp start-pos)) - (loop for i of-type fixnum from start-pos below *end-pos* - thereis (and (,char-compare (schar *string* i) chr) i)))))) +(defun char-searcher-aux (char index case-insensitive-p ub8-p) + "Auxiliary function used by CREATE-CHAR-SEARCHER." + (if ub8-p + (if case-insensitive-p + `(char-equal (code-char (svref *byte-vec* ,index)) ,char) + `(char= (code-char (svref *byte-vec* ,index)) ,char)) + (if case-insensitive-p + `(char-equal (schar *string* ,index) ,char) + `(char= (schar *string* ,index) ,char)))) + -(defun create-char-searcher (chr case-insensitive-p) +(defun create-char-searcher (chr case-insensitive-p ub8-p) "Returns a function which searches the (special) simple-string -*STRING* for the first occurence of the character CHR. The search -starts at the position START-POS within *STRING* and stops before -*END-POS* is reached. Depending on the second argument the search is -case-insensitive or not." + *STRING* for the first occurence of the character CHR. The search + starts at the position START-POS within *STRING* and stops before + *END-POS* is reached. Depending on the second argument the search is + case-insensitive or not. Depending on the third argument *byte-vec* + is searched." (declare #.*standard-optimize-settings*) - (if case-insensitive-p - (char-searcher-aux :case-insensitive-p t) - (char-searcher-aux))) + `(lambda (start-pos) + (declare #.*standard-optimize-settings*) + (declare (fixnum start-pos)) + (and (not (minusp start-pos)) + (loop for i of-type fixnum from start-pos below *end-pos* + thereis ,(char-searcher-aux chr 'i case-insensitive-p ub8-p))))) (declaim (inline newline-skipper)) (defun newline-skipper (start-pos) @@ -123,17 +144,17 @@ (defun newline-skipper (start-pos) #\Newline) (1+ i)))) -(defmacro insert-advance-fn (advance-fn) +(defmacro insert-advance-fn (advance-fn ub8-mode) "Creates the actual closure returned by CREATE-SCANNER-AUX by replacing '(ADVANCE-FN-DEFINITION) with a suitable definition for ADVANCE-FN. This is a utility macro used by CREATE-SCANNER-AUX." (subst advance-fn '(advance-fn-definition) - '(lambda (string start end) + `(lambda (string start end) (block scan ;; initialize a couple of special variables used by the ;; matchers (see file specials.lisp) - (let* ((*string* string) + (let* ((,(if ub8-mode '*byte-vec* '*string*) string) (*start-pos* start) (*end-pos* end) ;; we will search forward for END-STRING if this value @@ -319,7 +340,8 @@ (defun create-scanner-aux (match-fn end-string-offset rep-num zero-length-num - reg-num) + reg-num + ub8-mode) "Auxiliary function to create and return a scanner \(which is actually a closure). Used by CREATE-SCANNER." (declare #.*standard-optimize-settings*) @@ -385,7 +407,8 @@ (defun create-scanner-aux (match-fn ;; so we have to redo the inner LOOP to ;; find another end string candidate ;; further to the right - (setq try-pos (1+ *end-string-pos*)))))))))))) + (setq try-pos (1+ *end-string-pos*)))))))))) + ub8-mode)) ((and starts-with-everything end-string-test end-string-offset) ;; we know that the regular expression starts with ".*" (which ;; is not in single-line-mode, see CREATE-SCANNER-AUX) and ends @@ -437,7 +460,8 @@ (defun create-scanner-aux (match-fn ;; so we have to redo the inner LOOP to ;; find another end string candidate ;; further to the right - (setq try-pos (1+ *end-string-pos*)))))))))))) + (setq try-pos (1+ *end-string-pos*)))))))))) + ub8-mode)) ((and start-string-test end-string-test) ;; we know that the regular expression has constant start and ;; end strings; similar to the first case but we only need to @@ -453,7 +477,8 @@ (defun create-scanner-aux (match-fn (return-from advance-fn pos)) (unless (setq *end-string-pos* (funcall end-string-test pos)) (return-from scan nil)) - pos))) + pos) + ub8-mode)) ((and starts-with-everything end-string-test) ;; we know that the regular expression starts with ".*" (which ;; is not in single-line-mode, see CREATE-SCANNER-AUX) and ends @@ -470,7 +495,8 @@ (defun create-scanner-aux (match-fn (return-from advance-fn pos)) (unless (setq *end-string-pos* (funcall end-string-test pos)) (return-from scan nil)) - pos))) + pos) + ub8-mode)) (start-string-test ;; just check for constant start string candidate (insert-advance-fn @@ -478,14 +504,16 @@ (defun create-scanner-aux (match-fn (declare (function start-string-test)) (unless (setq pos (funcall start-string-test pos)) (return-from scan nil)) - pos))) + pos) + ub8-mode)) (starts-with-everything ;; just advance POS with NEWLINE-SKIPPER (insert-advance-fn (advance-fn (pos) (unless (setq pos (newline-skipper pos)) (return-from scan nil)) - pos))) + pos) + ub8-mode)) (end-string-test ;; just check for the next end string candidate if POS has ;; advanced beyond the last one @@ -497,10 +525,12 @@ (defun create-scanner-aux (match-fn (return-from advance-fn pos)) (unless (setq *end-string-pos* (funcall end-string-test pos)) (return-from scan nil)) - pos))) + pos) + ub8-mode)) (t ;; not enough optimization information about the regular ;; expression to optimize so we just return POS (insert-advance-fn (advance-fn (pos) - pos)))))) + pos) + ub8-mode))))) diff --git specials.lisp specials.lisp index 547a1ab..48c9356 100644 --- specials.lisp +++ specials.lisp @@ -35,10 +35,10 @@ (defvar *standard-optimize-settings* '(optimize - speed - (safety 0) + (speed 0) + (safety 3) (space 0) - (debug 1) + (debug 3) (compilation-speed 0) #+:lispworks (hcl:fixnum-safety 0)) "The standard optimize settings used by most declaration expressions.") @@ -61,6 +61,7 @@ (defvar *regex-char-code-limit* char-code-limit scanners if you don't need the \(full) Unicode support of implementations like AllegroCL, CLISP, LispWorks, or SBCL.") (declaim (fixnum *regex-char-code-limit*)) +;; TODO: depends on ub8-mode? (defvar *string* "" "The string which is currently scanned by SCAN. @@ -70,6 +71,16 @@ (defvar *string* "" #-:lispworks (declaim (simple-string *string*)) +(defvar *byte-vec* + (make-array 1 + :element-type '(unsigned-byte 8)) + "The string which is currently scanned by SCAN. +Will always be coerced to a SIMPLE-STRING.") +#+:lispworks +(declaim (lw:simple-vector *byte-vec*)) ;; TODO +#-:lispworks +(declaim (type (simple-array (unsigned-byte 8) *) *byte-vec*)) + (defvar *start-pos* 0 "Where to start scanning within *STRING*.") (declaim (fixnum *start-pos*)) diff --git util.lisp util.lisp index 8dd5fd2..6d3b6ad 100644 --- util.lisp +++ util.lisp @@ -133,19 +133,21 @@ (defun whitespacep (chr) match [\\s] in Perl." (find chr +whitespace-char-string+ :test #'char=)) -(defmacro maybe-coerce-to-simple-string (string) +(defmacro maybe-coerce-to-simple-string (string ub8-mode) "Coerces STRING to a simple STRING unless it already is one." (with-unique-names (=string=) `(let ((,=string= ,string)) - (cond (#+:lispworks - (lw:simple-text-string-p ,=string=) - #-:lispworks - (simple-string-p ,=string=) - ,=string=) - (t - (coerce ,=string= - #+:lispworks 'lw:simple-text-string - #-:lispworks 'simple-string)))))) + ,(if ub8-mode + `, =string= + `(cond (#+:lispworks + (lw:simple-text-string-p ,=string=) + #-:lispworks + (simple-string-p ,=string=) + ,=string=) + (t + (coerce ,=string= + #+:lispworks 'lw:simple-text-string + #-:lispworks 'simple-string))))))) (declaim (inline nsubseq)) (defun nsubseq (sequence start &optional (end (length sequence))) @@ -198,4 +200,4 @@ (defun complement* (test-function) (otherwise (lambda (char) (declare (character char)) - (not (funcall test-function char)))))) \ No newline at end of file + (not (funcall test-function char))))))