From 08d8ca630b134312ea4d0f6cc2a99041fb9fdaf6 Mon Sep 17 00:00:00 2001 From: gerd <gerd> Date: Sat, 8 Feb 2003 11:33:39 +0000 Subject: [PATCH] Generalized function names. * code/macros.lisp (evaluate-declaration-context): Use valid-function-name-p. --- code/macros.lisp | 83 ++++++++++++++++++++++++------------------------ 1 file changed, 41 insertions(+), 42 deletions(-) diff --git a/code/macros.lisp b/code/macros.lisp index c3243ecbd..ad7d17191 100644 --- a/code/macros.lisp +++ b/code/macros.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.86 2003/02/05 11:08:43 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.87 2003/02/08 11:33:39 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1646,48 +1646,47 @@ ;;; matches the specified context. ;;; (defun evaluate-declaration-context (context name parent) - (let* ((base (if (and (consp name) (consp (cdr name))) - (cadr name) - name)) - (package (and (symbolp base) (symbol-package base)))) - (if (atom context) - (multiple-value-bind (ignore how) - (if package - (find-symbol (symbol-name base) package) - (values nil nil)) - (declare (ignore ignore)) - (case context - (:internal (eq how :internal)) - (:external (eq how :external)) - (:uninterned (and (symbolp base) (not package))) - (:anonymous (not name)) - (:macro (eq parent 'defmacro)) - (:function (member parent '(defun labels flet function))) - (:global (member parent '(defun defmacro function))) - (:local (member parent '(labels flet))) - (t - (error "Unknown declaration context: ~S." context)))) - (case (first context) - (:or - (loop for x in (rest context) - thereis (evaluate-declaration-context x name parent))) - (:and - (loop for x in (rest context) - always (evaluate-declaration-context x name parent))) - (:not - (evaluate-declaration-context (second context) name parent)) - (:member - (member name (rest context) :test #'equal)) - (:match - (let ((name (concatenate 'string "$" (string base) "$"))) + (multiple-value-bind (valid base) + (valid-function-name-p name) + (let ((package (and valid (symbolp base) (symbol-package base)))) + (if (atom context) + (multiple-value-bind (ignore how) + (if package + (find-symbol (symbol-name base) package) + (values nil nil)) + (declare (ignore ignore)) + (case context + (:internal (eq how :internal)) + (:external (eq how :external)) + (:uninterned (and (symbolp base) (not package))) + (:anonymous (not name)) + (:macro (eq parent 'defmacro)) + (:function (member parent '(defun labels flet function))) + (:global (member parent '(defun defmacro function))) + (:local (member parent '(labels flet))) + (t + (error "Unknown declaration context: ~S." context)))) + (case (first context) + (:or (loop for x in (rest context) - thereis (search (string x) name)))) - (:package - (and package - (loop for x in (rest context) - thereis (eq (find-package (string x)) package)))) - (t - (error "Unknown declaration context: ~S." context)))))) + thereis (evaluate-declaration-context x name parent))) + (:and + (loop for x in (rest context) + always (evaluate-declaration-context x name parent))) + (:not + (evaluate-declaration-context (second context) name parent)) + (:member + (member name (rest context) :test #'equal)) + (:match + (let ((name (concatenate 'string "$" (string base) "$"))) + (loop for x in (rest context) + thereis (search (string x) name)))) + (:package + (and package + (loop for x in (rest context) + thereis (eq (find-package (string x)) package)))) + (t + (error "Unknown declaration context: ~S." context))))))) ;;; PROCESS-CONTEXT-DECLARATIONS -- Internal -- GitLab