Ignore:
Timestamp:
Mar 24, 2008, 1:23:30 PM (13 years ago)
Author:
mb
Message:

Record source location for condition classe with the label CONDITION (instead of CLASS)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/lib/source-files.lisp

    r8867 r8871  
    9090                           *source-files*)))))))
    9191
     92;; defined as a function in l0-source-files.lisp
     93(fmakunbound 'remove-definition-source)
     94(defgeneric remove-definition-source (definition-type name)
     95  (:method ((definition-type-name symbol) name)
     96    (remove-definition-source (definition-type-instance definition-type-name) name))
     97  (:method ((definition-type definition-type) name)
     98    (symbol-macrolet ((definitions
     99                          (gethash (definition-short-name definition-type effective-name) *source-files*)))
     100      (let ((effective-name (effective-name definition-type name)))
     101        (setf definitions (delete-if (lambda (def)
     102                                       (and (eq (first def) (definition-type-name definition-type))
     103                                            (definition-name-equal-p (second def) effective-name)))
     104                                     definitions))
     105        (when (null definitions)
     106          (remhash (definition-short-name definition-type effective-name) *source-files*))))
     107    *source-files*))
     108
    92109(defun definition-name-equal-p (a b)
    93110  "Returns T if A and B represent the same definition-name."
     
    97114               ((and (atom a) (atom b)) (eql a b))
    98115               ((and (consp a) (consp b))
    99                 (if (or (member a seen)
    100                         (member b seen))
    101                   (return-from definition-name-equal-p nil)
    102                   (prog1
    103                       (and (rec (car a) (car b))
    104                            (rec (cdr a) (cdr b)))
    105                     (push a seen)
    106                     (push b seen))))
     116                (when (or (member a seen)
     117                          (member b seen))
     118                  (return-from definition-name-equal-p nil))
     119                (push a seen)
     120                (push b seen)
     121                (and (rec (car a) (car b))
     122                     (rec (cdr a) (cdr b))))
    107123               (t nil))))
    108124      (rec a b))))
Note: See TracChangeset for help on using the changeset viewer.