symbols.lisp 2.44 KB
Newer Older
Nikodemus Siivola's avatar
Nikodemus Siivola committed
1 2
(in-package :alexandria)

3
(declaim (inline ensure-symbol))
Nikodemus Siivola's avatar
Nikodemus Siivola committed
4 5 6
(defun ensure-symbol (name &optional (package *package*))
  "Returns a symbol with name designated by NAME, accessible in package
designated by PACKAGE. If symbol is not already accessible in PACKAGE, it is
7 8
interned there. Returns a secondary value reflecting the status of the symbol
in the package, which matches the secondary return value of INTERN.
Nikodemus Siivola's avatar
Nikodemus Siivola committed
9

10 11 12 13
Example:

  (ensure-symbol :cons :cl) => cl:cons, :external
"
14
  (intern (string name) package))
Nikodemus Siivola's avatar
Nikodemus Siivola committed
15

16 17 18 19 20
(defun maybe-intern (name package)
  (values
   (if package
       (intern name (if (eq t package) *package* package))
       (make-symbol name))))
Nikodemus Siivola's avatar
Nikodemus Siivola committed
21 22 23

(declaim (inline format-symbol))
(defun format-symbol (package control &rest arguments)
24 25 26 27 28 29 30 31 32 33
  "Constructs a string by applying ARGUMENTS to string designator CONTROL as
if by FORMAT within WITH-STANDARD-IO-SYNTAX, and then creates a symbol named
by that string.

If PACKAGE is NIL, returns an uninterned symbol, if package is T, returns a
symbol interned in the current package, and otherwise returns a symbol
interned in the package designated by PACKAGE."
  (maybe-intern (with-standard-io-syntax
                  (apply #'format nil (string control) arguments))
                package))
Nikodemus Siivola's avatar
Nikodemus Siivola committed
34 35 36 37 38

(defun make-keyword (name)
  "Interns the string designated by NAME in the KEYWORD package."
  (intern (string name) :keyword))

39 40 41 42 43 44 45 46
(defun make-gensym (name)
  "If NAME is a non-negative integer, calls GENSYM using it. Otherwise NAME
must be a string designator, in which case calls GENSYM using the designated
string as the argument."
  (gensym (if (typep name '(integer 0))
              name
              (string name))))

47
(defun make-gensym-list (length &optional (x "G"))
48 49 50 51 52
  "Returns a list of LENGTH gensyms, each generated as if with a call to MAKE-GENSYM,
using the second (optional, defaulting to \"G\") argument."
  (let ((g (if (typep x '(integer 0)) x (string x))))
    (loop repeat length
          collect (gensym g))))
Attila Lendvai's avatar
Attila Lendvai committed
53 54 55 56 57 58 59 60 61 62 63 64 65

(defun symbolicate (&rest things)
  "Concatenate together the names of some strings and symbols,
producing a symbol in the current package."
  (let* ((length (reduce #'+ things
                         :key (lambda (x) (length (string x)))))
         (name (make-array length :element-type 'character)))
    (let ((index 0))
      (dolist (thing things (values (intern name)))
        (let* ((x (string thing))
               (len (length x)))
          (replace name x :start1 index)
          (incf index len))))))