nil nil nil nil nil
(sb!c::lexenv-handled-conditions old-lexenv)
(sb!c::lexenv-disabled-package-locks old-lexenv)
- (sb!c::lexenv-policy old-lexenv))))
+ (sb!c::lexenv-policy old-lexenv)
+ (sb!c::lexenv-user-data old-lexenv))))
(dolist (declaration declarations)
(unless (consp declaration)
(ip-error "malformed declaration specifier ~S in ~S"
(sb!c::internal-make-lexenv
nil nil
nil nil nil nil nil nil nil
- sb!c::*policy*)))
+ sb!c::*policy*
+ nil)))
;;; Augment ENV with a special or lexical variable binding
(declaim (inline push-var))
;;; Augment ENV with a local function binding
(declaim (inline push-fun))
-(defun push-fun (name value env)
+(defun push-fun (name value calling-env body-env)
(when (fboundp name)
- (let ((sb!c:*lexenv* (env-native-lexenv env)))
+ (let ((sb!c:*lexenv* (env-native-lexenv calling-env)))
(program-assert-symbol-home-package-unlocked
:eval name "binding ~A as a local function")))
- (push (cons name value) (env-funs env))
- (push (cons name :bogus) (sb!c::lexenv-funs (env-native-lexenv env))))
+ (push (cons name value) (env-funs body-env))
+ (push (cons name :bogus) (sb!c::lexenv-funs (env-native-lexenv body-env))))
(sb!int:def!method print-object ((env env) stream)
(print-unreadable-object (env stream :type t :identity t)))
(cond
((eq type :constant)
;; Horrible place for this, but it works.
- (ip-error "Can't bind constant symbol ~S" symbol))
+ (ip-error "Can't bind constant symbol: ~S" symbol))
+ ((eq type :global)
+ ;; Ditto...
+ (ip-error "Can't bind a global variable: ~S" symbol))
((eq type :special) t)
((member symbol declared-specials :test #'eq)
t)
(defun parse-arguments (arguments lambda-list)
(multiple-value-bind (required optional rest-p rest keyword-p
keyword allow-other-keys-p aux-p aux)
- (sb!int:parse-lambda-list lambda-list)
+ (handler-bind ((style-warning #'muffle-warning))
+ (sb!int:parse-lambda-list lambda-list))
(let* ((original-arguments arguments)
(arguments-present (length arguments))
(required-length (length required))
;;; Evaluate LET*-like (sequential) bindings.
;;;
;;; Given an alist of BINDINGS, evaluate the value form of the first
-;;; binding in ENV, bind the variable to the value in ENV, and then
-;;; evaluate the next binding form. Once all binding forms have been
-;;; handled, END-ACTION is funcalled.
+;;; binding in ENV, generate an augmented environment with a binding
+;;; of the variable to the value in ENV, and then evaluate the next
+;;; binding form. Once all binding forms have been handled, END-ACTION
+;;; is funcalled with the final environment.
;;;
;;; SPECIALS is a list of variables that have a bound special declaration.
;;; These variables (and those that have been declaimed as special) are
(%eval exp env))))
(if bindings
(let* ((binding-name (car (car bindings)))
- (binding-value (cdr (car bindings))))
+ (binding-value (cdr (car bindings)))
+ (new-env (make-env :parent env)))
(if (specialp binding-name specials)
(progv
(list binding-name)
(list (maybe-eval binding-value))
;; Mark the variable as special in this environment
- (push-var binding-name *special* env)
- (eval-next-let*-binding (cdr bindings)
- specials env end-action))
+ (push-var binding-name *special* new-env)
+ (eval-next-let*-binding
+ (cdr bindings) specials new-env end-action))
(progn
- (push-var binding-name (maybe-eval binding-value) env)
- (eval-next-let*-binding (cdr bindings)
- specials env end-action))))
- (funcall end-action))))
+ (push-var binding-name (maybe-eval binding-value) new-env)
+ (eval-next-let*-binding
+ (cdr bindings) specials new-env end-action))))
+ (funcall end-action env))))
;;; Create a new environment based on OLD-ENV by adding the variable
;;; bindings in BINDINGS to it, and call FUNCTION with the new environment
;; Then deal with optionals / keywords / etc.
(eval-next-let*-binding
let*-like-binding var-specials env
- #'(lambda ()
+ #'(lambda (env)
;; And now that we have evaluated all the
;; initialization forms for the bindings, add the free
;; special declarations to the environment. To see why
(t (values (cdr binding) :variable)))
(case (sb!int:info :variable :kind symbol)
(:macro (values (macroexpand-1 symbol) :expansion))
- (:alien (let ((type (sb!int:info :variable :alien-info symbol)))
- (values (sb!alien::%heap-alien type)
- :variable)))
+ (:alien (values (sb!alien-internals:alien-value symbol) :variable))
(t (values (symbol-value symbol) :variable))))))
;;; Retrieve the function/macro binding of the symbol NAME in
;;; Return true if EXP is a lambda form.
(defun lambdap (exp)
- (case (car exp) ((lambda
- sb!int:named-lambda
- sb!kernel:instance-lambda)
- t)))
+ (case (car exp)
+ ((lambda sb!int:named-lambda) t)))
;;; Split off the declarations (and the docstring, if
;;; DOC-STRING-ALLOWED is true) from the actual forms of BODY.
;;; in the environment ENV.
(defun eval-lambda (exp env)
(case (car exp)
- ((lambda sb!kernel:instance-lambda)
+ ((lambda)
(multiple-value-bind (body documentation declarations)
(parse-lambda-headers (cddr exp) :doc-string-allowed t)
(make-interpreted-function :lambda-list (second exp)
(binding-value binding)))
bindings)
var-specials env
- #'(lambda ()
+ #'(lambda (env)
;; Now that we're done evaluating the bindings, add the
;; free special declarations. See also
;; CALL-WITH-NEW-ENV-FULL-PARSING.
(push-fun (car function-def)
;; Evaluate the function definitions in ENV.
(eval-local-function-def function-def env)
+ ;; Do package-lock checks in ENV.
+ env
;; But add the bindings to the child environment.
new-env))
(eval-progn body new-env)))))
(dolist (function-def local-functions)
(push-fun (car function-def)
(eval-local-function-def function-def env)
+ old-env
env))
;; And then add an environment for the body of the LABELS. A
;; separate environment from the one where we added the
(defun eval-in-native-environment (form lexenv)
(handler-bind
((sb!impl::eval-error
- (lambda (condition)
- (error 'interpreted-program-error
- :condition (sb!int:encapsulated-condition condition)
- :form form)))
- (sb!c:compiler-error
- (lambda (c)
- (if (boundp 'sb!c::*compiler-error-bailout*)
- ;; if we're in the compiler, delegate either to a higher
- ;; authority or, if that's us, back down to the
- ;; outermost compiler handler...
- (progn
- (signal c)
- nil)
- ;; ... if we're not in the compiler, better signal the
- ;; error straight away.
- (invoke-restart 'sb!c::signal-error)))))
- (handler-case
- (let ((env (make-env-from-native-environment lexenv)))
- (%eval form env))
- (compiler-environment-too-complex-error (condition)
- (declare (ignore condition))
- ;; FIXME: this could be a really annoying warning. It should
- ;; have its own class.
- (sb!int:style-warn
- "~@<Native lexical environment too complex for SB-EVAL ~
- to evaluate ~S, falling back to SIMPLE-EVAL-IN-LEXENV. ~
- Lexenv: ~S~:@>"
- form lexenv)
- (sb!int:simple-eval-in-lexenv form lexenv)))))
+ (lambda (condition)
+ (error 'interpreted-program-error
+ :condition (sb!int:encapsulated-condition condition)
+ :form form))))
+ (sb!c:with-compiler-error-resignalling
+ (handler-case
+ (let ((env (make-env-from-native-environment lexenv)))
+ (%eval form env))
+ (compiler-environment-too-complex-error (condition)
+ (declare (ignore condition))
+ (sb!int:style-warn 'sb!kernel:lexical-environment-too-complex
+ :form form :lexenv lexenv)
+ (sb!int:simple-eval-in-lexenv form lexenv))))))