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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.87 - (show annotations)
Sun Aug 28 14:47:11 2005 UTC (8 years, 7 months ago) by mkoeppe
Branch: MAIN
Changes since 1.86: +11 -0 lines
(make-weak-key-hash-table)
(make-weak-value-hash-table): New interfaces.
1 ;;; -*- Mode: lisp; indent-tabs-mode: nil; outline-regexp: ";;;;;*" -*-
2 ;;;
3 ;;; slime-backend.lisp --- SLIME backend interface.
4 ;;;
5 ;;; Created by James Bielman in 2003. Released into the public domain.
6 ;;;
7 ;;;; Frontmatter
8 ;;;
9 ;;; This file defines the functions that must be implemented
10 ;;; separately for each Lisp. Each is declared as a generic function
11 ;;; for which swank-<implementation>.lisp provides methods.
12
13 (defpackage :swank-backend
14 (:use :common-lisp)
15 (:export #:sldb-condition
16 #:original-condition
17 #:compiler-condition
18 #:message
19 #:short-message
20 #:condition
21 #:severity
22 #:location
23 #:location-p
24 #:location-buffer
25 #:location-position
26 #:position-p
27 #:position-pos
28 #:print-output-to-string
29 #:quit-lisp
30 #:references
31 #:unbound-slot-filler
32 ;; inspector related symbols
33 #:inspector
34 #:inspect-for-emacs
35 #:raw-inspection
36 #:fancy-inspection
37 #:label-value-line
38 #:label-value-line*
39 ))
40
41 (defpackage :swank-mop
42 (:use)
43 (:export
44 ;; classes
45 #:standard-generic-function
46 #:standard-slot-definition
47 #:standard-method
48 #:standard-class
49 #:eql-specializer
50 #:eql-specializer-object
51 ;; standard-class readers
52 #:class-default-initargs
53 #:class-direct-default-initargs
54 #:class-direct-slots
55 #:class-direct-subclasses
56 #:class-direct-superclasses
57 #:class-finalized-p
58 #:class-name
59 #:class-precedence-list
60 #:class-prototype
61 #:class-slots
62 #:specializer-direct-methods
63 ;; generic function readers
64 #:generic-function-argument-precedence-order
65 #:generic-function-declarations
66 #:generic-function-lambda-list
67 #:generic-function-methods
68 #:generic-function-method-class
69 #:generic-function-method-combination
70 #:generic-function-name
71 ;; method readers
72 #:method-generic-function
73 #:method-function
74 #:method-lambda-list
75 #:method-specializers
76 #:method-qualifiers
77 ;; slot readers
78 #:slot-definition-allocation
79 #:slot-definition-documentation
80 #:slot-definition-initargs
81 #:slot-definition-initform
82 #:slot-definition-initfunction
83 #:slot-definition-name
84 #:slot-definition-type
85 #:slot-definition-readers
86 #:slot-definition-writers
87 ;; generic function protocol
88 #:compute-applicable-methods-using-classes
89 #:finalize-inheritance))
90
91 (in-package :swank-backend)
92
93
94 ;;;; Metacode
95
96 (defparameter *interface-functions* '()
97 "The names of all interface functions.")
98
99 (defparameter *unimplemented-interfaces* '()
100 "List of interface functions that are not implemented.
101 DEFINTERFACE adds to this list and DEFIMPLEMENTATION removes.")
102
103 (defmacro definterface (name args documentation &rest default-body)
104 "Define an interface function for the backend to implement.
105 A generic function is defined with NAME, ARGS, and DOCUMENTATION.
106
107 If a DEFAULT-BODY is supplied then NO-APPLICABLE-METHOD is specialized
108 to execute the body if the backend doesn't provide a specific
109 implementation.
110
111 Backends implement these functions using DEFIMPLEMENTATION."
112 (check-type documentation string "a documentation string")
113 (flet ((gen-default-impl ()
114 `(defmethod ,name ,args ,@default-body)))
115 `(progn (defgeneric ,name ,args (:documentation ,documentation))
116 (pushnew ',name *interface-functions*)
117 ,(if (null default-body)
118 `(pushnew ',name *unimplemented-interfaces*)
119 (gen-default-impl))
120 ;; see <http://www.franz.com/support/documentation/6.2/doc/pages/variables/compiler/s_cltl1-compile-file-toplevel-compatibility-p_s.htm>
121 (eval-when (:compile-toplevel :load-toplevel :execute)
122 (export ',name :swank-backend))
123 ',name)))
124
125 (defmacro defimplementation (name args &body body)
126 `(progn (defmethod ,name ,args ,@body)
127 (if (member ',name *interface-functions*)
128 (setq *unimplemented-interfaces*
129 (remove ',name *unimplemented-interfaces*))
130 (warn "DEFIMPLEMENTATION of undefined interface (~S)" ',name))
131 ',name))
132
133 (defun warn-unimplemented-interfaces ()
134 "Warn the user about unimplemented backend features.
135 The portable code calls this function at startup."
136 (warn "These Swank interfaces are unimplemented:~% ~A"
137 (sort (copy-list *unimplemented-interfaces*) #'string<)))
138
139 (defun import-to-swank-mop (symbol-list)
140 (dolist (sym symbol-list)
141 (let* ((swank-mop-sym (find-symbol (symbol-name sym) :swank-mop)))
142 (when swank-mop-sym
143 (unintern swank-mop-sym :swank-mop))
144 (import sym :swank-mop)
145 (export sym :swank-mop))))
146
147 (defun import-swank-mop-symbols (package except)
148 "Import the mop symbols from PACKAGE to SWANK-MOP.
149 EXCEPT is a list of symbol names which should be ignored."
150 (do-symbols (s :swank-mop)
151 (unless (member s except :test #'string=)
152 (let ((real-symbol (find-symbol (string s) package)))
153 (assert real-symbol () "Symbol ~A not found in package ~A" s package)
154 (unintern s :swank-mop)
155 (import real-symbol :swank-mop)
156 (export real-symbol :swank-mop)))))
157
158
159 ;;;; Utilities
160
161 (defmacro with-struct ((conc-name &rest names) obj &body body)
162 "Like with-slots but works only for structs."
163 (flet ((reader (slot) (intern (concatenate 'string
164 (symbol-name conc-name)
165 (symbol-name slot))
166 (symbol-package conc-name))))
167 (let ((tmp (gensym "OO-")))
168 ` (let ((,tmp ,obj))
169 (symbol-macrolet
170 ,(loop for name in names collect
171 (typecase name
172 (symbol `(,name (,(reader name) ,tmp)))
173 (cons `(,(first name) (,(reader (second name)) ,tmp)))
174 (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))
175 ,@body)))))
176
177
178 ;;;; TCP server
179
180 (definterface create-socket (host port)
181 "Create a listening TCP socket on interface HOST and port PORT .")
182
183 (definterface local-port (socket)
184 "Return the local port number of SOCKET.")
185
186 (definterface close-socket (socket)
187 "Close the socket SOCKET.")
188
189 (definterface accept-connection (socket &key external-format)
190 "Accept a client connection on the listening socket SOCKET. Return
191 a stream for the new connection.")
192
193 (definterface add-sigio-handler (socket fn)
194 "Call FN whenever SOCKET is readable.")
195
196 (definterface remove-sigio-handlers (socket)
197 "Remove all sigio handlers for SOCKET.")
198
199 (definterface add-fd-handler (socket fn)
200 "Call FN when Lisp is waiting for input and SOCKET is readable.")
201
202 (definterface remove-fd-handlers (socket)
203 "Remove all fd-handlers for SOCKET.")
204
205 (definterface preferred-communication-style ()
206 "Return one of the symbols :spawn, :sigio, :fd-handler, or NIL."
207 nil)
208
209 ;;; Base condition for networking errors.
210 (define-condition network-error (simple-error) ())
211
212 (definterface emacs-connected ()
213 "Hook called when the first connection from Emacs is established.
214 Called from the INIT-FN of the socket server that accepts the
215 connection.
216
217 This is intended for setting up extra context, e.g. to discover
218 that the calling thread is the one that interacts with Emacs."
219 nil)
220
221
222 ;;;; Unix signals
223
224 (defconstant +sigint+ 2)
225
226 (definterface call-without-interrupts (fn)
227 "Call FN in a context where interrupts are disabled."
228 (funcall fn))
229
230 (definterface getpid ()
231 "Return the (Unix) process ID of this superior Lisp.")
232
233 (definterface lisp-implementation-type-name ()
234 "Return a short name for the Lisp implementation."
235 (lisp-implementation-type))
236
237 (definterface default-directory ()
238 "Return the default directory."
239 (directory-namestring (truename *default-pathname-defaults*)))
240
241 (definterface set-default-directory (directory)
242 "Set the default directory.
243 This is used to resolve filenames without directory component."
244 (setf *default-pathname-defaults* (truename (merge-pathnames directory)))
245 (default-directory))
246
247 (definterface call-with-syntax-hooks (fn)
248 "Call FN with hooks to handle special syntax."
249 (funcall fn))
250
251 (definterface default-readtable-alist ()
252 "Return a suitable initial value for SWANK:*READTABLE-ALIST*."
253 '())
254
255 (definterface quit-lisp ()
256 "Exit the current lisp image.")
257
258
259 ;;;; Compilation
260
261 (definterface call-with-compilation-hooks (func)
262 "Call FUNC with hooks to record compiler conditions.")
263
264 (defmacro with-compilation-hooks ((&rest ignore) &body body)
265 "Execute BODY as in CALL-WITH-COMPILATION-HOOKS."
266 (declare (ignore ignore))
267 `(call-with-compilation-hooks (lambda () (progn ,@body))))
268
269 (definterface swank-compile-string (string &key buffer position directory)
270 "Compile source from STRING. During compilation, compiler
271 conditions must be trapped and resignalled as COMPILER-CONDITIONs.
272
273 If supplied, BUFFER and POSITION specify the source location in Emacs.
274
275 Additionally, if POSITION is supplied, it must be added to source
276 positions reported in compiler conditions.
277
278 If DIRECTORY is specified it may be used by certain implementations to
279 rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
280 source information.")
281
282 (definterface operate-on-system (system-name operation-name &rest keyword-args)
283 "Perform OPERATION-NAME on SYSTEM-NAME using ASDF.
284 The KEYWORD-ARGS are passed on to the operation.
285 Example:
286 \(operate-on-system \"SWANK\" \"COMPILE-OP\" :force t)"
287 (unless (member :asdf *features*)
288 (error "ASDF is not loaded."))
289 (with-compilation-hooks ()
290 (let ((operate (find-symbol "OPERATE" :asdf))
291 (operation (find-symbol operation-name :asdf)))
292 (when (null operation)
293 (error "Couldn't find ASDF operation ~S" operation-name))
294 (apply operate operation system-name keyword-args))))
295
296 (definterface swank-compile-file (filename load-p &optional external-format)
297 "Compile FILENAME signalling COMPILE-CONDITIONs.
298 If LOAD-P is true, load the file after compilation.")
299
300 (deftype severity ()
301 '(member :error :read-error :warning :style-warning :note))
302
303 ;; Base condition type for compiler errors, warnings and notes.
304 (define-condition compiler-condition (condition)
305 ((original-condition
306 ;; The original condition thrown by the compiler if appropriate.
307 ;; May be NIL if a compiler does not report using conditions.
308 :type (or null condition)
309 :initarg :original-condition
310 :accessor original-condition)
311
312 (severity :type severity
313 :initarg :severity
314 :accessor severity)
315
316 (message :initarg :message
317 :accessor message)
318
319 (short-message :initarg :short-message
320 :initform nil
321 :accessor short-message)
322
323 (references :initarg :references
324 :initform nil
325 :accessor references)
326
327 (location :initarg :location
328 :accessor location)))
329
330
331 ;;;; Streams
332
333 (definterface make-fn-streams (input-fn output-fn)
334 "Return character input and output streams backended by functions.
335 When input is needed, INPUT-FN is called with no arguments to
336 return a string.
337 When output is ready, OUTPUT-FN is called with the output as its
338 argument.
339
340 Output should be forced to OUTPUT-FN before calling INPUT-FN.
341
342 The streams are returned as two values.")
343
344 (definterface make-stream-interactive (stream)
345 "Do any necessary setup to make STREAM work interactively.
346 This is called for each stream used for interaction with the user
347 \(e.g. *standard-output*). An implementation could setup some
348 implementation-specific functions to control output flushing at the
349 like."
350 (declare (ignore stream))
351 nil)
352
353
354 ;;;; Documentation
355
356 (definterface arglist (name)
357 "Return the lambda list for the symbol NAME. NAME can also be
358 a lisp function object, on lisps which support this.
359
360 The result can be a list or the :not-available if the arglist
361 cannot be determined."
362 (declare (ignore name))
363 :not-available)
364
365 (definterface function-name (function)
366 "Return the name of the function object FUNCTION.
367
368 The result is either a symbol, a list, or NIL if no function name is available."
369 (declare (ignore function))
370 nil)
371
372 (definterface macroexpand-all (form)
373 "Recursively expand all macros in FORM.
374 Return the resulting form.")
375
376 (definterface describe-symbol-for-emacs (symbol)
377 "Return a property list describing SYMBOL.
378
379 The property list has an entry for each interesting aspect of the
380 symbol. The recognised keys are:
381
382 :VARIABLE :FUNCTION :SETF :SPECIAL-OPERATOR :MACRO :COMPILER-MACRO
383 :TYPE :CLASS :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
384
385 The value of each property is the corresponding documentation string,
386 or :NOT-DOCUMENTED. It is legal to include keys not listed here (but
387 slime-print-apropos in Emacs must know about them).
388
389 Properties should be included if and only if they are applicable to
390 the symbol. For example, only (and all) fbound symbols should include
391 the :FUNCTION property.
392
393 Example:
394 \(describe-symbol-for-emacs 'vector)
395 => (:CLASS :NOT-DOCUMENTED
396 :TYPE :NOT-DOCUMENTED
397 :FUNCTION \"Constructs a simple-vector from the given objects.\")")
398
399 (definterface describe-definition (name type)
400 "Describe the definition NAME of TYPE.
401 TYPE can be any value returned by DESCRIBE-SYMBOL-FOR-EMACS.
402
403 Return a documentation string, or NIL if none is available.")
404
405
406 ;;;; Debugging
407
408 (definterface call-with-debugging-environment (debugger-loop-fn)
409 "Call DEBUGGER-LOOP-FN in a suitable debugging environment.
410
411 This function is called recursively at each debug level to invoke the
412 debugger loop. The purpose is to setup any necessary environment for
413 other debugger callbacks that will be called within the debugger loop.
414
415 For example, this is a reasonable place to compute a backtrace, switch
416 to safe reader/printer settings, and so on.")
417
418 (definterface call-with-debugger-hook (hook fun)
419 "Call FUN and use HOOK as debugger hook.
420
421 HOOK should be called for both BREAK and INVOKE-DEBUGGER."
422 (let ((*debugger-hook* hook))
423 (funcall fun)))
424
425 (define-condition sldb-condition (condition)
426 ((original-condition
427 :initarg :original-condition
428 :accessor original-condition))
429 (:report (lambda (condition stream)
430 (format stream "Condition in debugger code~@[: ~A~]"
431 (original-condition condition))))
432 (:documentation
433 "Wrapper for conditions that should not be debugged.
434
435 When a condition arises from the internals of the debugger, it is not
436 desirable to debug it -- we'd risk entering an endless loop trying to
437 debug the debugger! Instead, such conditions can be reported to the
438 user without (re)entering the debugger by wrapping them as
439 `sldb-condition's."))
440
441 (definterface compute-backtrace (start end)
442 "Return a list containing a backtrace of the condition current
443 being debugged. The results are unspecified if this function is
444 called outside the dynamic contour CALL-WITH-DEBUGGING-ENVIRONMENT.
445
446 START and END are zero-based indices constraining the number of frames
447 returned. Frame zero is defined as the frame which invoked the
448 debugger. If END is nil, return the frames from START to the end of
449 the stack.")
450
451 (definterface print-frame (frame stream)
452 "Print frame to stream.")
453
454 (definterface frame-source-location-for-emacs (frame-number)
455 "Return the source location for FRAME-NUMBER.")
456
457 (definterface frame-catch-tags (frame-number)
458 "Return a list of XXX list of what? catch tags for a debugger
459 stack frame. The results are undefined unless this is called
460 within the dynamic contour of a function defined by
461 DEFINE-DEBUGGER-HOOK.")
462
463 (definterface frame-locals (frame-number)
464 "Return a list of XXX local variable designators define me
465 for a debugger stack frame. The results are undefined unless
466 this is called within the dynamic contour of a function defined
467 by DEFINE-DEBUGGER-HOOK.")
468
469 (definterface frame-var-value (frame var)
470 "Return the value of VAR in FRAME.
471 FRAME is the number of the frame in the backtrace.
472 VAR is the number of the variable in the frame.")
473
474 (definterface disassemble-frame (frame-number)
475 "Disassemble the code for the FRAME-NUMBER.
476 The output should be written to standard output.
477 FRAME-NUMBER is a non-negative integer.")
478
479 (definterface eval-in-frame (form frame-number)
480 "Evaluate a Lisp form in the lexical context of a stack frame
481 in the debugger. The results are undefined unless called in the
482 dynamic contour of a function defined by DEFINE-DEBUGGER-HOOK.
483
484 FRAME-NUMBER must be a positive integer with 0 indicating the
485 frame which invoked the debugger.
486
487 The return value is the result of evaulating FORM in the
488 appropriate context.")
489
490 (definterface return-from-frame (frame-number form)
491 "Unwind the stack to the frame FRAME-NUMBER and return the value(s)
492 produced by evaluating FORM in the frame context to its caller.
493
494 Execute any clean-up code from unwind-protect forms above the frame
495 during unwinding.
496
497 Return a string describing the error if it's not possible to return
498 from the frame.")
499
500 (definterface restart-frame (frame-number)
501 "Restart execution of the frame FRAME-NUMBER with the same arguments
502 as it was called originally.")
503
504 (definterface format-sldb-condition (condition)
505 "Format a condition for display in SLDB."
506 (princ-to-string condition))
507
508 (definterface condition-references (condition)
509 "Return a list of documentation references for a condition.
510 Each reference is one of:
511 (:ANSI-CL
512 {:FUNCTION | :SPECIAL-OPERATOR | :MACRO | :SECTION | :GLOSSARY }
513 symbol-or-name)
514 (:SBCL :NODE node-name)"
515 (declare (ignore condition))
516 '())
517
518 (definterface condition-extras (condition)
519 "Return a list of extra for the debugger.
520 The allowed elements are of the form:
521 (:SHOW-FRAME-SOURCE frame-number)"
522 (declare (ignore condition))
523 '())
524
525 (definterface activate-stepping (frame-number)
526 "Prepare the frame FRAME-NUMBER for stepping.")
527
528 (definterface sldb-break-on-return (frame-number)
529 "Set a breakpoint in the frame FRAME-NUMBER.")
530
531 (definterface sldb-break-at-start (symbol)
532 "Set a breakpoint on the beginning of the function for SYMBOL.")
533
534
535
536 ;;;; Definition finding
537
538 (defstruct (:location (:type list) :named
539 (:constructor make-location
540 (buffer position &optional hints)))
541 buffer position
542 ;; Hints is a property list optionally containing:
543 ;; :snippet SOURCE-TEXT
544 ;; This is a snippet of the actual source text at the start of
545 ;; the definition, which could be used in a text search.
546 hints)
547
548 (defstruct (:error (:type list) :named (:constructor)) message)
549 (defstruct (:file (:type list) :named (:constructor)) name)
550 (defstruct (:buffer (:type list) :named (:constructor)) name)
551 (defstruct (:position (:type list) :named (:constructor)) pos)
552
553 (definterface find-definitions (name)
554 "Return a list ((DSPEC LOCATION) ...) for NAME's definitions.
555
556 NAME is a \"definition specifier\".
557
558 DSPEC is a \"definition specifier\" describing the
559 definition, e.g., FOO or (METHOD FOO (STRING NUMBER)) or
560 \(DEFVAR FOO).
561
562 LOCATION is the source location for the definition.")
563
564 (definterface buffer-first-change (filename)
565 "Called for effect the first time FILENAME's buffer is modified."
566 (declare (ignore filename))
567 nil)
568
569
570 ;;;; XREF
571
572 (definterface who-calls (function-name)
573 "Return the call sites of FUNCTION-NAME (a symbol).
574 The results is a list ((DSPEC LOCATION) ...).")
575
576 (definterface calls-who (function-name)
577 "Return the call sites of FUNCTION-NAME (a symbol).
578 The results is a list ((DSPEC LOCATION) ...).")
579
580 (definterface who-references (variable-name)
581 "Return the locations where VARIABLE-NAME (a symbol) is referenced.
582 See WHO-CALLS for a description of the return value.")
583
584 (definterface who-binds (variable-name)
585 "Return the locations where VARIABLE-NAME (a symbol) is bound.
586 See WHO-CALLS for a description of the return value.")
587
588 (definterface who-sets (variable-name)
589 "Return the locations where VARIABLE-NAME (a symbol) is set.
590 See WHO-CALLS for a description of the return value.")
591
592 (definterface who-macroexpands (macro-name)
593 "Return the locations where MACRO-NAME (a symbol) is expanded.
594 See WHO-CALLS for a description of the return value.")
595
596 (definterface who-specializes (class-name)
597 "Return the locations where CLASS-NAME (a symbol) is specialized.
598 See WHO-CALLS for a description of the return value.")
599
600 ;;; Simpler variants.
601
602 (definterface list-callers (function-name)
603 "List the callers of FUNCTION-NAME.
604 This function is like WHO-CALLS except that it is expected to use
605 lower-level means. Whereas WHO-CALLS is usually implemented with
606 special compiler support, LIST-CALLERS is usually implemented by
607 groveling for constants in function objects throughout the heap.
608
609 The return value is as for WHO-CALLS.")
610
611 (definterface list-callees (function-name)
612 "List the functions called by FUNCTION-NAME.
613 See LIST-CALLERS for a description of the return value.")
614
615
616 ;;;; Profiling
617
618 ;;; The following functions define a minimal profiling interface.
619
620 (definterface profile (fname)
621 "Marks symbol FNAME for profiling.")
622
623 (definterface profiled-functions ()
624 "Returns a list of profiled functions.")
625
626 (definterface unprofile (fname)
627 "Marks symbol FNAME as not profiled.")
628
629 (definterface unprofile-all ()
630 "Marks all currently profiled functions as not profiled."
631 (dolist (f (profiled-functions))
632 (unprofile f)))
633
634 (definterface profile-report ()
635 "Prints profile report.")
636
637 (definterface profile-reset ()
638 "Resets profile counters.")
639
640 (definterface profile-package (package callers-p methods)
641 "Wrap profiling code around all functions in PACKAGE. If a function
642 is already profiled, then unprofile and reprofile (useful to notice
643 function redefinition.)
644
645 If CALLERS-P is T names have counts of the most common calling
646 functions recorded.
647
648 When called with arguments :METHODS T, profile all methods of all
649 generic functions having names in the given package. Generic functions
650 themselves, that is, their dispatch functions, are left alone.")
651
652
653 ;;;; Inspector
654
655 (defclass inspector ()
656 ()
657 (:documentation "Super class of inspector objects.
658
659 Implementations should sub class in order to dispatch off of the
660 inspect-for-emacs method."))
661
662 (definterface make-default-inspector ()
663 "Return an inspector object suitable for passing to inspect-for-emacs.")
664
665 (definterface inspect-for-emacs (object inspector)
666 "Explain to Emacs how to inspect OBJECT.
667
668 The argument INSPECTOR is an object representing how to get at
669 the internals of OBJECT, it is usually an implementation specific
670 class used simply for dispatching to the proper method.
671
672 The orgument INSPECTION-MODE is an object specifying how, and
673 what, to show to the user.
674
675 Returns two values: a string which will be used as the title of
676 the inspector buffer and a list specifying how to render the
677 object for inspection.
678
679 Every element of the list must be either a string, which will be
680 inserted into the buffer as is, or a list of the form:
681
682 (:value object &optional format) - Render an inspectable
683 object. If format is provided it must be a string and will be
684 rendered in place of the value, otherwise use princ-to-string.
685
686 (:newline) - Render a \\n
687
688 (:action label lambda) - Render LABEL (a text string) which when
689 clicked will call LAMBDA.
690
691 NIL - do nothing.")
692
693 (defmethod inspect-for-emacs ((object t) (inspector t))
694 "Generic method for inspecting any kind of object.
695
696 Since we don't know how to deal with OBJECT we simply dump the
697 output of CL:DESCRIBE."
698 (declare (ignore inspector))
699 (values
700 "A value."
701 `("Type: " (:value ,(type-of object)) (:newline)
702 "Don't know how to inspect the object, dumping output of CL:DESCRIBE:"
703 (:newline) (:newline)
704 ,(with-output-to-string (desc) (describe object desc)))))
705
706 ;;; Utilities for inspector methods.
707 ;;;
708 (defun label-value-line (label value)
709 "Create a control list which prints \"LABEL: VALUE\" in the inspector."
710 (list (princ-to-string label) ": " `(:value ,value) '(:newline)))
711
712 (defmacro label-value-line* (&rest label-values)
713 ` (append ,@(loop for (label value) in label-values
714 collect `(label-value-line ,label ,value))))
715
716 (definterface describe-primitive-type (object)
717 "Return a string describing the primitive type of object."
718 (declare (ignore object))
719 "N/A")
720
721
722 ;;;; Multithreading
723 ;;;
724 ;;; The default implementations are sufficient for non-multiprocessing
725 ;;; implementations.
726
727 (definterface startup-multiprocessing ()
728 "Initialize multiprocessing, if necessary.
729
730 This function is called directly through the listener, not in an RPC
731 from Emacs. This is to support interfaces such as CMUCL's
732 MP::STARTUP-IDLE-AND-TOP-LEVEL-LOOPS which does not return like a
733 normal function."
734 nil)
735
736 (definterface spawn (fn &key name)
737 "Create a new thread to call FN.")
738
739 (definterface thread-id (thread)
740 "Return an Emacs-parsable object to identify THREAD.
741
742 Ids should be comparable with equal, i.e.:
743 (equal (thread-id <t1>) (thread-id <t2>)) <==> (eq <t1> <t2>)")
744
745 (definterface find-thread (id)
746 "Return the thread for ID.
747 ID should be an id previously obtained with THREAD-ID.
748 Can return nil if the thread no longer exists.")
749
750 (definterface thread-name (thread)
751 "Return the name of THREAD.
752
753 Thread names are be single-line strings and are meaningful to the
754 user. They do not have to be unique."
755 (declare (ignore thread))
756 "The One True Thread")
757
758 (definterface thread-status (thread)
759 "Return a string describing THREAD's state."
760 (declare (ignore thread))
761 "")
762
763 (definterface make-lock (&key name)
764 "Make a lock for thread synchronization.
765 Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time."
766 (declare (ignore name))
767 :null-lock)
768
769 (definterface call-with-lock-held (lock function)
770 "Call FUNCTION with LOCK held, queueing if necessary."
771 (declare (ignore lock)
772 (type function function))
773 (funcall function))
774
775 (definterface current-thread ()
776 "Return the currently executing thread."
777 0)
778
779 (definterface all-threads ()
780 "Return a list of all threads.")
781
782 (definterface thread-alive-p (thread)
783 "Test if THREAD is termintated."
784 (member thread (all-threads)))
785
786 (definterface interrupt-thread (thread fn)
787 "Cause THREAD to execute FN.")
788
789 (definterface kill-thread (thread)
790 "Kill THREAD."
791 (declare (ignore thread))
792 nil)
793
794 (definterface send (thread object)
795 "Send OBJECT to thread THREAD.")
796
797 (definterface receive ()
798 "Return the next message from current thread's mailbox.")
799
800 (definterface toggle-trace (spec)
801 "Toggle tracing of the function(s) given with SPEC.
802 SPEC can be:
803 (setf NAME) ; a setf function
804 (:defmethod NAME QUALIFIER... (SPECIALIZER...)) ; a specific method
805 (:defgeneric NAME) ; a generic function with all methods
806 (:call CALLER CALLEE) ; trace calls from CALLER to CALLEE.
807 (:labels TOPLEVEL LOCAL)
808 (:flet TOPLEVEL LOCAL) ")
809
810
811 ;;;; Weak datastructures
812
813 (definterface make-weak-key-hash-table (&rest args)
814 "Like MAKE-HASH-TABLE, but weak w.r.t. the keys."
815 (apply #'make-hash-table args))
816
817 (definterface make-weak-value-hash-table (&rest args)
818 "Like MAKE-HASH-TABLE, but weak w.r.t. the values."
819 (apply #'make-hash-table args))

  ViewVC Help
Powered by ViewVC 1.1.5