Changeset 9363


Ignore:
Timestamp:
May 5, 2008, 9:31:32 PM (11 years ago)
Author:
gz
Message:

More string-equal tweaks

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

Legend:

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

    r9361 r9363  
    18711871        (= ,gtype ,(nx-lookup-target-uvector-subtag :simple-string))))))
    18721872
    1873 (define-compiler-macro string-equal (&whole call
    1874                                      string1 string2
    1875                                      &rest keys)
     1873(define-compiler-macro string-equal (&whole call string1 string2
     1874                                            &environment env
     1875                                            &rest keys)
    18761876  (if (null keys)
    1877     (once-only ((string1 string1)
    1878                 (string2 string2)
    1879                 (s1 0)
    1880                 (e1 `(length ,string1))
    1881                 (s2 0)
    1882                 (e2 `(length ,string2)))
    1883       `(when (eql ,e1 ,e2)
    1884          (if (not (typep ,string1 'simple-string))
    1885            (multiple-value-setq (,string1 ,s1 ,e1)
    1886              (string-start-end (string ,string1) ,s1 ,e1)))
    1887          (if (not (typep ,string2 'simple-string))
    1888            (multiple-value-setq (,string2 ,s2 ,e2)
    1889              (string-start-end (string ,string2) ,s2 ,e2)))
    1890          (%string-equal ,string1 ,s1 ,e1
    1891                         ,string2 ,s2 ,e2)))
     1877    (if (and (nx-form-typep string1 'simple-string env)
     1878             (nx-form-typep string2 'simple-string env))
     1879      (once-only ((string1 string1)
     1880                  (string2 string2)
     1881                  (len1 `(length ,string1))
     1882                  (len2 `(length ,string2)))
     1883        `(and (eq ,len1 ,len2)
     1884              (%string-equal ,string1 0 ,len1 ,string2 0 ,len2)))
     1885      `(string-equal-no-keys ,string1 ,string2))
    18921886    call))
    18931887
  • branches/working-0711/ccl/lib/chars.lisp

    r9359 r9363  
    503503    (if (eq result -1) nil pos)))
    504504
    505 (defun string-equal (string1 string2 &key (start1 0) (end1 (length (string string1)))
    506                                           (start2 0) (end2 (length (string string2))))
     505(defun string-equal (string1 string2 &key start1 end1 start2 end2)
    507506  "Given two strings (string1 and string2), and optional integers start1,
    508507  start2, end1 and end2, compares characters in string1 to characters in
    509508  string2 (using char-equal)."
    510   (%string-equal (if (typep string1 'simple-string)
    511                    string1
     509  (%string-equal (if (and (typep string1 'simple-string) (null start1) (null end1))
     510                   (progn
     511                     (setq start1 0 end1 (length string1))
     512                     string1)
    512513                   (multiple-value-setq (string1 start1 end1)
    513514                     (string-start-end string1 start1 end1)))
    514515                 start1 end1
    515                  (if (typep string2 'simple-string)
    516                    string2
     516                 (if (and (typep string2 'simple-string) (null start2) (null end2))
     517                   (progn
     518                     (setq start2 0 end2 (length string2))
     519                     string2)
    517520                   (multiple-value-setq (string2 start2 end2)
    518521                     (string-start-end string2 start2 end2)))
    519522                 start2 end2))
     523
     524;; For use by optimizer
     525(defun string-equal-no-keys (string1 string2 &aux start1 end1  start2 end2)
     526  (if (typep string1 'simple-string)
     527    (setq start1 0 end1 (length string1))
     528    (multiple-value-setq (string1 start1 end1)
     529      (string-start-end string1 start1 end1)))
     530  (if (typep string2 'simple-string)
     531    (setq start2 0 end2 (length string2))
     532    (multiple-value-setq (string2 start2 end2)
     533      (string-start-end string2 start2 end2)))
     534  (and (eq (%i- end1 start1) (%i- end2 start2))
     535       (%string-equal string1 start1 end1 string2 start2 end2)))
    520536
    521537(defun %string-equal (simple-string-1 start1 end1 simple-string-2 start2 end2)
     
    525541  (let* ((len1 (- end1 start1))
    526542         (len2 (- end2 start2)))
     543    (declare (type fixnum len1 len2))
    527544    (when (/= len1 len2)
    528545      (return-from %string-equal nil))
Note: See TracChangeset for help on using the changeset viewer.