Changeset 14576

Timestamp:

Jan 12, 2011, 1:37:09 PM (14 years ago)

Author:

Gary Byers

Message:

Handle SETF function names in AUGMENT-ENVIRONMENT.
Fixes ticket:807.

File:

• trunk/source/compiler/nx-basic.lisp (modified) (2 diffs)

trunk/source/compiler/nx-basic.lisp

@@ -393 +393 @@
          (check-all-symbols (symlist argname pairs pairsname)
           (dolist (v symlist)
-            (unless (symbolp v) 
-              (signal-simple-program-error "Malformed ~S list: ~S is not a symbol in ~S." argname v symlist))
-            (when (assq v pairs) 
-              (signal-simple-program-error "~S ~S conflicts with ~S ~S" argname v pairsname (assq v pairs))))))
+            (if (symbolp v)
+              (when (assq v pairs) 
+                (signal-simple-program-error "~S ~S conflicts with ~S ~S" argname v pairsname (assq v pairs)))
+              (if (eq argname :function)
+                (unless (valid-function-name-p v)
+                  (signal-simple-program-error "Malformed ~S list: ~S is not a function name in ~S." argname v symlist))
+                (signal-simple-program-error "Malformed ~S list: ~S is not a symbol in ~S." argname v symlist))))))
     (check-all-pairs symbol-macro :symbol-macro)
     (check-all-pairs macro :macro)
@@ -511 +514 @@
                                 symbol-macro))
          (macros (mapcar #'(lambda (m) (list* (car m) 'macro (cadr m))) macro))
-         (functions (mapcar #'(lambda (f) (list* f 'function nil)) function))
+         (functions (mapcar #'(lambda (f) (list* (ensure-valid-function-name f) 'function nil)) function))
          (new-env (new-lexical-environment env)))
     (setf (lexenv.variables new-env) (nconc vars symbol-macros)