[Openmcl-devel] cl-ppcre speedup

[Alan Ruttenberg]

I was profiling the following expression

(cl-ppcre::scan "(\\S+)\\s*(.*)" "DE   Halobacterium halobium ribosomal 
proteins, partial and complete")

and char=, char/= and char<= were coming up highest in the breakdown.

One way to conservatively fix (least number of edits to the source) 
would be the following, which gets about a factor of 2x for the above 
expression.
Arguably, this might be considered for inclusion in openmcl proper.

Similar could be done for char-equal etc.

-Alan

#+openmcl
(define-compiler-macro char<= (&whole form &environment env  char &rest 
others)
   ""
   (if (and (= (ccl::speed-optimize-quantity env) 3)  (= 
(ccl::safety-optimize-quantity env) 0))
     (cond ((= (length others) 1)
	   `(ccl::%i<= (the fixnum (char-code (the character ,char))) (the 
fixnum (char-code (the character ,(car others))))))
	  ((= (length others) 2)
	   `(let ((middle (char-code (the character ,(car others)))))
	     (declare (fixnum middle))
	     (and (ccl::%i<= (the fixnum (char-code (the character ,char))) 
middle)
		  (ccl::%i<= middle (the fixnum (char-code (the character ,(second 
others))))))))
	  (t form))
     form))

#+openmcl
(define-compiler-macro char= (&whole form &environment env  char &rest 
others)
   ""
   (if (and (= (ccl::speed-optimize-quantity env) 3)  (= 
(ccl::safety-optimize-quantity env) 0))
     (cond ((= (length others) 1)
	   `(eq ,char ,(car others)))
	  (t form))
     form))

#+openmcl
(define-compiler-macro char/= (&whole form &environment env  char &rest 
others)
   ""
   (if (and (= (ccl::speed-optimize-quantity env) 3)  (= 
(ccl::safety-optimize-quantity env) 0))
     (cond ((= (length others) 1)
	   `(not (eq ,char ,(car others))))
	  (t form))
     form))

;; add the optimize declares in the lambdas below so the compiler 
optimization kicks in.

(defmethod create-matcher-aux ((char-class char-class) next-fn)
   (declare (type function next-fn))
   ;; insert a test against the current character within *STRING*
   (insert-char-class-tester (char-class (schar *string* start-pos))
     (if (invertedp char-class)
       (lambda (start-pos)
         (declare (type fixnum start-pos))
	(declare (optimize (speed 3) (safety 0)))
         (and (< start-pos *end-pos*)
              (not (char-class-test))
              (funcall next-fn (1+ start-pos))))
       (lambda (start-pos)
         (declare (type fixnum start-pos))
	(declare (optimize (speed 3) (safety 0)))
         (and (< start-pos *end-pos*)
              (char-class-test)
              (funcall next-fn (1+ start-pos)))))))