X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Feval.lisp;h=9bd74e2563b5e5c1535389eb0cb6ede9b49bd3e4;hb=b2ad48f269cd6b9403820588d65eac526e4e32fd;hp=2b9f4000db84cf009782537cae5b3c8e3692bd60;hpb=28ce7a00cbce6d27b127fd6a2783325c8198a568;p=sbcl.git diff --git a/src/code/eval.lisp b/src/code/eval.lisp index 2b9f400..9bd74e2 100644 --- a/src/code/eval.lisp +++ b/src/code/eval.lisp @@ -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,10 +62,10 @@ ;; 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 @@ -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)