Changeset 9359


Ignore:
Timestamp:
May 5, 2008, 4:02:54 PM (11 years ago)
Author:
mb
Message:

Implement minor optimizations for string-equal.

Location:
branches/working-0711/ccl
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/optimizers.lisp

    r9357 r9359  
    18721872        (= ,gtype ,(nx-lookup-target-uvector-subtag :simple-string))))))
    18731873
     1874(define-compiler-macro string-equal (&whole call
     1875                                     &environment env
     1876                                     string1 string2
     1877                                     &rest keys)
     1878  (if (null keys)
     1879    (once-only ((string1 string1)
     1880                (string2 string2)
     1881                (s1 0)
     1882                (e1 `(length ,string1))
     1883                (s2 0)
     1884                (e2 `(length ,string2)))
     1885      `(when (= ,e1 ,e2)
     1886         (if (not (typep ,string1 'simple-string env))
     1887           (multiple-value-setq (,string1 ,s1 ,e1)
     1888             (string-start-end (string ,string1) ,s1 ,e1)))
     1889         (if (not (typep ,string2 'simple-string env))
     1890           (multiple-value-setq (,string2 ,s2 ,e2)
     1891             (string-start-end (string ,string2) ,s2 ,e2)))
     1892         (%string-equal ,string1 ,s1 ,e1
     1893                        ,string2 ,s2 ,e2)))
     1894    call))
    18741895
    18751896(defsetf %misc-ref %misc-set)
    1876 
    18771897
    18781898(define-compiler-macro lockp (lock)
  • branches/working-0711/ccl/lib/chars.lisp

    r9357 r9359  
    445445      (setq start2 0 end2 (length string2))
    446446      (multiple-value-setq (string2 start2 end2)(string-start-end string2 start2 end2)))
    447     (setq istart1 (%i- start1 istart1))       
     447    (setq istart1 (%i- start1 istart1))
    448448    (let* ((val t))
    449449      (declare (optimize (speed 3)(safety 0)))
     
    452452           ()
    453453        (when (eq i end1)
    454           (when (neq j end2)(setq val -1))
     454          (when (neq j end2)
     455            (setq val -1))
    455456          (return))
    456457        (when (eq j end2)
    457458          (setq end1 i)
    458           (setq val 1)(return))
     459          (setq val 1)
     460          (return))
    459461        (let ((code1 (%scharcode string1 i))
    460462              (code2 (%scharcode string2 j)))
     
    501503    (if (eq result -1) nil pos)))
    502504
    503 (defun string-equal (string1 string2 &key start1 end1 start2 end2)
     505(defun string-equal (string1 string2 &key (start1 0) (end1 (length (string string1)))
     506                                          (start2 0) (end2 (length (string string2))))
    504507  "Given two strings (string1 and string2), and optional integers start1,
    505508  start2, end1 and end2, compares characters in string1 to characters in
    506509  string2 (using char-equal)."
    507   (eq t (string-compare string1 start1 end1 string2 start2 end2)))
    508 
     510  (%string-equal (if (typep string1 'simple-string)
     511                   string1
     512                   (multiple-value-setq (string1 start1 end1)
     513                     (string-start-end string1 start1 end1)))
     514                 start1 end1
     515                 (if (typep string2 'simple-string)
     516                   string2
     517                   (multiple-value-setq (string2 start2 end2)
     518                     (string-start-end string2 start2 end2)))
     519                 start2 end2))
     520
     521(defun %string-equal (simple-string-1 start1 end1 simple-string-2 start2 end2)
     522  (declare (type simple-string simple-string-1 simple-string-2)
     523           (type fixnum start1 end1 start2 end2)
     524           (optimize (speed 3) (safety 0) (debug 0)))
     525  (let* ((len1 (- end1 start1))
     526         (len2 (- end2 start2)))
     527    (when (/= len1 len2)
     528      (return-from %string-equal nil))
     529    (macrolet ((.char-equal (a b)
     530                 ;; not a typo. it's faster to make the char= check and, only if that fails, run the
     531                 ;; char-equal check.
     532                 `(or (char= ,a ,b) (char-equal ,a ,b)))
     533               (s1 (index)
     534                 `(uvref simple-string-1 ,index))
     535               (s2 (index)
     536                 `(uvref simple-string-2 ,index)))
     537     
     538      (do* ((index1 start1 (%i+ 1 index1))
     539            (index2 start2 (%i+ 1 index2))
     540            (char1  (s1 index1) (s1 index1))
     541            (char2  (s2 index2) (s2 index2)))
     542          ()
     543        (declare (type fixnum index1 index2)
     544                 (type character char1 char2))
     545        (when (eq index1 end1)
     546          (return-from %string-equal t))
     547        (when (not (.char-equal char1 char2))
     548          (return-from %string-equal nil))))))
    509549
    510550(defun string-lessp (string1 string2 &key start1 end1 start2 end2)
Note: See TracChangeset for help on using the changeset viewer.