cleanup: partial long cleanup in sniff_code_object and gencgc_apply_code_fixups

[sbcl.git] / src / compiler / macros.lisp

diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp
index 66b034d..be5100e 100644 (file)
--- a/src/compiler/macros.lisp
+++ b/src/compiler/macros.lisp
@@ -469,12 +469,16 @@
 ;;; the function might have.
 (defmacro defknown (name arg-types result-type &optional (attributes '(any))
                     &body keys)
+  #-sb-xc-host
+  (when (member 'unsafe attributes)
+    (style-warn "Ignoring legacy attribute UNSAFE. Replaced by its inverse: DX-SAFE.")
+    (setf attributes (remove 'unsafe attributes)))
   (when (and (intersection attributes '(any call unwind))
              (intersection attributes '(movable)))
     (error "function cannot have both good and bad attributes: ~S" attributes))
 
   (when (member 'any attributes)
-    (setq attributes (union '(call unsafe unwind) attributes)))
+    (setq attributes (union '(call unwind) attributes)))
   (when (member 'flushable attributes)
     (pushnew 'unsafely-flushable attributes))
 
@@ -983,3 +987,19 @@ specify bindings for printer control variables.")
         (nreverse (mapcar #'car *compiler-print-variable-alist*))
         (nreverse (mapcar #'cdr *compiler-print-variable-alist*))
       ,@forms)))
+
+;;; Like DESTRUCTURING-BIND, but generates a COMPILER-ERROR on failure
+(defmacro compiler-destructuring-bind (lambda-list thing context
+                                       &body body)
+  (let ((whole-name (gensym "WHOLE")))
+    (multiple-value-bind (body local-decls)
+        (parse-defmacro lambda-list whole-name body nil
+                        context
+                        :anonymousp t
+                        :doc-string-allowed nil
+                        :wrap-block nil
+                        :error-fun 'compiler-error)
+      `(let ((,whole-name ,thing))
+         (declare (type list ,whole-name))
+         ,@local-decls
+         ,body))))