/[slime]/slime/swank-ccl.lisp
ViewVC logotype

Diff of /slime/swank-ccl.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.29 by sboukarev, Mon Dec 3 03:43:16 2012 UTC revision 1.32 by sboukarev, Sat Feb 2 10:11:16 2013 UTC
# Line 180  Line 180 
180    (with-output-to-string (stream)    (with-output-to-string (stream)
181      (ccl:report-compiler-warning c stream :short t)))      (ccl:report-compiler-warning c stream :short t)))
182    
183    ;; Needed because `ccl:report-compiler-warning' would return
184    ;; "Nonspecific warning".
185    (defmethod compiler-warning-short-message ((c ccl::shadowed-typecase-clause))
186      (princ-to-string c))
187    
188  (defimplementation call-with-compilation-hooks (function)  (defimplementation call-with-compilation-hooks (function)
189    (handler-bind ((ccl:compiler-warning 'handle-compiler-warning))    (handler-bind ((ccl:compiler-warning 'handle-compiler-warning))
190      (let ((ccl:*merge-compiler-warnings* nil))      (let ((ccl:*merge-compiler-warnings* nil))
# Line 407  Line 412 
412          (pc-source-location lfun pc)          (pc-source-location lfun pc)
413          (function-source-location lfun)))))          (function-source-location lfun)))))
414    
415    (defun function-name-package (name)
416      (etypecase name
417        (null nil)
418        (symbol (symbol-package name))
419        ((cons (eql setf) symbol) (symbol-package (cadr name)))
420        ((cons (eql :internal)) (function-name-package (car (last name))))
421        ((cons (and symbol (not keyword)) (cons list null))
422         (symbol-package (car name)))
423        (standard-method (function-name-package (ccl:method-name name)))))
424    
425    (defimplementation frame-package (frame-number)
426      (with-frame (p context) frame-number
427        (let* ((lfun (ccl:frame-function p context))
428               (name (ccl:function-name lfun)))
429          (function-name-package name))))
430    
431  (defimplementation eval-in-frame (form index)  (defimplementation eval-in-frame (form index)
432    (with-frame (p context) index    (with-frame (p context) index
433      (let ((vars (ccl:frame-named-variables p context)))      (let ((vars (ccl:frame-named-variables p context)))
# Line 673  Line 694 
694      (loop for i below (ccl:uvsize object) append      (loop for i below (ccl:uvsize object) append
695            (label-value-line (princ-to-string i) (ccl:uvref object i)))))            (label-value-line (princ-to-string i) (ccl:uvref object i)))))
696    
697    (defimplementation type-specifier-p (symbol)
698      (or (ccl:type-specifier-p symbol)
699          (not (eq (type-specifier-arglist symbol) :not-available))))
700    
701  ;;; Multiprocessing  ;;; Multiprocessing
702    
703  (defvar *known-processes*  (defvar *known-processes*

Legend:
Removed from v.1.29  
changed lines
  Added in v.1.32

  ViewVC Help
Powered by ViewVC 1.1.5