X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprimordial-extensions.lisp;h=8375ea6e444faba1caa900204605820590fcc9f9;hb=4255b37e50876702d2563f3418a44a3f5bf8a2e8;hp=e28cb0e33fdb333bb2e56b590097d21a5fbe8ece;hpb=68664fcaa607ab61bc53bce1e9795622942135a4;p=sbcl.git

diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp
index e28cb0e..8375ea6 100644
--- a/src/code/primordial-extensions.lisp
+++ b/src/code/primordial-extensions.lisp
@@ -131,22 +131,23 @@
   (let ((block-name (when env
                       (car (find-if #'car (sb!c::lexenv-blocks env))))))
     (if block-name
-        (gensym (format nil "~A[~A]" name block-name))
-        (gensym name))))
-
+        (sb!xc:gensym (format nil "~A[~A]" name block-name))
+        (sb!xc:gensym name))))
 
 ;;; Compile a version of BODY for all TYPES, and dispatch to the
 ;;; correct one based on the value of VAR. This was originally used
 ;;; only for strings, hence the name. Renaming it to something more
 ;;; generic might not be a bad idea.
 (defmacro string-dispatch ((&rest types) var &body body)
-  (let ((fun (gensym "STRING-DISPATCH-FUN-")))
+  (let ((fun (sb!xc:gensym "STRING-DISPATCH-FUN")))
     `(flet ((,fun (,var)
               ,@body))
        (declare (inline ,fun))
        (etypecase ,var
          ,@(loop for type in types
-                 collect `(,type (,fun (the ,type ,var))))))))
+                 ;; TRULY-THE allows transforms to take advantage of the type
+                 ;; information without need for constraint propagation.
+                 collect `(,type (,fun (truly-the ,type ,var))))))))
 
 ;;; Automate an idiom often found in macros:
 ;;;   (LET ((FOO (GENSYM "FOO"))
@@ -169,9 +170,16 @@
 
 ;;; Return a list of N gensyms. (This is a common suboperation in
 ;;; macros and other code-manipulating code.)
-(declaim (ftype (function (index) list) make-gensym-list))
-(defun make-gensym-list (n)
-  (loop repeat n collect (block-gensym)))
+(declaim (ftype (function (index &optional t) (values list &optional))
+                make-gensym-list))
+(defun make-gensym-list (n &optional name)
+  (case name
+    ((t)
+     (loop repeat n collect (gensym)))
+    ((nil)
+     (loop repeat n collect (block-gensym)))
+    (otherwise
+     (loop repeat n collect (gensym name)))))
 
 ;;;; miscellany
 
@@ -260,7 +268,7 @@
     dfd))
 
 ;;; Give names to elements of a numeric sequence.
-(defmacro defenum ((&key (prefix "") (suffix "") (start 0) (step 1))
+(defmacro defenum ((&key (start 0) (step 1))
                    &rest identifiers)
   (let ((results nil)
         (index 0)
@@ -268,11 +276,11 @@
         (step (eval step)))
     (dolist (id identifiers)
       (when id
-        (multiple-value-bind (root docs)
+        (multiple-value-bind (sym docs)
             (if (consp id)
                 (values (car id) (cdr id))
                 (values id nil))
-          (push `(def!constant ,(symbolicate prefix root suffix)
+          (push `(def!constant ,sym
                    ,(+ start (* step index))
                    ,@docs)
                 results)))