/[cmucl]/src/code/macros.lisp
ViewVC logotype

Diff of /src/code/macros.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.23 by ram, Wed May 8 23:54:08 1991 UTC revision 1.24 by ram, Fri May 24 16:58:02 1991 UTC
# Line 1447  Line 1447 
1447  ;;; matches the specified context.  ;;; matches the specified context.
1448  ;;;  ;;;
1449  (defun evaluate-declaration-context (context name parent)  (defun evaluate-declaration-context (context name parent)
1450    (let ((base (if (and (consp name) (consp (cdr name)))    (let* ((base (if (and (consp name) (consp (cdr name)))
1451                    (cadr name)                     (cadr name)
1452                    name)))                     name))
1453             (package (and (symbolp base) (symbol-package base))))
1454      (if (atom context)      (if (atom context)
1455          (let ((package (and (symbolp base) (symbol-package base))))          (multiple-value-bind (ignore how)
1456            (multiple-value-bind (ignore how)                               (if package
1457                                 (if package                                   (find-symbol (symbol-name base) package)
1458                                     (find-symbol (symbol-name base) package)                                   (values nil nil))
1459                                     (values nil nil))            (declare (ignore ignore))
1460              (declare (ignore ignore))            (case context
1461              (case context              (:internal (eq how :internal))
1462                (:internal (eq how :internal))              (:external (eq how :external))
1463                (:external (eq how :external))              (:uninterned (and (symbolp base) (not package)))
1464                (:uninterned (and (symbolp base) (not package)))              (:anonymous (not name))
1465                (:anonymous (not name))              (:macro (eq parent 'defmacro))
1466                (:macro (eq parent 'defmacro))              (:function (member parent '(defun labels flet function)))
1467                (:function (member parent '(defun labels flet function)))              (:global (member parent '(defun defmacro function)))
1468                (:global (member parent '(defun defmacro function)))              (:local (member parent '(labels flet)))
1469                (:local (member parent '(labels flet)))              (t
1470                (t               (error "Unknown declaration context: ~S." context))))
                (error "Unknown declaration context: ~S." context)))))  
1471          (case (first context)          (case (first context)
1472            (:or            (:or
1473             (loop for x in (rest context)             (loop for x in (rest context)
# Line 1483  Line 1483 
1483             (let ((name (concatenate 'string "$" (string base) "$")))             (let ((name (concatenate 'string "$" (string base) "$")))
1484               (loop for x in (rest context)               (loop for x in (rest context)
1485                 thereis (search (string x) name))))                 thereis (search (string x) name))))
1486              (:package
1487               (and package
1488                    (loop for x in (rest context)
1489                      thereis (eq (find-package (string x)) package))))
1490            (t            (t
1491             (error "Unknown declaration context: ~S." context))))))             (error "Unknown declaration context: ~S." context))))))
1492    

Legend:
Removed from v.1.23  
changed lines
  Added in v.1.24

  ViewVC Help
Powered by ViewVC 1.1.5