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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5