symbols.lisp - clic - Clic is an command line interactive client for gopher wri… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
symbols.lisp (2497B) | |
--- | |
1 (in-package :alexandria) | |
2 | |
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, i… | |
7 interned there. Returns a secondary value reflecting the status of the s… | |
8 in the package, which matches the secondary return value of INTERN. | |
9 | |
10 Example: | |
11 | |
12 (ensure-symbol :cons :cl) => cl:cons, :external | |
13 " | |
14 (intern (string name) package)) | |
15 | |
16 (defun maybe-intern (name package) | |
17 (values | |
18 (if package | |
19 (intern name (if (eq t package) *package* package)) | |
20 (make-symbol name)))) | |
21 | |
22 (declaim (inline format-symbol)) | |
23 (defun format-symbol (package control &rest arguments) | |
24 "Constructs a string by applying ARGUMENTS to string designator CONTRO… | |
25 if by FORMAT within WITH-STANDARD-IO-SYNTAX, and then creates a symbol n… | |
26 by that string. | |
27 | |
28 If PACKAGE is NIL, returns an uninterned symbol, if package is T, return… | |
29 symbol interned in the current package, and otherwise returns a symbol | |
30 interned in the package designated by PACKAGE." | |
31 (maybe-intern (with-standard-io-syntax | |
32 (apply #'format nil (string control) arguments)) | |
33 package)) | |
34 | |
35 (defun make-keyword (name) | |
36 "Interns the string designated by NAME in the KEYWORD package." | |
37 (intern (string name) :keyword)) | |
38 | |
39 (defun make-gensym (name) | |
40 "If NAME is a non-negative integer, calls GENSYM using it. Otherwise N… | |
41 must be a string designator, in which case calls GENSYM using the design… | |
42 string as the argument." | |
43 (gensym (if (typep name '(integer 0)) | |
44 name | |
45 (string name)))) | |
46 | |
47 (defun make-gensym-list (length &optional (x "G")) | |
48 "Returns a list of LENGTH gensyms, each generated as if with a call to… | |
49 using the second (optional, defaulting to \"G\") argument." | |
50 (let ((g (if (typep x '(integer 0)) x (string x)))) | |
51 (loop repeat length | |
52 collect (gensym g)))) | |
53 | |
54 (defun symbolicate (&rest things) | |
55 "Concatenate together the names of some strings and symbols, | |
56 producing a symbol in the current package." | |
57 (let* ((length (reduce #'+ things | |
58 :key (lambda (x) (length (string x))))) | |
59 (name (make-array length :element-type 'character))) | |
60 (let ((index 0)) | |
61 (dolist (thing things (values (intern name))) | |
62 (let* ((x (string thing)) | |
63 (len (length x))) | |
64 (replace name x :start1 index) | |
65 (incf index len)))))) |