X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Feval.lisp;h=b33ca523492a03d9cb1c48842ee869b5c0106047;hb=35697e2c02e7b29f7953ae318d50305561927a16;hp=d77f90f2bef886042eae3a653a83aa55f3c0f3a8;hpb=c41cb4c87eae7b04f844dca5f7edb5086c5d2d68;p=sbcl.git diff --git a/src/code/eval.lisp b/src/code/eval.lisp index d77f90f..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,7 +46,7 @@ (eval-in-lexenv (first i) lexenv) (return (eval-in-lexenv (first i) lexenv))))) -(defun eval-locally (exp lexenv &optional vars) +(defun eval-locally (exp lexenv &key vars) (multiple-value-bind (body decls) (parse-body (rest exp) :doc-string-allowed nil) (let ((lexenv @@ -62,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 - lexenv)))) + :lexenv lexenv)))) (eval-progn-body body lexenv)))) (defun eval (original-exp) @@ -94,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 @@ -128,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) @@ -144,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) @@ -188,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 @@ -198,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 @@ -207,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)) @@ -246,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)