X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Feval.lisp;h=b33ca523492a03d9cb1c48842ee869b5c0106047;hb=35697e2c02e7b29f7953ae318d50305561927a16;hp=3f29e5952c8a1f15aafe8173ebe4ea7d08c4598b;hpb=269554bcae55d7e502992ea20932f71790066483;p=sbcl.git diff --git a/src/code/eval.lisp b/src/code/eval.lisp index 3f29e59..b33ca52 100644 --- a/src/code/eval.lisp +++ b/src/code/eval.lisp @@ -20,7 +20,7 @@ ;; to be careful about not muffling warnings arising from inner ;; evaluations/compilations, though [e.g. the ignored variable in ;; (DEFUN FOO (X) 1)]. -- CSR, 2003-05-13 - (let ((fun (sb!c:compile-in-lexenv (gensym "EVAL-TMPFUN-") + (let ((fun (sb!c:compile-in-lexenv nil `(lambda () ,expr) lexenv))) (funcall fun))) @@ -46,8 +46,9 @@ (eval-in-lexenv (first i) lexenv) (return (eval-in-lexenv (first i) lexenv))))) -(defun eval-locally (exp lexenv &optional vars) - (multiple-value-bind (body decls) (parse-body (rest exp) nil) +(defun eval-locally (exp lexenv &key vars) + (multiple-value-bind (body decls) + (parse-body (rest exp) :doc-string-allowed nil) (let ((lexenv ;; KLUDGE: Uh, yeah. I'm not anticipating ;; winning any prizes for this code, which was @@ -61,15 +62,15 @@ ;; undefined things can be accumulated [and ;; then thrown away, as it happens]). -- CSR, ;; 2002-10-24 - (let ((sb!c:*lexenv* lexenv) - (sb!c::*free-funs* (make-hash-table :test 'equal)) - (sb!c::*free-vars* (make-hash-table :test 'eq)) - (sb!c::*undefined-warnings* nil)) + (let* ((sb!c:*lexenv* lexenv) + (sb!c::*free-funs* (make-hash-table :test 'equal)) + (sb!c::*free-vars* (make-hash-table :test 'eq)) + (sb!c::*undefined-warnings* nil)) + ;; FIXME: VALUES declaration (sb!c::process-decls decls vars nil - (sb!c::make-continuation) - lexenv)))) + :lexenv lexenv)))) (eval-progn-body body lexenv)))) (defun eval (original-exp) @@ -93,9 +94,9 @@ (progn (signal c) nil) - ;; ... if we're not in the compiler, better signal a - ;; program error straight away. - (invoke-restart 'sb!c::signal-program-error))))) + ;; ... if we're not in the compiler, better signal the + ;; error straight away. + (invoke-restart 'sb!c::signal-error))))) (let ((exp (macroexpand original-exp lexenv))) (typecase exp (symbol @@ -127,7 +128,7 @@ (if (and (legal-fun-name-p name) (not (consp (let ((sb!c:*lexenv* lexenv)) (sb!c:lexenv-find name funs))))) - (fdefinition name) + (%coerce-name-to-fun name) (%eval original-exp lexenv)))) ((quote) (unless (= n-args 1) @@ -143,8 +144,8 @@ ((null (cddr args)) ;; We duplicate the call to SET so that the ;; correct value gets returned. - (set (first args) (eval (second args)))) - (set (first args) (eval (second args))))) + (set (first args) (eval-in-lexenv (second args) lexenv))) + (set (first args) (eval-in-lexenv (second args) lexenv)))) (let ((symbol (first name))) (case (info :variable :kind symbol) (:special) @@ -187,7 +188,7 @@ ((macrolet) (destructuring-bind (definitions &rest body) (rest exp) - (let ((lexenv + (let ((lexenv (let ((sb!c:*lexenv* lexenv)) (sb!c::funcall-in-macrolet-lexenv definitions @@ -197,8 +198,7 @@ :eval)))) (eval-locally `(locally ,@body) lexenv)))) ((symbol-macrolet) - (destructuring-bind (definitions &rest body) - (rest exp) + (destructuring-bind (definitions &rest body) (rest exp) (multiple-value-bind (lexenv vars) (let ((sb!c:*lexenv* lexenv)) (sb!c::funcall-in-symbol-macrolet-lexenv @@ -206,7 +206,7 @@ (lambda (&key vars) (values sb!c:*lexenv* vars)) :eval)) - (eval-locally `(locally ,@body) lexenv vars)))) + (eval-locally `(locally ,@body) lexenv :vars vars)))) (t (if (and (symbolp name) (eq (info :function :kind name) :function)) @@ -245,6 +245,7 @@ (defun values (&rest values) #!+sb-doc "Return all arguments, in order, as values." + (declare (dynamic-extent values)) (values-list values)) (defun values-list (list)