Changeset 15335

Timestamp:

Apr 19, 2012, 5:15:11 AM (13 years ago)

Author:

Gary Byers

Message:

Error on attempts to lexically bind special-operators.
Quietly allow local functions to shadow standard/builtin definitions if their
names are declared NOTINLINE in the enclosing environment.
Use NX1-CHECK-LOCAL-FUNCTION-BINDING to do what that function's name implies.
Make MACROLET handle SETF names, check local function bindings ...

File:

• trunk/source/compiler/nx1.lisp (modified) (5 diffs)

trunk/source/compiler/nx1.lisp

@@ -203 +203 @@
                     (setq args (cdr args)))))))
 
+(defun nx1-check-local-function-binding (funcname env)
+  (if (and (symbolp funcname) (special-operator-p funcname))
+    (nx-error "Can't lexically bind special operator ~s." funcname)
+    (unless (nx-declared-notinline-p funcname env)
+      (or (maybe-warn-about-shadowing-cl-function-name funcname)
+          (when (and (symbolp funcname)
+                     (gethash funcname *nx1-alphatizers*))
+            (nx1-whine :special-fbinding funcname))))))
+
 ;;; New semantics: expansion functions are defined in current lexical environment
 ;;; vice null environment.  May be meaningless ...
@@ -211 +220 @@
     (dolist (def defs)
       (destructuring-bind (name arglist &body mbody) def
+        (setq name (nx-need-function-name name))
         (push name names)
+        (nx1-check-local-function-binding name old-env)
         (push 
          (cons 
@@ -1788 +1799 @@
     t))
 
-(defun maybe-warn-about-nx1-alphatizer-binding (funcname)
-  (or (maybe-warn-about-shadowing-cl-function-name funcname)
-      (when (and (symbolp funcname)
-                 (gethash funcname *nx1-alphatizers*))
-        (nx1-whine :special-fbinding funcname))))
+
 
 
@@ -1814 +1821 @@
             (setq fname (nx-need-function-name funcname))
             (push fname fnames)
-            (maybe-warn-about-nx1-alphatizer-binding funcname)
+            (nx1-check-local-function-binding funcname env)
             (multiple-value-bind (body decls)
                                  (parse-body flet-function-body env)
@@ -1900 +1907 @@
         (dolist (def defs (setq funcs (nreverse funcs) bodies (nreverse bodies)))
           (destructuring-bind (funcname lambda-list &body labels-function-body) def
-            (maybe-warn-about-nx1-alphatizer-binding funcname)
+            (nx1-check-local-function-binding funcname env)
             (push (setq func (make-afunc)) funcs)
             (setq blockname funcname)