Avoid some exceptions in WAIT-UNTIL-FD-USABLE on Windows
[sbcl.git] / src / code / macroexpand.lisp
1 ;;;; MACROEXPAND and friends
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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.
11
12 (in-package "SB!IMPL")
13 \f
14 ;;;; syntactic environment access
15
16 (defun sb!xc:special-operator-p (symbol)
17   #!+sb-doc
18   "If the symbol globally names a special form, return T, otherwise NIL."
19   (declare (symbol symbol))
20   (eq (info :function :kind symbol) :special-form))
21
22 (defvar sb!xc:*macroexpand-hook* 'funcall
23   #!+sb-doc
24   "The value of this variable must be a designator for a function that can
25   take three arguments, a macro expander function, the macro form to be
26   expanded, and the lexical environment to expand in. The function should
27   return the expanded form. This function is called by MACROEXPAND-1
28   whenever a runtime expansion is needed. Initially this is set to
29   FUNCALL.")
30
31 (defun sb!xc:macroexpand-1 (form &optional env)
32   #!+sb-doc
33   "If form is a macro (or symbol macro), expand it once. Return two values,
34    the expanded form and a T-or-NIL flag indicating whether the form was, in
35    fact, a macro. ENV is the lexical environment to expand in, which defaults
36    to the null environment."
37   (cond ((and (consp form) (symbolp (car form)))
38          (let ((def (sb!xc:macro-function (car form) env)))
39            (if def
40                (values (funcall sb!xc:*macroexpand-hook*
41                                 def
42                                 form
43                                 ;; As far as I can tell, it's not clear from
44                                 ;; the ANSI spec whether a MACRO-FUNCTION
45                                 ;; function needs to be prepared to handle
46                                 ;; NIL as a lexical environment. CMU CL
47                                 ;; passed NIL through to the MACRO-FUNCTION
48                                 ;; function, but I prefer SBCL "be conservative
49                                 ;; in what it sends and liberal in what it
50                                 ;; accepts" by doing the defaulting itself.
51                                 ;; -- WHN 19991128
52                                 (coerce-to-lexenv env))
53                        t)
54                (values form nil))))
55         ((symbolp form)
56          (flet ((perform-symbol-expansion (symbol expansion)
57                   ;; CLHS 3.1.2.1.1 specifies that symbol-macros are expanded
58                   ;; via the macroexpand hook, too.
59                   (funcall sb!xc:*macroexpand-hook*
60                            (constantly expansion)
61                            symbol
62                            env)))
63            (let* ((venv (when env (sb!c::lexenv-vars env)))
64                   (local-def (cdr (assoc form venv))))
65              (cond ((and (consp local-def)
66                          (eq (car local-def) 'macro))
67                     (values (perform-symbol-expansion form (cdr local-def)) t))
68                    (local-def
69                     (values form nil))
70                    ((eq (info :variable :kind form) :macro)
71                     (let ((expansion (info :variable :macro-expansion form)))
72                       (values (perform-symbol-expansion form expansion) t)))
73                    (t
74                     (values form nil))))))
75         (t
76          (values form nil))))
77
78 (defun sb!xc:macroexpand (form &optional env)
79   #!+sb-doc
80   "Repetitively call MACROEXPAND-1 until the form can no longer be expanded.
81    Returns the final resultant form, and T if it was expanded. ENV is the
82    lexical environment to expand in, or NIL (the default) for the null
83    environment."
84   (labels ((frob (form expanded)
85              (multiple-value-bind (new-form newly-expanded-p)
86                  (sb!xc:macroexpand-1 form env)
87                (if newly-expanded-p
88                    (frob new-form t)
89                    (values new-form expanded)))))
90     (frob form nil)))
91
92 ;;; Like MACROEXPAND-1, but takes care not to expand special forms.
93 (defun %macroexpand-1 (form &optional env)
94   (if (or (atom form)
95           (let ((op (car form)))
96             (not (and (symbolp op) (sb!xc:special-operator-p op)))))
97       (sb!xc:macroexpand-1 form env)
98       (values form nil)))
99
100 ;;; Like MACROEXPAND, but takes care not to expand special forms.
101 (defun %macroexpand (form &optional env)
102   (labels ((frob (form expanded)
103              (multiple-value-bind (new-form newly-expanded-p)
104                  (%macroexpand-1 form env)
105                (if newly-expanded-p
106                    (frob new-form t)
107                    (values new-form expanded)))))
108     (frob form nil)))