← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/slime/intrepid

« back to all changes in this revision

Viewing changes to swank-openmcl.lisp

  • Committer: Bazaar Package Importer
  • Author(s): Peter Van Eynde
  • Date: 2007-05-04 22:18:29 UTC
  • mfrom: (1.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070504221829-lhtgdzbpcaaiwii9
Tags: 1:20070409-1
Fixed XS-Vcs-Bzr item in control file 

Show diffs side-by-side

added added

removed removed

Lines of Context:
swank-openmcl.lisp
105
105
   openmcl-mop:slot-definition-type
106
106
   openmcl-mop:slot-definition-readers
107
107
   openmcl-mop:slot-definition-writers
108
 
   openmcl-mop:slot-boundp-using-class))
 
108
   openmcl-mop:slot-boundp-using-class
 
109
   openmcl-mop:slot-makunbound-using-class))
109
110
 
110
111
(defun specializer-name (spec)
111
112
  (etypecase spec
320
321
               )))))))
321
322
 
322
323
(defun xref-locations (relation name &optional (inverse nil))
323
 
  (loop for xref in (if inverse 
324
 
                        (ccl::get-relation  relation name :wild :exhaustive t)
325
 
                        (ccl::get-relation  relation :wild name :exhaustive t))
326
 
        for function = (ccl::xref-entry-name xref)
327
 
        collect `((function ,function) ,(function-source-location (ccl::xref-entry-name xref)))))
 
324
  (flet ((function-source-location (entry)
 
325
           (multiple-value-bind (info name)
 
326
               (ccl::edit-definition-p
 
327
                (ccl::%db-key-from-xref-entry entry)
 
328
                (if (eql (ccl::xref-entry-type entry)
 
329
                         'macro)
 
330
                    'function
 
331
                    (ccl::xref-entry-type entry)))
 
332
             (cond ((not info)
 
333
                    (list :error
 
334
                          (format nil "No source info available for ~A"
 
335
                                  (ccl::xref-entry-name entry))))
 
336
                   ((typep (caar info) 'ccl::method)
 
337
                    `(:location 
 
338
                      (:file ,(remove-filename-quoting
 
339
                               (namestring (translate-logical-pathname
 
340
                                            (cdr (car info))))))
 
341
                      (:method
 
342
                          ,(princ-to-string (ccl::method-name (caar info)))
 
343
                        ,(mapcar 'princ-to-string
 
344
                                 (mapcar #'specializer-name
 
345
                                         (ccl::method-specializers
 
346
                                          (caar info))))
 
347
                        ,@(mapcar 'princ-to-string
 
348
                                  (ccl::method-qualifiers (caar info))))
 
349
                      nil))
 
350
                   (t
 
351
                    (canonicalize-location (cdr (first info)) name))))))
 
352
    (declare (dynamic-extent #'function-source-location))
 
353
    (loop for xref in (if inverse 
 
354
                          (ccl::get-relation relation name
 
355
                                             :wild :exhaustive t)
 
356
                          (ccl::get-relation relation
 
357
                                             :wild name :exhaustive t))
 
358
       for function = (ccl::xref-entry-name xref)
 
359
       collect `((function ,function)
 
360
                 ,(function-source-location xref)))))
328
361
 
329
362
(defimplementation who-binds (name)
330
363
  (xref-locations :binds name))
930
963
(defimplementation make-weak-value-hash-table (&rest args)
931
964
  (apply #'make-hash-table :weak :value args))
932
965
 
 
966
(defimplementation hash-table-weakness (hashtable)
 
967
  (ccl::hash-table-weak-p hashtable))