(eval-in-lexenv (first i) lexenv)
(return (eval-in-lexenv (first i) lexenv)))))
+(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
+ ;; written on a "let's get it to work" basis.
+ ;; These seem to be the variables that need
+ ;; bindings for PROCESS-DECLS to work
+ ;; (*FREE-FUNS* and *FREE-VARS* so that
+ ;; references to free functions and variables
+ ;; in the declarations can be noted;
+ ;; *UNDEFINED-WARNINGS* so that warnings about
+ ;; 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))
+ ;; FIXME: VALUES declaration
+ (sb!c::process-decls decls
+ vars
+ nil
+ lexenv))))
+ (eval-progn-body body lexenv))))
+
(defun eval (original-exp)
#!+sb-doc
"Evaluate the argument in a null lexical environment, returning the
(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
(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)
((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)
(when e
(eval-progn-body body lexenv)))))
((locally)
- (multiple-value-bind (body decls) (parse-body (rest exp) nil)
- (let ((lexenv
- ;; KLUDGE: Uh, yeah. I'm not anticipating
- ;; winning any prizes for this code, which was
- ;; written on a "let's get it to work" basis.
- ;; These seem to be the variables that need
- ;; bindings for PROCESS-DECLS to work
- ;; (*FREE-FUNS* and *FREE-VARS* so that
- ;; references to free functions and variables
- ;; in the declarations can be noted;
- ;; *UNDEFINED-WARNINGS* so that warnings about
- ;; 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))
- (sb!c::process-decls decls
- nil nil
- (sb!c::make-continuation)
- lexenv))))
- (eval-progn-body body lexenv))))
+ (eval-locally exp lexenv))
((macrolet)
(destructuring-bind (definitions &rest body)
(rest exp)
- ;; FIXME: shared code with
- ;; FUNCALL-IN-FOOMACROLET-LEXENV
- (declare (type list definitions))
- (unless (= (length definitions)
- (length (remove-duplicates definitions
- :key #'first)))
- (style-warn "duplicate definitions in ~S" definitions))
- (let ((lexenv
- (sb!c::make-lexenv
- :default lexenv
- :funs (mapcar
- (sb!c::macrolet-definitionize-fun
- :eval
- ;; I'm not sure that this is the
- ;; correct LEXENV to be compiling
- ;; local macros in...
- lexenv)
- definitions))))
- (eval-in-lexenv `(locally ,@body) lexenv))))
+ (let ((lexenv
+ (let ((sb!c:*lexenv* lexenv))
+ (sb!c::funcall-in-macrolet-lexenv
+ definitions
+ (lambda (&key funs)
+ (declare (ignore funs))
+ sb!c:*lexenv*)
+ :eval))))
+ (eval-locally `(locally ,@body) lexenv))))
((symbol-macrolet)
- (destructuring-bind (definitions &rest body)
- (rest exp)
- ;; FIXME: shared code with
- ;; FUNCALL-IN-FOOMACROLET-LEXENV
- (declare (type list definitions))
- (unless (= (length definitions)
- (length (remove-duplicates definitions
- :key #'first)))
- (style-warn "duplicate definitions in ~S" definitions))
- (let ((lexenv
- (sb!c::make-lexenv
- :default lexenv
- :vars (mapcar
- (sb!c::symbol-macrolet-definitionize-fun
- :eval)
- definitions))))
- (eval-in-lexenv `(locally ,@body) lexenv))))
+ (destructuring-bind (definitions &rest body) (rest exp)
+ (multiple-value-bind (lexenv vars)
+ (let ((sb!c:*lexenv* lexenv))
+ (sb!c::funcall-in-symbol-macrolet-lexenv
+ definitions
+ (lambda (&key vars)
+ (values sb!c:*lexenv* vars))
+ :eval))
+ (eval-locally `(locally ,@body) lexenv :vars vars))))
(t
(if (and (symbolp name)
(eq (info :function :kind name) :function))
(collect ((args))
- (dolist (arg (rest exp))
- (args (eval-in-lexenv arg lexenv)))
- (apply (symbol-function name) (args)))
+ (dolist (arg (rest exp))
+ (args (eval-in-lexenv arg lexenv)))
+ (apply (symbol-function name) (args)))
(%eval exp lexenv))))))
(t
exp)))))
(defun values (&rest values)
#!+sb-doc
"Return all arguments, in order, as values."
+ (declare (dynamic-extent values))
(values-list values))
(defun values-list (list)
projects / sbcl.git / blobdiff