1 (in-package :alexandria
)
3 (declaim (inline ensure-symbol
))
4 (defun ensure-symbol (name &optional
(package *package
*))
5 "Returns a symbol with name designated by NAME, accessible in package
6 designated by PACKAGE. If symbol is not already accessible in PACKAGE, it is
7 interned there. Returns a secondary value reflecting the status of the symbol
8 in the package, which matches the secondary return value of INTERN.
12 (ensure-symbol :cons :cl) => cl:cons, :external
14 (intern (string name
) package
))
16 (defun maybe-intern (name package
)
19 (intern name
(if (eq t package
) *package
* package
))
22 (declaim (inline format-symbol
))
23 (defun format-symbol (package control
&rest arguments
)
24 "Constructs a string by applying ARGUMENTS to string designator
25 CONTROL as if by FORMAT, and then creates a symbol named by that
26 string. If PACKAGE is NIL, returns an uninterned symbol, if package is
27 T, returns a symbol interned in the current package, and otherwise
28 returns a symbol interned in the package designated by PACKAGE."
29 (maybe-intern (apply #'format nil
(string control
) arguments
) package
))
31 (defun make-keyword (name)
32 "Interns the string designated by NAME in the KEYWORD package."
33 (intern (string name
) :keyword
))
35 (defun make-gensym (name)
36 "If NAME is a non-negative integer, calls GENSYM using it. Otherwise NAME
37 must be a string designator, in which case calls GENSYM using the designated
38 string as the argument."
39 (gensym (if (typep name
'(integer 0))
43 (defun make-gensym-list (length &optional
(x "G"))
44 "Returns a list of LENGTH gensyms, each generated as if with a call to MAKE-GENSYM,
45 using the second (optional, defaulting to \"G\") argument."
46 (let ((g (if (typep x
'(integer 0)) x
(string x
))))
50 (defun symbolicate (&rest things
)
51 "Concatenate together the names of some strings and symbols,
52 producing a symbol in the current package."
53 (let* ((length (reduce #'+ things
54 :key
(lambda (x) (length (string x
)))))
55 (name (make-array length
:element-type
'character
)))
57 (dolist (thing things
(values (intern name
)))
58 (let* ((x (string thing
))
60 (replace name x
:start1 index
)