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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.185 - (hide annotations)
Sat Nov 21 21:32:28 2009 UTC (4 years, 4 months ago) by trittweiler
Branch: MAIN
Changes since 1.184: +3 -0 lines
	* swank-sbcl.lisp (who-specializes): Implement.
	Requires SBCL 1.0.32.
1 lgorrie 1.85 ;;; -*- Mode: lisp; indent-tabs-mode: nil; outline-regexp: ";;;;;*" -*-
2 lgorrie 1.1 ;;;
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.85 ;;;
7     ;;;; Frontmatter
8 lgorrie 1.1 ;;;
9 lgorrie 1.13 ;;; 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 lgorrie 1.1
13 heller 1.36 (defpackage :swank-backend
14 lgorrie 1.1 (:use :common-lisp)
15 heller 1.36 (:export #:sldb-condition
16 trittweiler 1.179 #:compiler-condition
17 heller 1.36 #:original-condition
18     #:message
19 heller 1.180 #:source-context
20 heller 1.36 #:condition
21     #:severity
22 heller 1.124 #:with-compilation-hooks
23 heller 1.36 #:location
24     #:location-p
25     #:location-buffer
26     #:location-position
27     #:position-p
28     #:position-pos
29     #:print-output-to-string
30 mbaringer 1.42 #:quit-lisp
31 crhodes 1.62 #:references
32 mbaringer 1.67 #:unbound-slot-filler
33 trittweiler 1.120 #:declaration-arglist
34     #:type-specifier-arglist
35 heller 1.140 ;; interrupt macro for the backend
36     #:*pending-slime-interrupts*
37     #:check-slime-interrupts
38 heller 1.172 #:*interrupt-queued-handler*
39 mbaringer 1.67 ;; inspector related symbols
40 heller 1.128 #:emacs-inspect
41 heller 1.70 #:label-value-line
42     #:label-value-line*
43 heller 1.136
44 mbaringer 1.115 #:with-struct
45 mbaringer 1.67 ))
46 lgorrie 1.1
47 mbaringer 1.65 (defpackage :swank-mop
48     (:use)
49     (:export
50     ;; classes
51     #:standard-generic-function
52     #:standard-slot-definition
53     #:standard-method
54     #:standard-class
55 mbaringer 1.68 #:eql-specializer
56     #:eql-specializer-object
57 mbaringer 1.65 ;; standard-class readers
58     #:class-default-initargs
59     #:class-direct-default-initargs
60     #:class-direct-slots
61     #:class-direct-subclasses
62     #:class-direct-superclasses
63     #:class-finalized-p
64     #:class-name
65     #:class-precedence-list
66     #:class-prototype
67     #:class-slots
68 mbaringer 1.68 #:specializer-direct-methods
69 mbaringer 1.65 ;; generic function readers
70     #:generic-function-argument-precedence-order
71     #:generic-function-declarations
72     #:generic-function-lambda-list
73     #:generic-function-methods
74     #:generic-function-method-class
75     #:generic-function-method-combination
76     #:generic-function-name
77     ;; method readers
78     #:method-generic-function
79     #:method-function
80     #:method-lambda-list
81     #:method-specializers
82     #:method-qualifiers
83     ;; slot readers
84     #:slot-definition-allocation
85     #:slot-definition-documentation
86     #:slot-definition-initargs
87     #:slot-definition-initform
88     #:slot-definition-initfunction
89     #:slot-definition-name
90     #:slot-definition-type
91     #:slot-definition-readers
92 lgorrie 1.79 #:slot-definition-writers
93 heller 1.95 #:slot-boundp-using-class
94     #:slot-value-using-class
95 alendvai 1.111 #:slot-makunbound-using-class
96 lgorrie 1.79 ;; generic function protocol
97 lgorrie 1.82 #:compute-applicable-methods-using-classes
98     #:finalize-inheritance))
99 mbaringer 1.65
100 heller 1.36 (in-package :swank-backend)
101 lgorrie 1.1
102    
103 lgorrie 1.21 ;;;; Metacode
104    
105     (defparameter *interface-functions* '()
106     "The names of all interface functions.")
107    
108     (defparameter *unimplemented-interfaces* '()
109     "List of interface functions that are not implemented.
110     DEFINTERFACE adds to this list and DEFIMPLEMENTATION removes.")
111    
112 heller 1.52 (defmacro definterface (name args documentation &rest default-body)
113 lgorrie 1.21 "Define an interface function for the backend to implement.
114 trittweiler 1.125 A function is defined with NAME, ARGS, and DOCUMENTATION. This
115     function first looks for a function to call in NAME's property list
116     that is indicated by 'IMPLEMENTATION; failing that, it looks for a
117     function indicated by 'DEFAULT. If neither is present, an error is
118     signaled.
119    
120     If a DEFAULT-BODY is supplied, then a function with the same body and
121     ARGS will be added to NAME's property list as the property indicated
122     by 'DEFAULT.
123 lgorrie 1.21
124     Backends implement these functions using DEFIMPLEMENTATION."
125 lgorrie 1.43 (check-type documentation string "a documentation string")
126 heller 1.101 (assert (every #'symbolp args) ()
127     "Complex lambda-list not supported: ~S ~S" name args)
128     (labels ((gen-default-impl ()
129     `(setf (get ',name 'default) (lambda ,args ,@default-body)))
130     (args-as-list (args)
131     (destructuring-bind (req opt key rest) (parse-lambda-list args)
132     `(,@req ,@opt
133     ,@(loop for k in key append `(,(kw k) ,k))
134     ,@(or rest '(())))))
135     (parse-lambda-list (args)
136     (parse args '(&optional &key &rest)
137     (make-array 4 :initial-element nil)))
138     (parse (args keywords vars)
139     (cond ((null args)
140     (reverse (map 'list #'reverse vars)))
141     ((member (car args) keywords)
142     (parse (cdr args) (cdr (member (car args) keywords)) vars))
143     (t (push (car args) (aref vars (length keywords)))
144     (parse (cdr args) keywords vars))))
145     (kw (s) (intern (string s) :keyword)))
146     `(progn
147     (defun ,name ,args
148     ,documentation
149     (let ((f (or (get ',name 'implementation)
150     (get ',name 'default))))
151     (cond (f (apply f ,@(args-as-list args)))
152 mkoeppe 1.178 (t (error "~S not implemented" ',name)))))
153 heller 1.101 (pushnew ',name *interface-functions*)
154     ,(if (null default-body)
155     `(pushnew ',name *unimplemented-interfaces*)
156     (gen-default-impl))
157     ;; see <http://www.franz.com/support/documentation/6.2/doc/pages/variables/compiler/s_cltl1-compile-file-toplevel-compatibility-p_s.htm>
158     (eval-when (:compile-toplevel :load-toplevel :execute)
159     (export ',name :swank-backend))
160     ',name)))
161 lgorrie 1.21
162     (defmacro defimplementation (name args &body body)
163 heller 1.101 (assert (every #'symbolp args) ()
164     "Complex lambda-list not supported: ~S ~S" name args)
165 heller 1.99 `(progn
166 heller 1.101 (setf (get ',name 'implementation) (lambda ,args ,@body))
167 heller 1.99 (if (member ',name *interface-functions*)
168     (setq *unimplemented-interfaces*
169     (remove ',name *unimplemented-interfaces*))
170     (warn "DEFIMPLEMENTATION of undefined interface (~S)" ',name))
171     ',name))
172 lgorrie 1.21
173     (defun warn-unimplemented-interfaces ()
174     "Warn the user about unimplemented backend features.
175     The portable code calls this function at startup."
176 trittweiler 1.174 (let ((*print-pretty* t))
177     (warn "These Swank interfaces are unimplemented:~% ~:<~{~A~^ ~:_~}~:>"
178     (list (sort (copy-list *unimplemented-interfaces*) #'string<)))))
179 lgorrie 1.21
180 heller 1.69 (defun import-to-swank-mop (symbol-list)
181     (dolist (sym symbol-list)
182     (let* ((swank-mop-sym (find-symbol (symbol-name sym) :swank-mop)))
183     (when swank-mop-sym
184     (unintern swank-mop-sym :swank-mop))
185     (import sym :swank-mop)
186     (export sym :swank-mop))))
187    
188     (defun import-swank-mop-symbols (package except)
189     "Import the mop symbols from PACKAGE to SWANK-MOP.
190     EXCEPT is a list of symbol names which should be ignored."
191     (do-symbols (s :swank-mop)
192     (unless (member s except :test #'string=)
193     (let ((real-symbol (find-symbol (string s) package)))
194 heller 1.76 (assert real-symbol () "Symbol ~A not found in package ~A" s package)
195 heller 1.69 (unintern s :swank-mop)
196     (import real-symbol :swank-mop)
197     (export real-symbol :swank-mop)))))
198    
199 heller 1.88 (defvar *gray-stream-symbols*
200     '(:fundamental-character-output-stream
201     :stream-write-char
202 heller 1.137 :stream-write-string
203 heller 1.88 :stream-fresh-line
204     :stream-force-output
205     :stream-finish-output
206     :fundamental-character-input-stream
207     :stream-read-char
208 heller 1.148 :stream-peek-char
209     :stream-read-line
210 trittweiler 1.150 ;; STREAM-FILE-POSITION is not available on all implementations, or
211     ;; partially under a different name.
212     ; :stream-file-posiion
213 heller 1.88 :stream-listen
214     :stream-unread-char
215     :stream-clear-input
216     :stream-line-column
217 jsnellman 1.90 :stream-read-char-no-hang
218     ;; STREAM-LINE-LENGTH is an extension to gray streams that's apparently
219 dcrosher 1.91 ;; supported by CMUCL, OpenMCL, SBCL and SCL.
220     #+(or cmu openmcl sbcl scl)
221 jsnellman 1.90 :stream-line-length))
222 heller 1.88
223     (defun import-from (package symbol-names &optional (to-package *package*))
224     "Import the list of SYMBOL-NAMES found in the package PACKAGE."
225     (dolist (name symbol-names)
226     (multiple-value-bind (symbol found) (find-symbol (string name) package)
227     (assert found () "Symbol ~A not found in package ~A" name package)
228     (import symbol to-package))))
229    
230 lgorrie 1.21
231 heller 1.46 ;;;; Utilities
232    
233     (defmacro with-struct ((conc-name &rest names) obj &body body)
234     "Like with-slots but works only for structs."
235     (flet ((reader (slot) (intern (concatenate 'string
236     (symbol-name conc-name)
237     (symbol-name slot))
238     (symbol-package conc-name))))
239     (let ((tmp (gensym "OO-")))
240     ` (let ((,tmp ,obj))
241     (symbol-macrolet
242     ,(loop for name in names collect
243     (typecase name
244     (symbol `(,name (,(reader name) ,tmp)))
245     (cons `(,(first name) (,(reader (second name)) ,tmp)))
246     (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))
247     ,@body)))))
248 lgorrie 1.54
249 trittweiler 1.171 (defun with-symbol (name package)
250     "Generate a form suitable for testing with #+."
251     (if (find-symbol (string name) (string package))
252     '(:and)
253     '(:or)))
254    
255 lgorrie 1.54
256 lgorrie 1.13 ;;;; TCP server
257    
258 heller 1.29 (definterface create-socket (host port)
259     "Create a listening TCP socket on interface HOST and port PORT .")
260 lgorrie 1.13
261 lgorrie 1.21 (definterface local-port (socket)
262     "Return the local port number of SOCKET.")
263 lgorrie 1.1
264 lgorrie 1.21 (definterface close-socket (socket)
265     "Close the socket SOCKET.")
266 lgorrie 1.1
267 heller 1.93 (definterface accept-connection (socket &key external-format
268 dcrosher 1.97 buffering timeout)
269 heller 1.93 "Accept a client connection on the listening socket SOCKET.
270     Return a stream for the new connection.")
271 heller 1.16
272 heller 1.31 (definterface add-sigio-handler (socket fn)
273 lgorrie 1.21 "Call FN whenever SOCKET is readable.")
274 heller 1.16
275 heller 1.31 (definterface remove-sigio-handlers (socket)
276     "Remove all sigio handlers for SOCKET.")
277    
278     (definterface add-fd-handler (socket fn)
279     "Call FN when Lisp is waiting for input and SOCKET is readable.")
280    
281     (definterface remove-fd-handlers (socket)
282     "Remove all fd-handlers for SOCKET.")
283 heller 1.18
284 heller 1.36 (definterface preferred-communication-style ()
285     "Return one of the symbols :spawn, :sigio, :fd-handler, or NIL."
286     nil)
287    
288 dcrosher 1.97 (definterface set-stream-timeout (stream timeout)
289     "Set the 'stream 'timeout. The timeout is either the real number
290     specifying the timeout in seconds or 'nil for no timeout."
291     (declare (ignore stream timeout))
292     nil)
293    
294 lgorrie 1.13 ;;; Base condition for networking errors.
295 msimmons 1.50 (define-condition network-error (simple-error) ())
296 lgorrie 1.13
297 heller 1.74 (definterface emacs-connected ()
298 lgorrie 1.13 "Hook called when the first connection from Emacs is established.
299     Called from the INIT-FN of the socket server that accepts the
300     connection.
301 lgorrie 1.1
302 lgorrie 1.13 This is intended for setting up extra context, e.g. to discover
303 heller 1.74 that the calling thread is the one that interacts with Emacs."
304 mbaringer 1.73 nil)
305 lgorrie 1.1
306    
307 heller 1.20 ;;;; Unix signals
308    
309     (defconstant +sigint+ 2)
310    
311 heller 1.32 (definterface getpid ()
312     "Return the (Unix) process ID of this superior Lisp.")
313    
314 heller 1.144 (definterface install-sigint-handler (function)
315     "Call FUNCTION on SIGINT (instead of invoking the debugger).
316     Return old signal handler."
317 heller 1.162 (declare (ignore function))
318 heller 1.144 nil)
319    
320     (definterface call-with-user-break-handler (handler function)
321     "Install the break handler HANDLER while executing FUNCTION."
322     (let ((old-handler (install-sigint-handler handler)))
323     (unwind-protect (funcall function)
324     (install-sigint-handler old-handler))))
325    
326 heller 1.155 (definterface quit-lisp ()
327     "Exit the current lisp image.")
328    
329 heller 1.32 (definterface lisp-implementation-type-name ()
330     "Return a short name for the Lisp implementation."
331     (lisp-implementation-type))
332 heller 1.20
333 heller 1.155
334     ;; pathnames are sooo useless
335    
336     (definterface filename-to-pathname (filename)
337     "Return a pathname for FILENAME.
338     A filename in Emacs may for example contain asterisks which should not
339     be translated to wildcards."
340     (parse-namestring filename))
341    
342     (definterface pathname-to-filename (pathname)
343     "Return the filename for PATHNAME."
344     (namestring pathname))
345    
346 heller 1.51 (definterface default-directory ()
347     "Return the default directory."
348     (directory-namestring (truename *default-pathname-defaults*)))
349    
350 heller 1.39 (definterface set-default-directory (directory)
351     "Set the default directory.
352     This is used to resolve filenames without directory component."
353     (setf *default-pathname-defaults* (truename (merge-pathnames directory)))
354 heller 1.51 (default-directory))
355    
356 heller 1.155
357 heller 1.51 (definterface call-with-syntax-hooks (fn)
358     "Call FN with hooks to handle special syntax."
359     (funcall fn))
360 heller 1.39
361 heller 1.52 (definterface default-readtable-alist ()
362 heller 1.77 "Return a suitable initial value for SWANK:*READTABLE-ALIST*."
363 heller 1.52 '())
364    
365 heller 1.20
366 lgorrie 1.1 ;;;; Compilation
367 dbarlow 1.8
368 lgorrie 1.21 (definterface call-with-compilation-hooks (func)
369 lgorrie 1.47 "Call FUNC with hooks to record compiler conditions.")
370 lgorrie 1.13
371 vsedach 1.14 (defmacro with-compilation-hooks ((&rest ignore) &body body)
372 lgorrie 1.47 "Execute BODY as in CALL-WITH-COMPILATION-HOOKS."
373 vsedach 1.14 (declare (ignore ignore))
374 dbarlow 1.8 `(call-with-compilation-hooks (lambda () (progn ,@body))))
375 lgorrie 1.1
376 heller 1.167 (definterface swank-compile-string (string &key buffer position filename
377 trittweiler 1.165 policy)
378 heller 1.156 "Compile source from STRING.
379     During compilation, compiler conditions must be trapped and
380     resignalled as COMPILER-CONDITIONs.
381 lgorrie 1.1
382     If supplied, BUFFER and POSITION specify the source location in Emacs.
383    
384     Additionally, if POSITION is supplied, it must be added to source
385 pseibel 1.64 positions reported in compiler conditions.
386    
387 heller 1.167 If FILENAME is specified it may be used by certain implementations to
388 pseibel 1.64 rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
389 heller 1.131 source information.
390    
391 heller 1.167 If POLICY is supplied, and non-NIL, it may be used by certain
392 trittweiler 1.134 implementations to compile with a debug optimization quality of its
393 trittweiler 1.135 value.
394    
395     Should return T on successfull compilation, NIL otherwise.
396 heller 1.131 ")
397 lgorrie 1.1
398 heller 1.169 (definterface swank-compile-file (input-file output-file load-p
399     external-format)
400     "Compile INPUT-FILE signalling COMPILE-CONDITIONs.
401 heller 1.109 If LOAD-P is true, load the file after compilation.
402     EXTERNAL-FORMAT is a value returned by find-external-format or
403 trittweiler 1.135 :default.
404    
405 heller 1.156 Should return OUTPUT-TRUENAME, WARNINGS-P and FAILURE-p
406     like `compile-file'")
407 lgorrie 1.1
408 heller 1.72 (deftype severity ()
409 trittweiler 1.179 '(member :error :read-error :warning :style-warning :note :redefinition))
410 lgorrie 1.13
411     ;; Base condition type for compiler errors, warnings and notes.
412     (define-condition compiler-condition (condition)
413     ((original-condition
414     ;; The original condition thrown by the compiler if appropriate.
415     ;; May be NIL if a compiler does not report using conditions.
416     :type (or null condition)
417     :initarg :original-condition
418     :accessor original-condition)
419    
420     (severity :type severity
421     :initarg :severity
422     :accessor severity)
423    
424     (message :initarg :message
425     :accessor message)
426    
427 heller 1.180 ;; Macro expansion history etc. which may be helpful in some cases
428     ;; but is often very verbose.
429     (source-context :initarg :source-context
430     :type (or null string)
431     :initform nil
432     :accessor source-context)
433 crhodes 1.62
434     (references :initarg :references
435     :initform nil
436     :accessor references)
437 heller 1.30
438 lgorrie 1.13 (location :initarg :location
439     :accessor location)))
440 heller 1.30
441 heller 1.109 (definterface find-external-format (coding-system)
442     "Return a \"external file format designator\" for CODING-SYSTEM.
443     CODING-SYSTEM is Emacs-style coding system name (a string),
444     e.g. \"latin-1-unix\"."
445     (if (equal coding-system "iso-latin-1-unix")
446     :default
447     nil))
448    
449 trittweiler 1.146 (definterface guess-external-format (pathname)
450     "Detect the external format for the file with name pathname.
451 heller 1.109 Return nil if the file contains no special markers."
452     ;; Look for a Emacs-style -*- coding: ... -*- or Local Variable: section.
453 trittweiler 1.146 (with-open-file (s pathname :if-does-not-exist nil
454 heller 1.109 :external-format (or (find-external-format "latin-1-unix")
455     :default))
456 heller 1.110 (if s
457     (or (let* ((line (read-line s nil))
458     (p (search "-*-" line)))
459     (when p
460     (let* ((start (+ p (length "-*-")))
461     (end (search "-*-" line :start2 start)))
462     (when end
463     (%search-coding line start end)))))
464     (let* ((len (file-length s))
465     (buf (make-string (min len 3000))))
466     (file-position s (- len (length buf)))
467     (read-sequence buf s)
468     (let ((start (search "Local Variables:" buf :from-end t))
469     (end (search "End:" buf :from-end t)))
470     (and start end (< start end)
471     (%search-coding buf start end))))))))
472 heller 1.109
473     (defun %search-coding (str start end)
474     (let ((p (search "coding:" str :start2 start :end2 end)))
475     (when p
476     (incf p (length "coding:"))
477     (loop while (and (< p end)
478     (member (aref str p) '(#\space #\tab)))
479     do (incf p))
480     (let ((end (position-if (lambda (c) (find c '(#\space #\tab #\newline)))
481     str :start p)))
482     (find-external-format (subseq str p end))))))
483    
484 lgorrie 1.17
485 lgorrie 1.13 ;;;; Streams
486    
487 heller 1.147 (definterface make-output-stream (write-string)
488     "Return a new character output stream.
489     The stream calls WRITE-STRING when output is ready.")
490    
491     (definterface make-input-stream (read-string)
492     "Return a new character input stream.
493     The stream calls READ-STRING when input is needed.")
494    
495 lgorrie 1.1
496     ;;;; Documentation
497    
498 heller 1.36 (definterface arglist (name)
499 mbaringer 1.65 "Return the lambda list for the symbol NAME. NAME can also be
500     a lisp function object, on lisps which support this.
501    
502 trittweiler 1.120 The result can be a list or the :not-available keyword if the
503     arglist cannot be determined."
504 mbaringer 1.65 (declare (ignore name))
505     :not-available)
506 heller 1.36
507 trittweiler 1.120 (defgeneric declaration-arglist (decl-identifier)
508     (:documentation
509     "Return the argument list of the declaration specifier belonging to the
510     declaration identifier DECL-IDENTIFIER. If the arglist cannot be determined,
511     the keyword :NOT-AVAILABLE is returned.
512    
513     The different SWANK backends can specialize this generic function to
514     include implementation-dependend declaration specifiers, or to provide
515     additional information on the specifiers defined in ANSI Common Lisp.")
516     (:method (decl-identifier)
517     (case decl-identifier
518     (dynamic-extent '(&rest vars))
519     (ignore '(&rest vars))
520     (ignorable '(&rest vars))
521     (special '(&rest vars))
522     (inline '(&rest function-names))
523 trittweiler 1.175 (notinline '(&rest function-names))
524     (declaration '(&rest names))
525 trittweiler 1.120 (optimize '(&any compilation-speed debug safety space speed))
526     (type '(type-specifier &rest args))
527     (ftype '(type-specifier &rest function-names))
528     (otherwise
529     (flet ((typespec-p (symbol) (member :type (describe-symbol-for-emacs symbol))))
530     (cond ((and (symbolp decl-identifier) (typespec-p decl-identifier))
531     '(&rest vars))
532     ((and (listp decl-identifier) (typespec-p (first decl-identifier)))
533     '(&rest vars))
534     (t :not-available)))))))
535    
536     (defgeneric type-specifier-arglist (typespec-operator)
537     (:documentation
538     "Return the argument list of the type specifier belonging to
539     TYPESPEC-OPERATOR.. If the arglist cannot be determined, the keyword
540     :NOT-AVAILABLE is returned.
541    
542     The different SWANK backends can specialize this generic function to
543     include implementation-dependend declaration specifiers, or to provide
544     additional information on the specifiers defined in ANSI Common Lisp.")
545     (:method (typespec-operator)
546     (declare (special *type-specifier-arglists*)) ; defined at end of file.
547     (typecase typespec-operator
548     (symbol (or (cdr (assoc typespec-operator *type-specifier-arglists*))
549     :not-available))
550     (t :not-available))))
551    
552 mbaringer 1.65 (definterface function-name (function)
553     "Return the name of the function object FUNCTION.
554    
555     The result is either a symbol, a list, or NIL if no function name is available."
556     (declare (ignore function))
557     nil)
558 lgorrie 1.1
559 lgorrie 1.21 (definterface macroexpand-all (form)
560 lgorrie 1.1 "Recursively expand all macros in FORM.
561 lgorrie 1.21 Return the resulting form.")
562 lgorrie 1.1
563 heller 1.94 (definterface compiler-macroexpand-1 (form &optional env)
564     "Call the compiler-macro for form.
565     If FORM is a function call for which a compiler-macro has been
566     defined, invoke the expander function using *macroexpand-hook* and
567     return the results and T. Otherwise, return the original form and
568     NIL."
569     (let ((fun (and (consp form) (compiler-macro-function (car form)))))
570     (if fun
571     (let ((result (funcall *macroexpand-hook* fun form env)))
572     (values result (not (eq result form))))
573     (values form nil))))
574    
575     (definterface compiler-macroexpand (form &optional env)
576     "Repetitively call `compiler-macroexpand-1'."
577     (labels ((frob (form expanded)
578     (multiple-value-bind (new-form newly-expanded)
579     (compiler-macroexpand-1 form env)
580     (if newly-expanded
581     (frob new-form t)
582     (values new-form expanded)))))
583     (frob form env)))
584    
585 trittweiler 1.173 (definterface format-string-expand (control-string)
586     "Expand the format string CONTROL-STRING."
587     (macroexpand `(formatter ,control-string)))
588    
589 lgorrie 1.21 (definterface describe-symbol-for-emacs (symbol)
590 lgorrie 1.1 "Return a property list describing SYMBOL.
591    
592     The property list has an entry for each interesting aspect of the
593     symbol. The recognised keys are:
594    
595 heller 1.86 :VARIABLE :FUNCTION :SETF :SPECIAL-OPERATOR :MACRO :COMPILER-MACRO
596     :TYPE :CLASS :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
597 lgorrie 1.1
598     The value of each property is the corresponding documentation string,
599 heller 1.86 or :NOT-DOCUMENTED. It is legal to include keys not listed here (but
600     slime-print-apropos in Emacs must know about them).
601 lgorrie 1.1
602     Properties should be included if and only if they are applicable to
603     the symbol. For example, only (and all) fbound symbols should include
604     the :FUNCTION property.
605    
606     Example:
607     \(describe-symbol-for-emacs 'vector)
608     => (:CLASS :NOT-DOCUMENTED
609     :TYPE :NOT-DOCUMENTED
610 lgorrie 1.21 :FUNCTION \"Constructs a simple-vector from the given objects.\")")
611    
612     (definterface describe-definition (name type)
613     "Describe the definition NAME of TYPE.
614     TYPE can be any value returned by DESCRIBE-SYMBOL-FOR-EMACS.
615    
616     Return a documentation string, or NIL if none is available.")
617 lgorrie 1.2
618    
619     ;;;; Debugging
620    
621 heller 1.92 (definterface install-debugger-globally (function)
622     "Install FUNCTION as the debugger for all threads/processes. This
623     usually involves setting *DEBUGGER-HOOK* and, if the implementation
624     permits, hooking into BREAK as well."
625     (setq *debugger-hook* function))
626    
627 lgorrie 1.21 (definterface call-with-debugging-environment (debugger-loop-fn)
628 lgorrie 1.2 "Call DEBUGGER-LOOP-FN in a suitable debugging environment.
629    
630     This function is called recursively at each debug level to invoke the
631     debugger loop. The purpose is to setup any necessary environment for
632     other debugger callbacks that will be called within the debugger loop.
633    
634     For example, this is a reasonable place to compute a backtrace, switch
635 lgorrie 1.21 to safe reader/printer settings, and so on.")
636 lgorrie 1.2
637 heller 1.80 (definterface call-with-debugger-hook (hook fun)
638 trittweiler 1.181 "Call FUN and use HOOK as debugger hook. HOOK can be NIL.
639 heller 1.80
640     HOOK should be called for both BREAK and INVOKE-DEBUGGER."
641     (let ((*debugger-hook* hook))
642     (funcall fun)))
643    
644 lgorrie 1.2 (define-condition sldb-condition (condition)
645     ((original-condition
646     :initarg :original-condition
647 heller 1.5 :accessor original-condition))
648 heller 1.63 (:report (lambda (condition stream)
649     (format stream "Condition in debugger code~@[: ~A~]"
650     (original-condition condition))))
651 lgorrie 1.2 (:documentation
652     "Wrapper for conditions that should not be debugged.
653    
654     When a condition arises from the internals of the debugger, it is not
655     desirable to debug it -- we'd risk entering an endless loop trying to
656     debug the debugger! Instead, such conditions can be reported to the
657     user without (re)entering the debugger by wrapping them as
658     `sldb-condition's."))
659    
660 trittweiler 1.132 ;;; The following functions in this section are supposed to be called
661     ;;; within the dynamic contour of CALL-WITH-DEBUGGING-ENVIRONMENT only.
662    
663 heller 1.36 (definterface compute-backtrace (start end)
664 trittweiler 1.132 "Returns a backtrace of the condition currently being debugged,
665 heller 1.157 that is an ordered list consisting of frames. ``Ordered list''
666 trittweiler 1.151 means that an integer I can be mapped back to the i-th frame of this
667     backtrace.
668 heller 1.36
669     START and END are zero-based indices constraining the number of frames
670 trittweiler 1.151 returned. Frame zero is defined as the frame which invoked the
671     debugger. If END is nil, return the frames from START to the end of
672 heller 1.36 the stack.")
673 lgorrie 1.3
674 heller 1.157 (definterface print-frame (frame stream)
675 heller 1.36 "Print frame to stream.")
676 heller 1.70
677 heller 1.157 (definterface frame-restartable-p (frame)
678     "Is the frame FRAME restartable?.
679     Return T if `restart-frame' can safely be called on the frame."
680 heller 1.161 (declare (ignore frame))
681 heller 1.157 nil)
682    
683 heller 1.176 (definterface frame-source-location (frame-number)
684 trittweiler 1.132 "Return the source location for the frame associated to FRAME-NUMBER.")
685 lgorrie 1.3
686 lgorrie 1.21 (definterface frame-catch-tags (frame-number)
687 trittweiler 1.132 "Return a list of catch tags for being printed in a debugger stack
688 heller 1.159 frame."
689 heller 1.160 (declare (ignore frame-number))
690 heller 1.159 '())
691 lgorrie 1.3
692 lgorrie 1.21 (definterface frame-locals (frame-number)
693 trittweiler 1.132 "Return a list of ((&key NAME ID VALUE) ...) where each element of
694     the list represents a local variable in the stack frame associated to
695     FRAME-NUMBER.
696    
697     NAME, a symbol; the name of the local variable.
698    
699     ID, an integer; used as primary key for the local variable, unique
700     relatively to the frame under operation.
701    
702     value, an object; the value of the local variable.")
703    
704     (definterface frame-var-value (frame-number var-id)
705     "Return the value of the local variable associated to VAR-ID
706     relatively to the frame associated to FRAME-NUMBER.")
707 heller 1.57
708 heller 1.37 (definterface disassemble-frame (frame-number)
709     "Disassemble the code for the FRAME-NUMBER.
710     The output should be written to standard output.
711 heller 1.84 FRAME-NUMBER is a non-negative integer.")
712 heller 1.37
713 lgorrie 1.21 (definterface eval-in-frame (form frame-number)
714 lgorrie 1.3 "Evaluate a Lisp form in the lexical context of a stack frame
715 trittweiler 1.132 in the debugger.
716 lgorrie 1.3
717     FRAME-NUMBER must be a positive integer with 0 indicating the
718     frame which invoked the debugger.
719    
720     The return value is the result of evaulating FORM in the
721 lgorrie 1.21 appropriate context.")
722 heller 1.22
723     (definterface return-from-frame (frame-number form)
724     "Unwind the stack to the frame FRAME-NUMBER and return the value(s)
725     produced by evaluating FORM in the frame context to its caller.
726    
727     Execute any clean-up code from unwind-protect forms above the frame
728     during unwinding.
729    
730     Return a string describing the error if it's not possible to return
731     from the frame.")
732    
733     (definterface restart-frame (frame-number)
734     "Restart execution of the frame FRAME-NUMBER with the same arguments
735     as it was called originally.")
736 lgorrie 1.3
737 lgorrie 1.49 (definterface format-sldb-condition (condition)
738     "Format a condition for display in SLDB."
739     (princ-to-string condition))
740    
741 heller 1.69 (definterface condition-extras (condition)
742     "Return a list of extra for the debugger.
743     The allowed elements are of the form:
744 heller 1.126 (:SHOW-FRAME-SOURCE frame-number)
745     (:REFERENCES &rest refs)
746     "
747 mbaringer 1.73 (declare (ignore condition))
748 heller 1.69 '())
749    
750 heller 1.71 (definterface activate-stepping (frame-number)
751     "Prepare the frame FRAME-NUMBER for stepping.")
752 heller 1.69
753     (definterface sldb-break-on-return (frame-number)
754     "Set a breakpoint in the frame FRAME-NUMBER.")
755    
756     (definterface sldb-break-at-start (symbol)
757     "Set a breakpoint on the beginning of the function for SYMBOL.")
758 heller 1.52
759 jsnellman 1.103 (definterface sldb-stepper-condition-p (condition)
760     "Return true if SLDB was invoked due to a single-stepping condition,
761     false otherwise. "
762     (declare (ignore condition))
763     nil)
764    
765     (definterface sldb-step-into ()
766     "Step into the current single-stepper form.")
767    
768     (definterface sldb-step-next ()
769     "Step to the next form in the current function.")
770    
771     (definterface sldb-step-out ()
772     "Stop single-stepping temporarily, but resume it once the current function
773     returns.")
774 lgorrie 1.49
775 lgorrie 1.3
776 heller 1.36 ;;;; Definition finding
777    
778     (defstruct (:location (:type list) :named
779 lgorrie 1.45 (:constructor make-location
780     (buffer position &optional hints)))
781     buffer position
782     ;; Hints is a property list optionally containing:
783     ;; :snippet SOURCE-TEXT
784     ;; This is a snippet of the actual source text at the start of
785     ;; the definition, which could be used in a text search.
786     hints)
787 heller 1.36
788     (defstruct (:error (:type list) :named (:constructor)) message)
789     (defstruct (:file (:type list) :named (:constructor)) name)
790     (defstruct (:buffer (:type list) :named (:constructor)) name)
791     (defstruct (:position (:type list) :named (:constructor)) pos)
792    
793     (definterface find-definitions (name)
794     "Return a list ((DSPEC LOCATION) ...) for NAME's definitions.
795    
796 heller 1.38 NAME is a \"definition specifier\".
797 heller 1.36
798 heller 1.38 DSPEC is a \"definition specifier\" describing the
799 heller 1.36 definition, e.g., FOO or (METHOD FOO (STRING NUMBER)) or
800 heller 1.38 \(DEFVAR FOO).
801    
802     LOCATION is the source location for the definition.")
803 heller 1.36
804 trittweiler 1.130 (definterface find-source-location (object)
805     "Returns the source location of OBJECT, or NIL.
806    
807     That is the source location of the underlying datastructure of
808     OBJECT. E.g. on a STANDARD-OBJECT, the source location of the
809     respective DEFCLASS definition is returned, on a STRUCTURE-CLASS the
810     respective DEFSTRUCT definition, and so on."
811 trittweiler 1.135 ;; This returns one source location and not a list of locations. It's
812 trittweiler 1.130 ;; supposed to return the location of the DEFGENERIC definition on
813     ;; #'SOME-GENERIC-FUNCTION.
814     )
815    
816    
817 lgorrie 1.61 (definterface buffer-first-change (filename)
818     "Called for effect the first time FILENAME's buffer is modified."
819 mbaringer 1.73 (declare (ignore filename))
820 lgorrie 1.61 nil)
821    
822 trittweiler 1.130
823 heller 1.36
824     ;;;; XREF
825    
826     (definterface who-calls (function-name)
827     "Return the call sites of FUNCTION-NAME (a symbol).
828 trittweiler 1.181 The results is a list ((DSPEC LOCATION) ...)."
829     (declare (ignore function-name))
830     :not-implemented)
831 heller 1.36
832 heller 1.81 (definterface calls-who (function-name)
833     "Return the call sites of FUNCTION-NAME (a symbol).
834 trittweiler 1.181 The results is a list ((DSPEC LOCATION) ...)."
835     (declare (ignore function-name))
836     :not-implemented)
837 heller 1.81
838 heller 1.36 (definterface who-references (variable-name)
839     "Return the locations where VARIABLE-NAME (a symbol) is referenced.
840 trittweiler 1.181 See WHO-CALLS for a description of the return value."
841     (declare (ignore variable-name))
842     :not-implemented)
843 heller 1.36
844     (definterface who-binds (variable-name)
845     "Return the locations where VARIABLE-NAME (a symbol) is bound.
846 trittweiler 1.181 See WHO-CALLS for a description of the return value."
847     (declare (ignore variable-name))
848     :not-implemented)
849 heller 1.36
850     (definterface who-sets (variable-name)
851     "Return the locations where VARIABLE-NAME (a symbol) is set.
852 trittweiler 1.181 See WHO-CALLS for a description of the return value."
853     (declare (ignore variable-name))
854     :not-implemented)
855 heller 1.36
856     (definterface who-macroexpands (macro-name)
857     "Return the locations where MACRO-NAME (a symbol) is expanded.
858 trittweiler 1.181 See WHO-CALLS for a description of the return value."
859     (declare (ignore macro-name))
860     :not-implemented)
861 heller 1.36
862     (definterface who-specializes (class-name)
863     "Return the locations where CLASS-NAME (a symbol) is specialized.
864 trittweiler 1.181 See WHO-CALLS for a description of the return value."
865     (declare (ignore class-name))
866     :not-implemented)
867 heller 1.36
868     ;;; Simpler variants.
869    
870     (definterface list-callers (function-name)
871     "List the callers of FUNCTION-NAME.
872     This function is like WHO-CALLS except that it is expected to use
873     lower-level means. Whereas WHO-CALLS is usually implemented with
874     special compiler support, LIST-CALLERS is usually implemented by
875     groveling for constants in function objects throughout the heap.
876    
877     The return value is as for WHO-CALLS.")
878    
879     (definterface list-callees (function-name)
880     "List the functions called by FUNCTION-NAME.
881     See LIST-CALLERS for a description of the return value.")
882    
883    
884 heller 1.23 ;;;; Profiling
885    
886     ;;; The following functions define a minimal profiling interface.
887    
888     (definterface profile (fname)
889     "Marks symbol FNAME for profiling.")
890    
891     (definterface profiled-functions ()
892     "Returns a list of profiled functions.")
893    
894     (definterface unprofile (fname)
895     "Marks symbol FNAME as not profiled.")
896    
897     (definterface unprofile-all ()
898     "Marks all currently profiled functions as not profiled."
899     (dolist (f (profiled-functions))
900     (unprofile f)))
901    
902     (definterface profile-report ()
903     "Prints profile report.")
904    
905     (definterface profile-reset ()
906     "Resets profile counters.")
907    
908     (definterface profile-package (package callers-p methods)
909     "Wrap profiling code around all functions in PACKAGE. If a function
910     is already profiled, then unprofile and reprofile (useful to notice
911     function redefinition.)
912    
913     If CALLERS-P is T names have counts of the most common calling
914     functions recorded.
915    
916     When called with arguments :METHODS T, profile all methods of all
917     generic functions having names in the given package. Generic functions
918     themselves, that is, their dispatch functions, are left alone.")
919    
920    
921 heller 1.19 ;;;; Inspector
922 lgorrie 1.56
923 heller 1.128 (defgeneric emacs-inspect (object)
924 heller 1.100 (:documentation
925 heller 1.86 "Explain to Emacs how to inspect OBJECT.
926 mbaringer 1.67
927 heller 1.129 Returns a list specifying how to render the object for inspection.
928 mbaringer 1.67
929 lgorrie 1.83 Every element of the list must be either a string, which will be
930 mbaringer 1.67 inserted into the buffer as is, or a list of the form:
931    
932     (:value object &optional format) - Render an inspectable
933     object. If format is provided it must be a string and will be
934     rendered in place of the value, otherwise use princ-to-string.
935    
936     (:newline) - Render a \\n
937    
938 mbaringer 1.117 (:action label lambda &key (refresh t)) - Render LABEL (a text
939     string) which when clicked will call LAMBDA. If REFRESH is
940     non-NIL the currently inspected object will be re-inspected
941     after calling the lambda.
942 heller 1.129 "))
943 mbaringer 1.67
944 heller 1.128 (defmethod emacs-inspect ((object t))
945 mbaringer 1.67 "Generic method for inspecting any kind of object.
946    
947     Since we don't know how to deal with OBJECT we simply dump the
948     output of CL:DESCRIBE."
949 heller 1.86 `("Type: " (:value ,(type-of object)) (:newline)
950     "Don't know how to inspect the object, dumping output of CL:DESCRIBE:"
951     (:newline) (:newline)
952 heller 1.129 ,(with-output-to-string (desc) (describe object desc))))
953 heller 1.70
954 trittweiler 1.185
955 heller 1.84 ;;; Utilities for inspector methods.
956 heller 1.70 ;;;
957 trittweiler 1.185
958 mbaringer 1.118 (defun label-value-line (label value &key (newline t))
959     "Create a control list which prints \"LABEL: VALUE\" in the inspector.
960     If NEWLINE is non-NIL a `(:newline)' is added to the result."
961 trittweiler 1.185
962 mbaringer 1.118 (list* (princ-to-string label) ": " `(:value ,value)
963     (if newline '((:newline)) nil)))
964 heller 1.70
965     (defmacro label-value-line* (&rest label-values)
966     ` (append ,@(loop for (label value) in label-values
967     collect `(label-value-line ,label ,value))))
968 heller 1.19
969 heller 1.29 (definterface describe-primitive-type (object)
970 heller 1.35 "Return a string describing the primitive type of object."
971 heller 1.36 (declare (ignore object))
972 heller 1.35 "N/A")
973 heller 1.19
974    
975 heller 1.36 ;;;; Multithreading
976 lgorrie 1.21 ;;;
977     ;;; The default implementations are sufficient for non-multiprocessing
978     ;;; implementations.
979 lgorrie 1.9
980 mbaringer 1.106 (definterface initialize-multiprocessing (continuation)
981 heller 1.107 "Initialize multiprocessing, if necessary and then invoke CONTINUATION.
982    
983     Depending on the impleimentaion, this function may never return."
984 mbaringer 1.106 (funcall continuation))
985 lgorrie 1.9
986 lgorrie 1.21 (definterface spawn (fn &key name)
987     "Create a new thread to call FN.")
988 lgorrie 1.17
989 heller 1.58 (definterface thread-id (thread)
990     "Return an Emacs-parsable object to identify THREAD.
991    
992     Ids should be comparable with equal, i.e.:
993 heller 1.139 (equal (thread-id <t1>) (thread-id <t2>)) <==> (eq <t1> <t2>)"
994     thread)
995 heller 1.58
996     (definterface find-thread (id)
997     "Return the thread for ID.
998     ID should be an id previously obtained with THREAD-ID.
999 heller 1.142 Can return nil if the thread no longer exists."
1000 heller 1.162 (declare (ignore id))
1001 heller 1.142 (current-thread))
1002 heller 1.58
1003 heller 1.28 (definterface thread-name (thread)
1004     "Return the name of THREAD.
1005 heller 1.183 Thread names are short strings meaningful to the user. They do not
1006     have to be unique."
1007 heller 1.28 (declare (ignore thread))
1008 lgorrie 1.21 "The One True Thread")
1009 lgorrie 1.9
1010 heller 1.28 (definterface thread-status (thread)
1011     "Return a string describing THREAD's state."
1012     (declare (ignore thread))
1013     "")
1014    
1015 heller 1.177 (definterface thread-attributes (thread)
1016     "Return a plist of implementation-dependent attributes for THREAD"
1017     (declare (ignore thread))
1018     '())
1019    
1020 lgorrie 1.21 (definterface make-lock (&key name)
1021 lgorrie 1.17 "Make a lock for thread synchronization.
1022 heller 1.138 Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time
1023     but that thread may hold it more than once."
1024 heller 1.23 (declare (ignore name))
1025 lgorrie 1.21 :null-lock)
1026 lgorrie 1.9
1027 lgorrie 1.21 (definterface call-with-lock-held (lock function)
1028     "Call FUNCTION with LOCK held, queueing if necessary."
1029 heller 1.24 (declare (ignore lock)
1030     (type function function))
1031 lgorrie 1.21 (funcall function))
1032 heller 1.25
1033     (definterface current-thread ()
1034     "Return the currently executing thread."
1035     0)
1036 heller 1.28
1037     (definterface all-threads ()
1038 trittweiler 1.146 "Return a fresh list of all threads.")
1039 heller 1.28
1040     (definterface thread-alive-p (thread)
1041 heller 1.35 "Test if THREAD is termintated."
1042     (member thread (all-threads)))
1043 heller 1.25
1044     (definterface interrupt-thread (thread fn)
1045     "Cause THREAD to execute FN.")
1046    
1047 mbaringer 1.34 (definterface kill-thread (thread)
1048 heller 1.182 "Terminate THREAD immediately.
1049     Don't execute unwind-protected sections, don't raise conditions.
1050     (Do not pass go, do not collect $200.)"
1051 mbaringer 1.34 (declare (ignore thread))
1052     nil)
1053    
1054 heller 1.25 (definterface send (thread object)
1055     "Send OBJECT to thread THREAD.")
1056    
1057 heller 1.143 (definterface receive (&optional timeout)
1058 heller 1.142 "Return the next message from current thread's mailbox."
1059 heller 1.143 (receive-if (constantly t) timeout))
1060 mbaringer 1.78
1061 heller 1.143 (definterface receive-if (predicate &optional timeout)
1062 heller 1.136 "Return the first message satisfiying PREDICATE.")
1063    
1064 heller 1.168 (definterface set-default-initial-binding (var form)
1065     "Initialize special variable VAR by default with FORM.
1066    
1067     Some implementations initialize certain variables in each newly
1068     created thread. This function sets the form which is used to produce
1069     the initial value."
1070     (set var (eval form)))
1071    
1072 heller 1.153 ;; List of delayed interrupts.
1073     ;; This should only have thread-local bindings, so no init form.
1074     (defvar *pending-slime-interrupts*)
1075 heller 1.140
1076 heller 1.154 (defun check-slime-interrupts ()
1077 heller 1.140 "Execute pending interrupts if any.
1078     This should be called periodically in operations which
1079 heller 1.153 can take a long time to complete.
1080 heller 1.154 Return a boolean indicating whether any interrupts was processed."
1081 heller 1.153 (when (and (boundp '*pending-slime-interrupts*)
1082     *pending-slime-interrupts*)
1083 heller 1.154 (funcall (pop *pending-slime-interrupts*))
1084 heller 1.153 t))
1085 heller 1.140
1086 heller 1.172 (defvar *interrupt-queued-handler* nil
1087     "Function to call on queued interrupts.
1088     Interrupts get queued when an interrupt occurs while interrupt
1089     handling is disabled.
1090    
1091     Backends can use this function to abort slow operations.")
1092 heller 1.163
1093 heller 1.152 (definterface wait-for-input (streams &optional timeout)
1094     "Wait for input on a list of streams. Return those that are ready.
1095     STREAMS is a list of streams
1096     TIMEOUT nil, t, or real number. If TIMEOUT is t, return
1097     those streams which are ready immediately, without waiting.
1098     If TIMEOUT is a number and no streams is ready after TIMEOUT seconds,
1099     return nil.
1100    
1101     Return :interrupt if an interrupt occurs while waiting."
1102 heller 1.164 (assert (member timeout '(nil t)))
1103 heller 1.166 (cond #+(or)
1104     ((null (cdr streams))
1105 heller 1.164 (wait-for-one-stream (car streams) timeout))
1106     (t
1107     (wait-for-streams streams timeout))))
1108    
1109     (defun wait-for-streams (streams timeout)
1110 heller 1.166 (loop
1111     (when (check-slime-interrupts) (return :interrupt))
1112     (let ((ready (remove-if-not #'stream-readable-p streams)))
1113     (when ready (return ready)))
1114     (when timeout (return nil))
1115     (sleep 0.1)))
1116 heller 1.164
1117 heller 1.166 ;; Note: Usually we can't interrupt PEEK-CHAR cleanly.
1118 heller 1.164 (defun wait-for-one-stream (stream timeout)
1119     (ecase timeout
1120     ((nil)
1121     (cond ((check-slime-interrupts) :interrupt)
1122     (t (peek-char nil stream nil nil)
1123     (list stream))))
1124     ((t)
1125     (let ((c (read-char-no-hang stream nil nil)))
1126     (cond (c
1127     (unread-char c stream)
1128     (list stream))
1129     (t '()))))))
1130 heller 1.152
1131 heller 1.166 (defun stream-readable-p (stream)
1132     (let ((c (read-char-no-hang stream nil :eof)))
1133     (cond ((not c) nil)
1134     ((eq c :eof) t)
1135     (t (unread-char c stream) t))))
1136    
1137 heller 1.81 (definterface toggle-trace (spec)
1138     "Toggle tracing of the function(s) given with SPEC.
1139     SPEC can be:
1140     (setf NAME) ; a setf function
1141     (:defmethod NAME QUALIFIER... (SPECIALIZER...)) ; a specific method
1142     (:defgeneric NAME) ; a generic function with all methods
1143     (:call CALLER CALLEE) ; trace calls from CALLER to CALLEE.
1144     (:labels TOPLEVEL LOCAL)
1145     (:flet TOPLEVEL LOCAL) ")
1146 mkoeppe 1.87
1147    
1148     ;;;; Weak datastructures
1149    
1150     (definterface make-weak-key-hash-table (&rest args)
1151     "Like MAKE-HASH-TABLE, but weak w.r.t. the keys."
1152     (apply #'make-hash-table args))
1153    
1154     (definterface make-weak-value-hash-table (&rest args)
1155     "Like MAKE-HASH-TABLE, but weak w.r.t. the values."
1156     (apply #'make-hash-table args))
1157 mkoeppe 1.108
1158 alendvai 1.113 (definterface hash-table-weakness (hashtable)
1159     "Return nil or one of :key :value :key-or-value :key-and-value"
1160     (declare (ignore hashtable))
1161     nil)
1162    
1163 mkoeppe 1.108
1164     ;;;; Character names
1165    
1166     (definterface character-completion-set (prefix matchp)
1167     "Return a list of names of characters that match PREFIX."
1168     ;; Handle the standard and semi-standard characters.
1169     (loop for name in '("Newline" "Space" "Tab" "Page" "Rubout"
1170     "Linefeed" "Return" "Backspace")
1171     when (funcall matchp prefix name)
1172     collect name))
1173    
1174 trittweiler 1.120
1175     (defparameter *type-specifier-arglists*
1176     '((and . (&rest type-specifiers))
1177     (array . (&optional element-type dimension-spec))
1178     (base-string . (&optional size))
1179     (bit-vector . (&optional size))
1180     (complex . (&optional type-specifier))
1181     (cons . (&optional car-typespec cdr-typespec))
1182     (double-float . (&optional lower-limit upper-limit))
1183     (eql . (object))
1184     (float . (&optional lower-limit upper-limit))
1185     (function . (&optional arg-typespec value-typespec))
1186     (integer . (&optional lower-limit upper-limit))
1187     (long-float . (&optional lower-limit upper-limit))
1188     (member . (&rest eql-objects))
1189     (mod . (n))
1190     (not . (type-specifier))
1191     (or . (&rest type-specifiers))
1192     (rational . (&optional lower-limit upper-limit))
1193     (real . (&optional lower-limit upper-limit))
1194     (satisfies . (predicate-symbol))
1195     (short-float . (&optional lower-limit upper-limit))
1196     (signed-byte . (&optional size))
1197     (simple-array . (&optional element-type dimension-spec))
1198     (simple-base-string . (&optional size))
1199     (simple-bit-vector . (&optional size))
1200     (simple-string . (&optional size))
1201     (single-float . (&optional lower-limit upper-limit))
1202     (simple-vector . (&optional size))
1203     (string . (&optional size))
1204     (unsigned-byte . (&optional size))
1205     (values . (&rest typespecs))
1206     (vector . (&optional element-type size))
1207 heller 1.121 ))
1208 heller 1.145
1209     ;;; Heap dumps
1210    
1211     (definterface save-image (filename &optional restart-function)
1212     "Save a heap image to the file FILENAME.
1213     RESTART-FUNCTION, if non-nil, should be called when the image is loaded.")
1214    
1215    
1216    

  ViewVC Help
Powered by ViewVC 1.1.5