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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5