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)))))))