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 ;;; general case of EVAL (except in that it can't handle toplevel
15 ;;; EVAL-WHEN magic properly): Delegate to #'COMPILE.
16 (defun %eval
(expr lexenv
)
17 ;; FIXME: It might be nice to quieten the toplevel by muffling
18 ;; warnings generated by this compilation (since we're about to
19 ;; execute the results irrespective of the warnings). We might want
20 ;; to be careful about not muffling warnings arising from inner
21 ;; evaluations/compilations, though [e.g. the ignored variable in
22 ;; (DEFUN FOO (X) 1)]. -- CSR, 2003-05-13
23 (let ((fun (sb!c
:compile-in-lexenv
(gensym "EVAL-TMPFUN-")
28 ;;; Handle PROGN and implicit PROGN.
29 (defun eval-progn-body (progn-body lexenv
)
30 (unless (list-with-length-p progn-body
)
31 (let ((*print-circle
* t
))
32 (error 'simple-program-error
34 "~@<not a proper list in PROGN or implicit PROGN: ~2I~_~S~:>"
35 :format-arguments
(list progn-body
))))
37 ;; * We can't just use (MAP NIL #'EVAL PROGN-BODY) here, because we
38 ;; need to take care to return all the values of the final EVAL.
39 ;; * It's left as an exercise to the reader to verify that this
40 ;; gives the right result when PROGN-BODY is NIL, because
41 ;; (FIRST NIL) = (REST NIL) = NIL.
42 (do* ((i progn-body rest-i
)
43 (rest-i (rest i
) (rest i
)))
45 (if rest-i
; if not last element of list
46 (eval-in-lexenv (first i
) lexenv
)
47 (return (eval-in-lexenv (first i
) lexenv
)))))
49 (defun eval-locally (exp lexenv
&optional vars
)
50 (multiple-value-bind (body decls
)
51 (parse-body (rest exp
) :doc-string-allowed nil
)
53 ;; KLUDGE: Uh, yeah. I'm not anticipating
54 ;; winning any prizes for this code, which was
55 ;; written on a "let's get it to work" basis.
56 ;; These seem to be the variables that need
57 ;; bindings for PROCESS-DECLS to work
58 ;; (*FREE-FUNS* and *FREE-VARS* so that
59 ;; references to free functions and variables
60 ;; in the declarations can be noted;
61 ;; *UNDEFINED-WARNINGS* so that warnings about
62 ;; undefined things can be accumulated [and
63 ;; then thrown away, as it happens]). -- CSR,
65 (let ((sb!c
:*lexenv
* lexenv
)
66 (sb!c
::*free-funs
* (make-hash-table :test
'equal
))
67 (sb!c
::*free-vars
* (make-hash-table :test
'eq
))
68 (sb!c
::*undefined-warnings
* nil
))
69 ;; FIXME: VALUES declaration
70 (sb!c
::process-decls decls
74 (eval-progn-body body lexenv
))))
76 (defun eval (original-exp)
78 "Evaluate the argument in a null lexical environment, returning the
80 (eval-in-lexenv original-exp
(make-null-lexenv)))
82 ;;; Pick off a few easy cases, and the various top level EVAL-WHEN
83 ;;; magical cases, and call %EVAL for the rest.
84 (defun eval-in-lexenv (original-exp lexenv
)
85 (declare (optimize (safety 1)))
86 ;; (aver (lexenv-simple-p lexenv))
90 (if (boundp 'sb
!c
::*compiler-error-bailout
*)
91 ;; if we're in the compiler, delegate either to a higher
92 ;; authority or, if that's us, back down to the
93 ;; outermost compiler handler...
97 ;; ... if we're not in the compiler, better signal a
98 ;; program error straight away.
99 (invoke-restart 'sb
!c
::signal-program-error
)))))
100 (let ((exp (macroexpand original-exp lexenv
)))
103 (ecase (info :variable
:kind exp
)
105 (values (info :variable
:constant-value exp
)))
108 ;; FIXME: This special case here is a symptom of non-ANSI
109 ;; weirdness in SBCL's ALIEN implementation, which could
110 ;; cause problems for e.g. code walkers. It'd probably be
111 ;; good to ANSIfy it by making alien variable accessors
112 ;; into ordinary forms, e.g. (SB-UNIX:ENV) and (SETF
113 ;; SB-UNIX:ENV), instead of magical symbols, e.g. plain
114 ;; SB-UNIX:ENV. Then if the old magical-symbol syntax is to
115 ;; be retained for compatibility, it can be implemented
116 ;; with DEFINE-SYMBOL-MACRO, keeping the code walkers
119 (%eval original-exp lexenv
))))
121 (let ((name (first exp
))
122 (n-args (1- (length exp
))))
126 (error "wrong number of args to FUNCTION:~% ~S" exp
))
127 (let ((name (second exp
)))
128 (if (and (legal-fun-name-p name
)
129 (not (consp (let ((sb!c
:*lexenv
* lexenv
))
130 (sb!c
:lexenv-find name funs
)))))
132 (%eval original-exp lexenv
))))
135 (error "wrong number of args to QUOTE:~% ~S" exp
))
138 (unless (evenp n-args
)
139 (error "odd number of args to SETQ:~% ~S" exp
))
140 (unless (zerop n-args
)
141 (do ((name (cdr exp
) (cddr name
)))
143 (do ((args (cdr exp
) (cddr args
)))
145 ;; We duplicate the call to SET so that the
146 ;; correct value gets returned.
147 (set (first args
) (eval (second args
))))
148 (set (first args
) (eval (second args
)))))
149 (let ((symbol (first name
)))
150 (case (info :variable
:kind symbol
)
152 (t (return (%eval original-exp lexenv
))))
153 (unless (type= (info :variable
:type symbol
)
155 ;; let the compiler deal with type checking
156 (return (%eval original-exp lexenv
)))))))
158 (eval-progn-body (rest exp
) lexenv
))
160 ;; FIXME: DESTRUCTURING-BIND returns ARG-COUNT-ERROR
161 ;; instead of PROGRAM-ERROR when there's something wrong
162 ;; with the syntax here (e.g. missing SITUATIONS). This
163 ;; could be fixed by hand-crafting clauses to catch and
164 ;; report each possibility, but it would probably be
165 ;; cleaner to write a new macro
166 ;; DESTRUCTURING-BIND-PROGRAM-SYNTAX which does
167 ;; DESTRUCTURING-BIND and promotes any mismatch to
168 ;; PROGRAM-ERROR, then to use it here and in (probably
169 ;; dozens of) other places where the same problem
171 (destructuring-bind (eval-when situations
&rest body
) exp
172 (declare (ignore eval-when
))
173 (multiple-value-bind (ct lt e
)
174 (sb!c
:parse-eval-when-situations situations
)
175 ;; CLHS 3.8 - Special Operator EVAL-WHEN: The use of
176 ;; the situation :EXECUTE (or EVAL) controls whether
177 ;; evaluation occurs for other EVAL-WHEN forms; that
178 ;; is, those that are not top level forms, or those
179 ;; in code processed by EVAL or COMPILE. If the
180 ;; :EXECUTE situation is specified in such a form,
181 ;; then the body forms are processed as an implicit
182 ;; PROGN; otherwise, the EVAL-WHEN form returns NIL.
183 (declare (ignore ct lt
))
185 (eval-progn-body body lexenv
)))))
187 (eval-locally exp lexenv
))
189 (destructuring-bind (definitions &rest body
)
192 (let ((sb!c
:*lexenv
* lexenv
))
193 (sb!c
::funcall-in-macrolet-lexenv
196 (declare (ignore funs
))
199 (eval-locally `(locally ,@body
) lexenv
))))
201 (destructuring-bind (definitions &rest body
)
203 (multiple-value-bind (lexenv vars
)
204 (let ((sb!c
:*lexenv
* lexenv
))
205 (sb!c
::funcall-in-symbol-macrolet-lexenv
208 (values sb
!c
:*lexenv
* vars
))
210 (eval-locally `(locally ,@body
) lexenv vars
))))
212 (if (and (symbolp name
)
213 (eq (info :function
:kind name
) :function
))
215 (dolist (arg (rest exp
))
216 (args (eval-in-lexenv arg lexenv
)))
217 (apply (symbol-function name
) (args)))
218 (%eval exp lexenv
))))))
222 ;;; miscellaneous full function definitions of things which are
223 ;;; ordinarily handled magically by the compiler
225 (defun apply (function arg
&rest arguments
)
227 "Apply FUNCTION to a list of arguments produced by evaluating ARGUMENTS in
228 the manner of LIST*. That is, a list is made of the values of all but the
229 last argument, appended to the value of the last argument, which must be a
231 (cond ((atom arguments
)
232 (apply function arg
))
233 ((atom (cdr arguments
))
234 (apply function
(cons arg
(car arguments
))))
235 (t (do* ((a1 arguments a2
)
236 (a2 (cdr arguments
) (cdr a2
)))
239 (apply function
(cons arg arguments
)))))))
241 (defun funcall (function &rest arguments
)
243 "Call FUNCTION with the given ARGUMENTS."
244 (apply function arguments
))
246 (defun values (&rest values
)
248 "Return all arguments, in order, as values."
249 (values-list values
))
251 (defun values-list (list)
253 "Return all of the elements of LIST, in order, as values."