src/code/destructuring-bind.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; This software is derived from the CMU CL system, which was
   5 ;;;; written at Carnegie Mellon University and released into the
   6 ;;;; public domain. The software is in the public domain and is
   7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
   8 ;;;; files for more information.
   9
  10 (in-package "SB!IMPL")
  11
  12 (macrolet (#+sb-xc-host ; Bootstrap NAMED-DS-BIND
  13            (named-ds-bind (name lambda-list expression &body body)
  14              (declare (ignore name))
  15              `(cl:destructuring-bind ,lambda-list ,expression ,@body)))
  16
  17   (sb!xc:defmacro destructuring-bind (lambda-list expression &body body
  18                                                   &environment env)
  19     (declare (ignore env)) ; could be policy-sensitive (but isn't)
  20     #!+sb-doc
  21     "Bind the variables in LAMBDA-LIST to the corresponding values in the
  22 tree structure resulting from the evaluation of EXPRESSION."
  23     `(binding* ,(sb!c::expand-ds-bind lambda-list expression t nil)
  24        ,@body))
  25
  26   (let ()
  27     ;; This is a variant of destructuring-bind that provides the name
  28     ;; of the containing construct in generated error messages.
  29     ;; There is a cyclic dependence between it and DEFMACRO.
  30     (sb!xc:defmacro named-ds-bind (name lambda-list expression &body body
  31                                         &environment env)
  32       (declare (ignore env)) ; could be policy-sensitive (but isn't)
  33       `(binding* ,(sb!c::expand-ds-bind lambda-list expression t nil name
  34                                         (and (eq (car name) :macro)
  35                                              (eq (cddr name) 'deftype)
  36                                              ''*))
  37          ,@body))))
  38
  39 #+sb-xc-host
  40 (progn
  41   ;; The expander for NAMED-DS-BIND in the host could almost always be
  42   ;; the above MACROLET, but that would fail to use the default of '* for
  43   ;; optional args of SB!XC:DEFTYPE that lack an overriding default.
  44   ;; So install our expander even if it produces suboptimal code for the host.
  45   (defmacro named-ds-bind (&whole form &rest args)
  46     (declare (ignore args))
  47     (funcall (sb!xc:macro-function 'named-ds-bind) form nil))
  48
  49   ;; A similar problem in reverse: SB!XC:DEFMACRO's expansion uses NAMED-DS-BIND
  50   ;; which expands to BINDING* (from "early-extensions") that hand-written code
  51   ;; also wants to use. So expand it in the target by using the host's expander
  52   ;; until it gets seen again during make-host-2.
  53   (setf (sb!xc:macro-function 'binding*)
  54         (lambda (form env) (declare (ignore env)) (cl:macroexpand-1 form nil))))