Changeset 9357


Ignore:
Timestamp:
May 5, 2008, 11:19:51 AM (11 years ago)
Author:
mb
Message:

Rollback r9356

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

Legend:

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

    r9356 r9357  
    19361936        `(let* ((,code (char-code ,ch)))
    19371937          (and (eq ,code (setq ,code (char-code ,other)))
    1938                (eq ,code (char-code ,third)))))
     1938           (eq ,code (char-code ,third)))))
    19391939      call)))
    19401940
  • branches/working-0711/ccl/level-1/l1-readloop-lds.lisp

    r9356 r9357  
    100100    (dotimes (i (length r) (terpri))
    101101      (format *debug-io* "~&~d. ~a" i (svref r i)))))
     102
     103;;; From Marco Baringer 2003/03/18
    102104
    103105(define-toplevel-command :break set (n frame value) "Set <n>th item of frame <frame> to <value>"
  • branches/working-0711/ccl/lib/ccl-export-syms.lisp

    r9356 r9357  
    4141     auxilliary-names
    4242     find-definitions-for-name
    43      find-definitions-of-thing
    4443     
    4544     show-documentation
  • branches/working-0711/ccl/lib/chars.lisp

    r9356 r9357  
    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)
    455             (setq val -1))
     454          (when (neq j end2)(setq val -1))
    456455          (return))
    457456        (when (eq j end2)
    458457          (setq end1 i)
    459           (setq val 1)
    460           (return))
     458          (setq val 1)(return))
    461459        (let ((code1 (%scharcode string1 i))
    462460              (code2 (%scharcode string2 j)))
     
    503501    (if (eq result -1) nil pos)))
    504502
    505 (defun string-equal (string1 string2 &key (start1 0) (end1 (length (string string1)))
    506                                           (start2 0) (end2 (length (string string2))))
     503(defun string-equal (string1 string2 &key start1 end1 start2 end2)
    507504  "Given two strings (string1 and string2), and optional integers start1,
    508505  start2, end1 and end2, compares characters in string1 to characters in
    509506  string2 (using char-equal)."
    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     (declare (type fixnum len1 len2))
    528     (when (/= len1 len2)
    529       (return-from %string-equal nil))
    530     (do* ((index1 start1 (%i+ 1 index1))
    531           (index2 start2 (%i+ 1 index2))
    532           (char1  (uvref simple-string-1 index1) (uvref simple-string-1 index1))
    533           (char2  (uvref simple-string-2 index2) (uvref simple-string-2 index2)))
    534         ()
    535       (declare (type fixnum index1 index2)
    536                (type character char1 char2))
    537       (when (eq index1 end1)
    538         (return-from %string-equal t))
    539       (when (and (not (char= char1 char2))
    540                  (not (char-equal char1 char2)))
    541         (return-from %string-equal nil)))))
     507  (eq t (string-compare string1 start1 end1 string2 start2 end2)))
     508
    542509
    543510(defun string-lessp (string1 string2 &key start1 end1 start2 end2)
  • branches/working-0711/ccl/lib/source-files.lisp

    r9356 r9357  
    254254    (second name)))
    255255
    256 (define-definition-name-function function (cons) cons)
     256(define-definition-name-function function (cons)
     257  (validate-function-name cons)
     258  cons)
    257259
    258260(define-definition-name-function function (function)
     
    407409;;;; * Finding definitions from a name
    408410
    409 (defun find-definitions-for-name (name &optional (type-name t))
     411(defun find-definitions-for-name (name)
    410412  "Returns a list of (TYPE . DEFINITION-SOURCE) for all the known definitions of NAME."
    411413  (let ((definitions '()))
    412414    (flet ((collect-def (type name)
    413              (when (or (eql t type-name)
    414                        (eql (definition-type-name type) type-name))
    415                (let ((source (definition-source type name)))
    416                  (when source
    417                    (push (list type name source) definitions))))))
     415             (let ((source (definition-source type name)))
     416               (when source
     417                 (push (list type name source) definitions)))))
    418418      (dolist (definition-type *definition-types*)
    419         (collect-def definition-type name)
     419        (collect-def (definition-type-name definition-type) name)
    420420        (dolist (other-name (auxilliary-names definition-type name))
    421           (collect-def (definition-type-instance (first other-name)) (second other-name))))
     421          (collect-def (first other-name) (second other-name))))
    422422      (remove-duplicates definitions
    423423                         :test (lambda (a b)
    424424                                 (and (eql (first a) (first b))
    425425                                      (definition-name-equal-p (second a) (second b))))))))
    426 
    427 (defun find-definitions-of-thing (thing)
    428   (let ((definitions '()))
    429     (labels ((def-eql (a b)
    430                (and (eql (first a) (first b))
    431                     (definition-name-equal-p (second a) (second b))))
    432              (collect-def (type name)
    433                (setf definitions
    434                      (remove-duplicates (append definitions
    435                                                 (find-definitions-for-name name type))
    436                                         :test #'def-eql))))
    437 
    438       (typecase thing
    439         (function  (collect-def 'function (function-name thing)))
    440         (class     (collect-def 'class (class-name thing)))
    441         (method    (collect-def 'method thing))
    442         (symbol    (collect-def 't thing))))
    443 
    444     definitions))
    445426
    446427;;;; * backwards compatability. find-definitions-for-name or definition-source is the preferred way
Note: See TracChangeset for help on using the changeset viewer.