Skip to content
Snippets Groups Projects
Commit 74181d56 authored by ram's avatar ram
Browse files

Added :PACKAGE constext declaration.

parent cf3b742f
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.23 1991/05/08 23:54:08 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.24 1991/05/24 16:58:02 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -1447,27 +1447,27 @@ ...@@ -1447,27 +1447,27 @@
;;; matches the specified context. ;;; matches the specified context.
;;; ;;;
(defun evaluate-declaration-context (context name parent) (defun evaluate-declaration-context (context name parent)
(let ((base (if (and (consp name) (consp (cdr name))) (let* ((base (if (and (consp name) (consp (cdr name)))
(cadr name) (cadr name)
name))) name))
(package (and (symbolp base) (symbol-package base))))
(if (atom context) (if (atom context)
(let ((package (and (symbolp base) (symbol-package base)))) (multiple-value-bind (ignore how)
(multiple-value-bind (ignore how) (if package
(if package (find-symbol (symbol-name base) package)
(find-symbol (symbol-name base) package) (values nil nil))
(values nil nil)) (declare (ignore ignore))
(declare (ignore ignore)) (case context
(case context (:internal (eq how :internal))
(:internal (eq how :internal)) (:external (eq how :external))
(:external (eq how :external)) (:uninterned (and (symbolp base) (not package)))
(:uninterned (and (symbolp base) (not package))) (:anonymous (not name))
(:anonymous (not name)) (:macro (eq parent 'defmacro))
(:macro (eq parent 'defmacro)) (:function (member parent '(defun labels flet function)))
(:function (member parent '(defun labels flet function))) (:global (member parent '(defun defmacro function)))
(:global (member parent '(defun defmacro function))) (:local (member parent '(labels flet)))
(:local (member parent '(labels flet))) (t
(t (error "Unknown declaration context: ~S." context))))
(error "Unknown declaration context: ~S." context)))))
(case (first context) (case (first context)
(:or (:or
(loop for x in (rest context) (loop for x in (rest context)
...@@ -1483,6 +1483,10 @@ ...@@ -1483,6 +1483,10 @@
(let ((name (concatenate 'string "$" (string base) "$"))) (let ((name (concatenate 'string "$" (string base) "$")))
(loop for x in (rest context) (loop for x in (rest context)
thereis (search (string x) name)))) thereis (search (string x) name))))
(:package
(and package
(loop for x in (rest context)
thereis (eq (find-package (string x)) package))))
(t (t
(error "Unknown declaration context: ~S." context)))))) (error "Unknown declaration context: ~S." context))))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment