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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.36 - (show annotations)
Tue Mar 9 12:46:27 2004 UTC (10 years, 1 month ago) by heller
Branch: MAIN
Changes since 1.35: +113 -248 lines
Merge package-split branch into main trunk.
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 ))
28
29 (in-package :swank-backend)
30
31
32 ;;;; Metacode
33
34 (defparameter *interface-functions* '()
35 "The names of all interface functions.")
36
37 (defparameter *unimplemented-interfaces* '()
38 "List of interface functions that are not implemented.
39 DEFINTERFACE adds to this list and DEFIMPLEMENTATION removes.")
40
41 (defmacro definterface (name args documentation &body default-body)
42 "Define an interface function for the backend to implement.
43 A generic function is defined with NAME, ARGS, and DOCUMENTATION.
44
45 If a DEFAULT-BODY is supplied then NO-APPLICABLE-METHOD is specialized
46 to execute the body if the backend doesn't provide a specific
47 implementation.
48
49 Backends implement these functions using DEFIMPLEMENTATION."
50 (flet ((gen-default-impl ()
51 (let ((received-args (gensym "ARGS-")))
52 `(defmethod no-applicable-method ((#:method
53 (eql (function ,name)))
54 &rest ,received-args)
55 (destructuring-bind ,args ,received-args
56 ,@default-body)))))
57 ` (progn (defgeneric ,name ,args (:documentation ,documentation))
58 (pushnew ',name *interface-functions*)
59 ,(if (null default-body)
60 `(pushnew ',name *unimplemented-interfaces*)
61 (gen-default-impl))
62 (export ',name :swank-backend)
63 ',name)))
64
65 (defmacro defimplementation (name args &body body)
66 ;; Is this a macro no-no -- should it be pushed out of macroexpansion?
67 `(progn (defmethod ,name ,args ,@body)
68 (if (member ',name *interface-functions*)
69 (setq *unimplemented-interfaces*
70 (remove ',name *unimplemented-interfaces*))
71 (warn "DEFIMPLEMENTATION of undefined interface (~S)" ',name))
72 ',name))
73
74 (defun warn-unimplemented-interfaces ()
75 "Warn the user about unimplemented backend features.
76 The portable code calls this function at startup."
77 (warn "These Swank interfaces are unimplemented:~% ~A"
78 (sort (copy-list *unimplemented-interfaces*) #'string<)))
79
80
81 ;;;; TCP server
82
83 (definterface create-socket (host port)
84 "Create a listening TCP socket on interface HOST and port PORT .")
85
86 (definterface local-port (socket)
87 "Return the local port number of SOCKET.")
88
89 (definterface close-socket (socket)
90 "Close the socket SOCKET.")
91
92 (definterface accept-connection (socket)
93 "Accept a client connection on the listening socket SOCKET. Return
94 a stream for the new connection.")
95
96 (definterface add-sigio-handler (socket fn)
97 "Call FN whenever SOCKET is readable.")
98
99 (definterface remove-sigio-handlers (socket)
100 "Remove all sigio handlers for SOCKET.")
101
102 (definterface add-fd-handler (socket fn)
103 "Call FN when Lisp is waiting for input and SOCKET is readable.")
104
105 (definterface remove-fd-handlers (socket)
106 "Remove all fd-handlers for SOCKET.")
107
108 (definterface preferred-communication-style ()
109 "Return one of the symbols :spawn, :sigio, :fd-handler, or NIL."
110 nil)
111
112 ;;; Base condition for networking errors.
113 (define-condition network-error (error) ())
114
115 (definterface emacs-connected ()
116 "Hook called when the first connection from Emacs is established.
117 Called from the INIT-FN of the socket server that accepts the
118 connection.
119
120 This is intended for setting up extra context, e.g. to discover
121 that the calling thread is the one that interacts with Emacs."
122 nil)
123
124
125 ;;;; Unix signals
126
127 (defconstant +sigint+ 2)
128
129 (definterface call-without-interrupts (fn)
130 "Call FN in a context where interrupts are disabled."
131 (funcall fn))
132
133 (definterface getpid ()
134 "Return the (Unix) process ID of this superior Lisp.")
135
136 (definterface lisp-implementation-type-name ()
137 "Return a short name for the Lisp implementation."
138 (lisp-implementation-type))
139
140
141 ;;;; Compilation
142
143 (definterface call-with-compilation-hooks (func)
144 "Call FUNC with hooks to trigger SLDB on compiler errors.")
145
146 (defmacro with-compilation-hooks ((&rest ignore) &body body)
147 (declare (ignore ignore))
148 `(call-with-compilation-hooks (lambda () (progn ,@body))))
149
150 (definterface swank-compile-string (string &key buffer position)
151 "Compile source from STRING. During compilation, compiler
152 conditions must be trapped and resignalled as COMPILER-CONDITIONs.
153
154 If supplied, BUFFER and POSITION specify the source location in Emacs.
155
156 Additionally, if POSITION is supplied, it must be added to source
157 positions reported in compiler conditions.")
158
159 (definterface swank-compile-system (system-name)
160 "Compile and load SYSTEM-NAME, During compilation compiler
161 conditions must be trapped and resignalled as
162 COMPILER-CONDITION ala compile-string-for-emacs."
163 (with-compilation-hooks ()
164 (cond ((member :asdf *features*)
165 (let ((operate (find-symbol (string :operate) :asdf))
166 (load-op (find-symbol (string :load-op) :asdf)))
167 (funcall operate load-op system-name)))
168 (t (error "ASDF not loaded")))))
169
170 (definterface swank-compile-file (filename load-p)
171 "Compile FILENAME signalling COMPILE-CONDITIONs.
172 If LOAD-P is true, load the file after compilation.")
173
174 (deftype severity () '(member :error :warning :style-warning :note))
175
176 ;; Base condition type for compiler errors, warnings and notes.
177 (define-condition compiler-condition (condition)
178 ((original-condition
179 ;; The original condition thrown by the compiler if appropriate.
180 ;; May be NIL if a compiler does not report using conditions.
181 :type (or null condition)
182 :initarg :original-condition
183 :accessor original-condition)
184
185 (severity :type severity
186 :initarg :severity
187 :accessor severity)
188
189 (message :initarg :message
190 :accessor message)
191
192 (short-message :initarg :short-message
193 :initform nil
194 :accessor short-message)
195
196 (location :initarg :location
197 :accessor location)))
198
199
200
201
202 ;;;; Streams
203
204 (definterface make-fn-streams (input-fn output-fn)
205 "Return character input and output streams backended by functions.
206 When input is needed, INPUT-FN is called with no arguments to
207 return a string.
208 When output is ready, OUTPUT-FN is called with the output as its
209 argument.
210
211 Output should be forced to OUTPUT-FN before calling INPUT-FN.
212
213 The streams are returned as two values.")
214
215
216 ;;;; Documentation
217
218 (definterface arglist (name)
219 "Return the lambda list for the symbol NAME.
220
221 The result can be a list or a string.
222
223 An error should be signaled if the lambda list cannot be found.")
224
225 (definterface macroexpand-all (form)
226 "Recursively expand all macros in FORM.
227 Return the resulting form.")
228
229 (definterface describe-symbol-for-emacs (symbol)
230 "Return a property list describing SYMBOL.
231
232 The property list has an entry for each interesting aspect of the
233 symbol. The recognised keys are:
234
235 :VARIABLE :FUNCTION :SETF :TYPE :CLASS :MACRO :COMPILER-MACRO
236 :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
237
238 The value of each property is the corresponding documentation string,
239 or :NOT-DOCUMENTED. It is legal to include keys not listed here.
240
241 Properties should be included if and only if they are applicable to
242 the symbol. For example, only (and all) fbound symbols should include
243 the :FUNCTION property.
244
245 Example:
246 \(describe-symbol-for-emacs 'vector)
247 => (:CLASS :NOT-DOCUMENTED
248 :TYPE :NOT-DOCUMENTED
249 :FUNCTION \"Constructs a simple-vector from the given objects.\")")
250
251 (definterface describe-definition (name type)
252 "Describe the definition NAME of TYPE.
253 TYPE can be any value returned by DESCRIBE-SYMBOL-FOR-EMACS.
254
255 Return a documentation string, or NIL if none is available.")
256
257
258 ;;;; Debugging
259
260 (definterface call-with-debugging-environment (debugger-loop-fn)
261 "Call DEBUGGER-LOOP-FN in a suitable debugging environment.
262
263 This function is called recursively at each debug level to invoke the
264 debugger loop. The purpose is to setup any necessary environment for
265 other debugger callbacks that will be called within the debugger loop.
266
267 For example, this is a reasonable place to compute a backtrace, switch
268 to safe reader/printer settings, and so on.")
269
270 (define-condition sldb-condition (condition)
271 ((original-condition
272 :initarg :original-condition
273 :accessor original-condition))
274 (:documentation
275 "Wrapper for conditions that should not be debugged.
276
277 When a condition arises from the internals of the debugger, it is not
278 desirable to debug it -- we'd risk entering an endless loop trying to
279 debug the debugger! Instead, such conditions can be reported to the
280 user without (re)entering the debugger by wrapping them as
281 `sldb-condition's."))
282
283 (definterface compute-backtrace (start end)
284 "Return a list containing a backtrace of the condition current
285 being debugged. The results are unspecified if this function is
286 called outside the dynamic contour CALL-WITH-DEBUGGING-ENVIRONMENT.
287
288 START and END are zero-based indices constraining the number of frames
289 returned. Frame zero is defined as the frame which invoked the
290 debugger. If END is nil, return the frames from START to the end of
291 the stack.")
292
293 (definterface print-frame (frame stream)
294 "Print frame to stream.")
295
296 (definterface frame-source-location-for-emacs (frame-number)
297 "Return the source location for FRAME-NUMBER.")
298
299 (definterface frame-catch-tags (frame-number)
300 "Return a list of XXX list of what? catch tags for a debugger
301 stack frame. The results are undefined unless this is called
302 within the dynamic contour of a function defined by
303 DEFINE-DEBUGGER-HOOK.")
304
305 (definterface frame-locals (frame-number)
306 "Return a list of XXX local variable designators define me
307 for a debugger stack frame. The results are undefined unless
308 this is called within the dynamic contour of a function defined
309 by DEFINE-DEBUGGER-HOOK.")
310
311 (definterface eval-in-frame (form frame-number)
312 "Evaluate a Lisp form in the lexical context of a stack frame
313 in the debugger. The results are undefined unless called in the
314 dynamic contour of a function defined by DEFINE-DEBUGGER-HOOK.
315
316 FRAME-NUMBER must be a positive integer with 0 indicating the
317 frame which invoked the debugger.
318
319 The return value is the result of evaulating FORM in the
320 appropriate context.")
321
322 (definterface return-from-frame (frame-number form)
323 "Unwind the stack to the frame FRAME-NUMBER and return the value(s)
324 produced by evaluating FORM in the frame context to its caller.
325
326 Execute any clean-up code from unwind-protect forms above the frame
327 during unwinding.
328
329 Return a string describing the error if it's not possible to return
330 from the frame.")
331
332 (definterface restart-frame (frame-number)
333 "Restart execution of the frame FRAME-NUMBER with the same arguments
334 as it was called originally.")
335
336
337 ;;;; Definition finding
338
339 (defstruct (:location (:type list) :named
340 (:constructor make-location (buffer position)))
341 buffer position)
342
343 (defstruct (:error (:type list) :named (:constructor)) message)
344 (defstruct (:file (:type list) :named (:constructor)) name)
345 (defstruct (:buffer (:type list) :named (:constructor)) name)
346 (defstruct (:position (:type list) :named (:constructor)) pos)
347
348 (definterface find-definitions (name)
349 "Return a list ((DSPEC LOCATION) ...) for NAME's definitions.
350
351 NAME is string denoting a symbol or \"definition specifier\".
352
353 DSPEC is a symbol or a \"definition specifier\" describing the
354 definition, e.g., FOO or (METHOD FOO (STRING NUMBER)) or
355 \(DEFVAR BAR).")
356
357
358 ;;;; XREF
359
360 (definterface who-calls (function-name)
361 "Return the call sites of FUNCTION-NAME (a symbol).
362 The results is a list ((DSPEC LOCATION) ...).")
363
364 (definterface who-references (variable-name)
365 "Return the locations where VARIABLE-NAME (a symbol) is referenced.
366 See WHO-CALLS for a description of the return value.")
367
368 (definterface who-binds (variable-name)
369 "Return the locations where VARIABLE-NAME (a symbol) is bound.
370 See WHO-CALLS for a description of the return value.")
371
372 (definterface who-sets (variable-name)
373 "Return the locations where VARIABLE-NAME (a symbol) is set.
374 See WHO-CALLS for a description of the return value.")
375
376 (definterface who-macroexpands (macro-name)
377 "Return the locations where MACRO-NAME (a symbol) is expanded.
378 See WHO-CALLS for a description of the return value.")
379
380 (definterface who-specializes (class-name)
381 "Return the locations where CLASS-NAME (a symbol) is specialized.
382 See WHO-CALLS for a description of the return value.")
383
384 ;;; Simpler variants.
385
386 (definterface list-callers (function-name)
387 "List the callers of FUNCTION-NAME.
388 This function is like WHO-CALLS except that it is expected to use
389 lower-level means. Whereas WHO-CALLS is usually implemented with
390 special compiler support, LIST-CALLERS is usually implemented by
391 groveling for constants in function objects throughout the heap.
392
393 The return value is as for WHO-CALLS.")
394
395 (definterface list-callees (function-name)
396 "List the functions called by FUNCTION-NAME.
397 See LIST-CALLERS for a description of the return value.")
398
399
400 ;;;; Profiling
401
402 ;;; The following functions define a minimal profiling interface.
403
404 (definterface profile (fname)
405 "Marks symbol FNAME for profiling.")
406
407 (definterface profiled-functions ()
408 "Returns a list of profiled functions.")
409
410 (definterface unprofile (fname)
411 "Marks symbol FNAME as not profiled.")
412
413 (definterface unprofile-all ()
414 "Marks all currently profiled functions as not profiled."
415 (dolist (f (profiled-functions))
416 (unprofile f)))
417
418 (definterface profile-report ()
419 "Prints profile report.")
420
421 (definterface profile-reset ()
422 "Resets profile counters.")
423
424 (definterface profile-package (package callers-p methods)
425 "Wrap profiling code around all functions in PACKAGE. If a function
426 is already profiled, then unprofile and reprofile (useful to notice
427 function redefinition.)
428
429 If CALLERS-P is T names have counts of the most common calling
430 functions recorded.
431
432 When called with arguments :METHODS T, profile all methods of all
433 generic functions having names in the given package. Generic functions
434 themselves, that is, their dispatch functions, are left alone.")
435
436
437 ;;;; Inspector
438
439 (definterface inspected-parts (object)
440 "Return a short description and a list of (LABEL . VALUE) pairs."
441 (values (format nil "~S is an atom." object) '()))
442
443 (definterface describe-primitive-type (object)
444 "Return a string describing the primitive type of object."
445 (declare (ignore object))
446 "N/A")
447
448
449 ;;;; Multithreading
450 ;;;
451 ;;; The default implementations are sufficient for non-multiprocessing
452 ;;; implementations.
453
454 (definterface startup-multiprocessing ()
455 "Initialize multiprocessing, if necessary.
456
457 This function is called directly through the listener, not in an RPC
458 from Emacs. This is to support interfaces such as CMUCL's
459 MP::STARTUP-IDLE-AND-TOP-LEVEL-LOOPS which does not return like a
460 normal function."
461 nil)
462
463 (definterface spawn (fn &key name)
464 "Create a new thread to call FN.")
465
466 (definterface thread-name (thread)
467 "Return the name of THREAD.
468
469 Thread names are be single-line strings and are meaningful to the
470 user. They do not have to be unique."
471 (declare (ignore thread))
472 "The One True Thread")
473
474 (definterface thread-status (thread)
475 "Return a string describing THREAD's state."
476 (declare (ignore thread))
477 "")
478
479 (definterface make-lock (&key name)
480 "Make a lock for thread synchronization.
481 Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time."
482 (declare (ignore name))
483 :null-lock)
484
485 (definterface call-with-lock-held (lock function)
486 "Call FUNCTION with LOCK held, queueing if necessary."
487 (declare (ignore lock)
488 (type function function))
489 (funcall function))
490
491 (definterface current-thread ()
492 "Return the currently executing thread."
493 0)
494
495 (definterface all-threads ()
496 "Return a list of all threads.")
497
498 (definterface thread-alive-p (thread)
499 "Test if THREAD is termintated."
500 (member thread (all-threads)))
501
502 (definterface interrupt-thread (thread fn)
503 "Cause THREAD to execute FN.")
504
505 (definterface kill-thread (thread)
506 "Kill THREAD."
507 (declare (ignore thread))
508 nil)
509
510 (definterface send (thread object)
511 "Send OBJECT to thread THREAD.")
512
513 (definterface receive ()
514 "Return the next message from current thread's mailbox.")

  ViewVC Help
Powered by ViewVC 1.1.5