X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Ffull-eval.lisp;h=08af2682b5400462c95b3803a37a2d7cffbbfd0c;hb=09a00b3120e7dd6d040cf70fbaaa1af32b890ee3;hp=c93a320e0194b6db18509ced3102ab617682b21c;hpb=5d04a95274c9ddaebbcd6ddffc5d646e2c25598c;p=sbcl.git

diff --git a/src/code/full-eval.lisp b/src/code/full-eval.lisp
index c93a320..08af268 100644
--- a/src/code/full-eval.lisp
+++ b/src/code/full-eval.lisp
@@ -104,7 +104,8 @@
                    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"
@@ -175,7 +176,8 @@
              (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))
@@ -185,13 +187,13 @@
 
 ;;; 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)))
@@ -236,7 +238,10 @@
     (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)
@@ -279,7 +284,8 @@
 (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))
@@ -516,9 +522,7 @@
           (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
@@ -538,10 +542,8 @@
 
 ;;; 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.
@@ -571,7 +573,7 @@
 ;;; 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)
@@ -681,6 +683,8 @@
           (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)))))
@@ -697,6 +701,7 @@
         (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