Changeset 9358


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

Add find-definition-of-thing.

This funtion will attempt to return the source-note which defines the object. Only works for function, class and method
objects.

Committing again without changes to string-equal.

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

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/lib/ccl-export-syms.lisp

    r9357 r9358  
    4141     auxilliary-names
    4242     find-definitions-for-name
     43     find-definitions-of-thing
    4344     
    4445     show-documentation
  • branches/working-0711/ccl/lib/source-files.lisp

    r9357 r9358  
    254254    (second name)))
    255255
    256 (define-definition-name-function function (cons)
    257   (validate-function-name cons)
    258   cons)
     256(define-definition-name-function function (cons) cons)
    259257
    260258(define-definition-name-function function (function)
     
    409407;;;; * Finding definitions from a name
    410408
    411 (defun find-definitions-for-name (name)
     409(defun find-definitions-for-name (name &optional (type-name t))
    412410  "Returns a list of (TYPE . DEFINITION-SOURCE) for all the known definitions of NAME."
    413411  (let ((definitions '()))
    414412    (flet ((collect-def (type name)
    415              (let ((source (definition-source type name)))
    416                (when source
    417                  (push (list type name source) definitions)))))
     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))))))
    418418      (dolist (definition-type *definition-types*)
    419         (collect-def (definition-type-name definition-type) name)
     419        (collect-def definition-type name)
    420420        (dolist (other-name (auxilliary-names definition-type name))
    421           (collect-def (first other-name) (second other-name))))
     421          (collect-def (definition-type-instance (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))
    426445
    427446;;;; * backwards compatability. find-definitions-for-name or definition-source is the preferred way
Note: See TracChangeset for help on using the changeset viewer.