cl-symbols-aux.lsp 1.53 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Thu Nov 28 06:43:51 2002
;;;; Contains: Aux. functions for cl-symbols.lsp

6

7 8 9 10 11 12 13

(declaim (optimize (safety 3)))

(defun is-external-symbol-of (sym package)
  (multiple-value-bind (sym2 status)
      (find-symbol (symbol-name sym) package)
    (and (eqt sym sym2)
sds's avatar
sds committed
14
         (eqt status :external))))
15 16 17

(defun test-if-not-in-cl-package (str)
  (multiple-value-bind (sym status)
18
      (find-symbol #+lower-case str #-lower-case (string-upcase str) 'common-lisp)
19
      (or
20 21
       ;; Symbol not present in the common lisp package as an external symbol
       (not (eqt status :external))
22 23 24
       ;; Check if it has any properties whose indicators are
       ;; external in any of the standard packages or are accessible
       ;; in CL-USER
25
       (let ((plist (symbol-plist sym)))
sds's avatar
sds committed
26 27 28 29 30 31 32 33 34 35 36
         (loop for e = plist then (cddr e)
               for indicator = (car e)
               while e
               when (and (symbolp indicator)
                         (or (is-external-symbol-of indicator
                                                    "COMMON-LISP")
                             (is-external-symbol-of indicator "KEYWORD")
                             (eqt indicator (find-symbol
                                             (symbol-name indicator)
                                             "COMMON-LISP-USER"))))
               collect indicator)))))
37 38 39 40 41 42

(defun safe-symbol-name (sym)
  (catch-type-error (symbol-name sym)))

(defun safe-make-symbol (name)
  (catch-type-error (make-symbol name)))