From 8244d894b18813c3d830606da4a340ae4dcb928e Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 7 Jul 2008 11:57:04 +0300
Subject: [PATCH] implement MAKE-GENSYM, use similar logic in MAKE-GENSYM-LIST

---
 package.lisp |  1 +
 symbols.lisp | 33 +++++++++++++++++++--------------
 2 files changed, 20 insertions(+), 14 deletions(-)

diff --git a/package.lisp b/package.lisp
index 51a1bef..9379d32 100644
--- a/package.lisp
+++ b/package.lisp
@@ -120,6 +120,7 @@
    ;; Symbols
    #:ensure-symbol
    #:format-symbol
+   #:make-gensym
    #:make-gensym-list
    #:make-keyword
    ;; Strings
diff --git a/symbols.lisp b/symbols.lisp
index 9b9f916..0347548 100644
--- a/symbols.lisp
+++ b/symbols.lisp
@@ -10,14 +10,11 @@ in the package, which matches the secondary return value of INTERN.
 Example: (ENSURE-SYMBOL :CONS :CL) => CL:CONS, :EXTERNAL"
   (intern (string name) package))
 
-(defun make-formatted-symbol (package name)
-  (case package
-    ((nil)
-     (make-symbol name))
-    ((t)
-     (intern name))
-    (t
-     (intern name package))))
+(defun maybe-intern (name package)
+  (values
+   (if package
+       (intern name (if (eq t package) *package* package))
+       (make-symbol name))))
 
 (declaim (inline format-symbol))
 (defun format-symbol (package control &rest arguments)
@@ -26,18 +23,26 @@ 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."
-  (values
-   (make-formatted-symbol package (apply #'format nil control arguments))))
+  (maybe-intern (apply #'format nil control arguments) package))
 
 (defun make-keyword (name)
   "Interns the string designated by NAME in the KEYWORD package."
   (intern (string name) :keyword))
 
+(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))))
+
 (defun make-gensym-list (length &optional (x "G"))
-  "Returns a list of LENGTH gensyms, each generated with a call to
-GENSYM using (if provided) as the argument."
-  (loop repeat length
-        collect (gensym x)))
+  "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))))
 
 (defun symbolicate (&rest things)
   "Concatenate together the names of some strings and symbols,
-- 
2.11.4.GIT