1 ;;;; Compiler macros that are important for the target system
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
12 (in-package "SB-IMPL")
14 ;;;; Source transforms are used by the compiler to make code more
15 ;;;; canonical so that the compiler can compile it futher; they are
16 ;;;; not optional. Compiler macros are an optional source rewriting
17 ;;;; mechanism mainly for compile-time syntax checking and
18 ;;;; optimizations that can be declined for any reason, but especially
19 ;;;; through the use of NOTINLINE. Perhaps the actual mechanism
20 ;;;; outside the decision to do rewriting could be reunified. We also
21 ;;;; must pay special attention when writing compiler macros for the
22 ;;;; purposes of cross-compiling. A problem is namespace clobbering:
23 ;;;; these must not affect the host Lisp.
25 ;;; The function that corresponds to this macro is defined in src/code/typep.
26 ;;; This expansion is not particularly good for the interpreter, so just
27 ;;; call the function when not compiling.
28 (define-compiler-macro sb-kernel
::%typecase-index
(layout-lists object sealed
)
29 (let ((exp (sb-impl::optimize-%typecase-index layout-lists object sealed
)))
32 ;;; A sanity-checker for an extremely common programmer error.
33 (define-compiler-macro format
(&whole form destination control
&rest args
)
34 (declare (ignore control args
))
35 (when (stringp destination
)
36 (warn "Literal string as destination in FORMAT:~% ~S" form
))
39 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
40 (declaim (inline maybe-note-read-from-string-signature-issue
))
41 (defun maybe-note-read-from-string-signature-issue (eof-error-p)
42 ;; The interface is so unintuitive that we explicitly check for the common
44 (when (member eof-error-p
'(:start
:end
:preserve-whitespace
))
45 (style-warn "~@<~S as EOF-ERROR-P argument to ~S: probable error. ~
46 Two optional arguments must be provided before the ~
47 first keyword argument.~:@>"
48 eof-error-p
'read-from-string
)
51 (define-compiler-macro read-from-string
(&whole form string
&rest args
53 ;; Check this at compile-time, and rewrite it so we're silent at runtime.
54 (destructuring-bind (&optional
(eof-error-p t
) eof-value
&rest keys
) args
55 (if (maybe-note-read-from-string-signature-issue eof-error-p
)
56 `(read-from-string ,string t
,eof-value
,@keys
)
58 ;; the :START, :END, :PRESERVE-WHITESPACE defaults respectively
59 (list (list 0 nil nil
))
64 form
; Odd number of keys, punt.
65 (let ((positionals (list (copy-symbol 'string
)
66 (copy-symbol 'eof-error-p
)
67 (copy-symbol 'eof-value
)))
68 (fun-name (if (sb-c:policy env
(= safety
3))
69 '%read-from-string
/safe
71 `(let (,@(mapcar #'list positionals
72 (list string eof-error-p eof-value
))
74 ,@(when ignore
`((declare (ignore ,@ignore
))))
75 (,fun-name
,@positionals
,@list
)))))
76 (let* ((key (pop keys
))
80 (:preserve-whitespace
2)
81 (otherwise (return-from read-from-string form
))))
82 (var (if (logbitp index seen
)
83 (let ((x (gensym "IGNORE")))
86 (setf seen
(logior (ash 1 index
) seen
)
87 (nth index list
) (copy-symbol key
)))))
88 (push (list var
(pop keys
)) bind
))))))
90 (defmacro def
!struct
(&rest args
) `(defstruct ,@args
))