Use make-symbol rather than gensym.

(loop, cl-parse-loop-clause, defsetf): Use backquote.

1 files changed, 219 insertions, 225 deletions

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 286c7632ed8..4bd3c966819 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -292,7 +292,7 @@ ARGLIST allows full Common Lisp conventions."
           (laterarg nil) (exactarg nil) minarg)
       (or num (setq num 0))
       (if (listp (cadr restarg))
-          (setq restarg (gensym "--rest--"))
+          (setq restarg (make-symbol "--cl-rest--"))
         (setq restarg (cadr restarg)))
       (push (list restarg expr) bind-lets)
       (if (eq (car args) '&whole)
@@ -354,7 +354,7 @@ ARGLIST allows full Common Lisp conventions."
                    (look (list 'memq (list 'quote karg) restarg)))
               (and def bind-enquote (setq def (list 'quote def)))
               (if (cddr arg)
-                  (let* ((temp (or (nth 2 arg) (gensym)))
+                  (let* ((temp (or (nth 2 arg) (make-symbol "--cl-var--")))
                          (val (list 'car (list 'cdr temp))))
                     (cl-do-arglist temp look)
                     (cl-do-arglist varg
@@ -377,7 +377,7 @@ ARGLIST allows full Common Lisp conventions."
       (setq keys (nreverse keys))
       (or (and (eq (car args) '&allow-other-keys) (pop args))
           (null keys) (= safety 0)
-          (let* ((var (gensym "--keys--"))
+          (let* ((var (make-symbol "--cl-keys--"))
                  (allow '(:allow-other-keys))
                  (check (list
                          'while var
@@ -494,7 +494,7 @@ If no clause succeeds, case returns nil.  A single atom may be used in
 place of a KEYLIST of one atom.  A KEYLIST of t or `otherwise' is
 allowed only in the final clause, and matches if no other keys match.
 Key values are compared by `eql'."
-  (let* ((temp (if (cl-simple-expr-p expr 3) expr (gensym)))
+  (let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
          (head-list nil)
          (body (cons
                 'cond
@@ -530,7 +530,7 @@ Each clause looks like (TYPE BODY...).  EXPR is evaluated and, if it
 satisfies TYPE, the corresponding BODY is evaluated.  If no clause succeeds,
 typecase returns nil.  A TYPE of t or `otherwise' is allowed only in the
 final clause, and matches if no other keys match."
-  (let* ((temp (if (cl-simple-expr-p expr 3) expr (gensym)))
+  (let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
          (type-list nil)
          (body (cons
                 'cond
@@ -644,10 +644,10 @@ Valid clauses are:
       (setq args (append args '(cl-end-loop)))
       (while (not (eq (car args) 'cl-end-loop)) (cl-parse-loop-clause))
       (if loop-finish-flag
-          (push (list (list loop-finish-flag t)) loop-bindings))
+          (push `((,loop-finish-flag t)) loop-bindings))
       (if loop-first-flag
-          (progn (push (list (list loop-first-flag t)) loop-bindings)
-                 (push (list 'setq loop-first-flag nil) loop-steps)))
+          (progn (push `((,loop-first-flag t)) loop-bindings)
+                 (push `(setq ,loop-first-flag nil) loop-steps)))
       (let* ((epilogue (nconc (nreverse loop-finally)
                               (list (or loop-result-explicit loop-result))))
              (ands (cl-loop-build-ands (nreverse loop-body)))
@@ -658,16 +658,16 @@ Valid clauses are:
                               (list 'block '--cl-finish--
                                     (subst
                                      (if (eq (car ands) t) while-body
-                                       (cons (list 'or (car ands)
-                                                   '(return-from --cl-finish--
-                                                      nil))
+                                       (cons `(or ,(car ands)
+                                                  (return-from --cl-finish--
+                                                    nil))
                                              while-body))
                                      '--cl-map loop-map-form))
                             (list* 'while (car ands) while-body)))
                     (if loop-finish-flag
                         (if (equal epilogue '(nil)) (list loop-result-var)
-                          (list (list 'if loop-finish-flag
-                                      (cons 'progn epilogue) loop-result-var)))
+                          `((if ,loop-finish-flag
+                                (progn ,@epilogue) ,loop-result-var)))
                       epilogue))))
         (if loop-result-var (push (list loop-result-var) loop-bindings))
         (while loop-bindings
@@ -682,7 +682,7 @@ Valid clauses are:
             (setq body (list (list* 'symbol-macrolet loop-symbol-macs body))))
         (list* 'block loop-name body)))))
 
-(defun cl-parse-loop-clause ()   ; uses args, loop-*
+(defun cl-parse-loop-clause ()          ; uses args, loop-*
   (let ((word (pop args))
         (hash-types '(hash-key hash-keys hash-value hash-values))
         (key-types '(key-code key-codes key-seq key-seqs
@@ -715,7 +715,7 @@ Valid clauses are:
       (let ((loop-for-bindings nil) (loop-for-sets nil) (loop-for-steps nil)
             (ands nil))
         (while
-            (let ((var (or (pop args) (gensym))))
+            (let ((var (or (pop args) (make-symbol "--cl-var--"))))
               (setq word (pop args))
               (if (eq word 'being) (setq word (pop args)))
               (if (memq word '(the each)) (setq word (pop args)))
@@ -738,26 +738,28 @@ Valid clauses are:
                                        '(to upto downto above below))
                                  (cl-pop2 args)))
                        (step (and (eq (car args) 'by) (cl-pop2 args)))
-                       (end-var (and (not (cl-const-expr-p end)) (gensym)))
+                       (end-var (and (not (cl-const-expr-p end))
+                                     (make-symbol "--cl-var--")))
                        (step-var (and (not (cl-const-expr-p step))
-                                      (gensym))))
+                                      (make-symbol "--cl-var--"))))
                   (and step (numberp step) (<= step 0)
                        (error "Loop `by' value is not positive: %s" step))
                   (push (list var (or start 0)) loop-for-bindings)
                   (if end-var (push (list end-var end) loop-for-bindings))
                   (if step-var (push (list step-var step)
-                                        loop-for-bindings))
+                                     loop-for-bindings))
                   (if end
                       (push (list
-                                (if down (if excl '> '>=) (if excl '< '<=))
-                                var (or end-var end)) loop-body))
+                             (if down (if excl '> '>=) (if excl '< '<=))
+                             var (or end-var end)) loop-body))
                   (push (list var (list (if down '- '+) var
-                                           (or step-var step 1)))
-                           loop-for-steps)))
+                                        (or step-var step 1)))
+                        loop-for-steps)))
 
                ((memq word '(in in-ref on))
                 (let* ((on (eq word 'on))
-                       (temp (if (and on (symbolp var)) var (gensym))))
+                       (temp (if (and on (symbolp var))
+                                 var (make-symbol "--cl-var--"))))
                   (push (list temp (pop args)) loop-for-bindings)
                   (push (list 'consp temp) loop-body)
                   (if (eq word 'in-ref)
@@ -766,18 +768,18 @@ Valid clauses are:
                         (progn
                           (push (list var nil) loop-for-bindings)
                           (push (list var (if on temp (list 'car temp)))
-                                   loop-for-sets))))
+                                loop-for-sets))))
                   (push (list temp
-                                 (if (eq (car args) 'by)
-                                     (let ((step (cl-pop2 args)))
-                                       (if (and (memq (car-safe step)
-                                                      '(quote function
-                                                              function*))
-                                                (symbolp (nth 1 step)))
-                                           (list (nth 1 step) temp)
-                                         (list 'funcall step temp)))
-                                   (list 'cdr temp)))
-                           loop-for-steps)))
+                              (if (eq (car args) 'by)
+                                  (let ((step (cl-pop2 args)))
+                                    (if (and (memq (car-safe step)
+                                                   '(quote function
+                                                           function*))
+                                             (symbolp (nth 1 step)))
+                                        (list (nth 1 step) temp)
+                                      (list 'funcall step temp)))
+                                (list 'cdr temp)))
+                        loop-for-steps)))
 
                ((eq word '=)
                 (let* ((start (pop args))
@@ -785,68 +787,68 @@ Valid clauses are:
                   (push (list var nil) loop-for-bindings)
                   (if (or ands (eq (car args) 'and))
                       (progn
-                        (push (list var
-                                       (list 'if
-                                             (or loop-first-flag
-                                                 (setq loop-first-flag
-                                                       (gensym)))
-                                             start var))
-                                 loop-for-sets)
+                        (push `(,var
+                                (if ,(or loop-first-flag
+                                         (setq loop-first-flag
+                                               (make-symbol "--cl-var--")))
+                                    ,start ,var))
+                              loop-for-sets)
                         (push (list var then) loop-for-steps))
                     (push (list var
-                                   (if (eq start then) start
-                                     (list 'if
-                                           (or loop-first-flag
-                                               (setq loop-first-flag (gensym)))
-                                           start then)))
-                             loop-for-sets))))
+                                (if (eq start then) start
+                                  `(if ,(or loop-first-flag
+                                            (setq loop-first-flag
+                                                  (make-symbol "--cl-var--")))
+                                       ,start ,then)))
+                          loop-for-sets))))
 
                ((memq word '(across across-ref))
-                (let ((temp-vec (gensym)) (temp-idx (gensym)))
+                (let ((temp-vec (make-symbol "--cl-vec--"))
+                      (temp-idx (make-symbol "--cl-idx--")))
                   (push (list temp-vec (pop args)) loop-for-bindings)
                   (push (list temp-idx -1) loop-for-bindings)
                   (push (list '< (list 'setq temp-idx (list '1+ temp-idx))
-                                 (list 'length temp-vec)) loop-body)
+                              (list 'length temp-vec)) loop-body)
                   (if (eq word 'across-ref)
                       (push (list var (list 'aref temp-vec temp-idx))
-                               loop-symbol-macs)
+                            loop-symbol-macs)
                     (push (list var nil) loop-for-bindings)
                     (push (list var (list 'aref temp-vec temp-idx))
-                             loop-for-sets))))
+                          loop-for-sets))))
 
                ((memq word '(element elements))
                 (let ((ref (or (memq (car args) '(in-ref of-ref))
                                (and (not (memq (car args) '(in of)))
                                     (error "Expected `of'"))))
                       (seq (cl-pop2 args))
-                      (temp-seq (gensym))
+                      (temp-seq (make-symbol "--cl-seq--"))
                       (temp-idx (if (eq (car args) 'using)
                                     (if (and (= (length (cadr args)) 2)
                                              (eq (caadr args) 'index))
                                         (cadr (cl-pop2 args))
                                       (error "Bad `using' clause"))
-                                  (gensym))))
+                                  (make-symbol "--cl-idx--"))))
                   (push (list temp-seq seq) loop-for-bindings)
                   (push (list temp-idx 0) loop-for-bindings)
                   (if ref
-                      (let ((temp-len (gensym)))
+                      (let ((temp-len (make-symbol "--cl-len--")))
                         (push (list temp-len (list 'length temp-seq))
-                                 loop-for-bindings)
+                              loop-for-bindings)
                         (push (list var (list 'elt temp-seq temp-idx))
-                                 loop-symbol-macs)
+                              loop-symbol-macs)
                         (push (list '< temp-idx temp-len) loop-body))
                     (push (list var nil) loop-for-bindings)
                     (push (list 'and temp-seq
-                                   (list 'or (list 'consp temp-seq)
-                                         (list '< temp-idx
-                                               (list 'length temp-seq))))
-                             loop-body)
+                                (list 'or (list 'consp temp-seq)
+                                      (list '< temp-idx
+                                            (list 'length temp-seq))))
+                          loop-body)
                     (push (list var (list 'if (list 'consp temp-seq)
-                                             (list 'pop temp-seq)
-                                             (list 'aref temp-seq temp-idx)))
-                             loop-for-sets))
+                                          (list 'pop temp-seq)
+                                          (list 'aref temp-seq temp-idx)))
+                          loop-for-sets))
                   (push (list temp-idx (list '1+ temp-idx))
-                           loop-for-steps)))
+                        loop-for-steps)))
 
                ((memq word hash-types)
                 (or (memq (car args) '(in of)) (error "Expected `of'"))
@@ -857,21 +859,17 @@ Valid clauses are:
                                            (not (eq (caadr args) word)))
                                       (cadr (cl-pop2 args))
                                     (error "Bad `using' clause"))
-                                (gensym))))
+                                (make-symbol "--cl-var--"))))
                   (if (memq word '(hash-value hash-values))
                       (setq var (prog1 other (setq other var))))
                   (setq loop-map-form
-                        (list 'maphash (list 'function
-                                             (list* 'lambda (list var other)
-                                                    '--cl-map)) table))))
+                        `(maphash (lambda (,var ,other) . --cl-map) ,table))))
 
                ((memq word '(symbol present-symbol external-symbol
                              symbols present-symbols external-symbols))
                 (let ((ob (and (memq (car args) '(in of)) (cl-pop2 args))))
                   (setq loop-map-form
-                        (list 'mapatoms (list 'function
-                                              (list* 'lambda (list var)
-                                                     '--cl-map)) ob))))
+                        `(mapatoms (lambda (,var) . --cl-map) ,ob))))
 
                ((memq word '(overlay overlays extent extents))
                 (let ((buf nil) (from nil) (to nil))
@@ -880,14 +878,15 @@ Valid clauses are:
                           ((eq (car args) 'to) (setq to (cl-pop2 args)))
                           (t (setq buf (cl-pop2 args)))))
                   (setq loop-map-form
-                        (list 'cl-map-extents
-                              (list 'function (list 'lambda (list var (gensym))
-                                                    '(progn . --cl-map) nil))
-                              buf from to))))
+                        `(cl-map-extents
+                          (lambda (,var ,(make-symbol "--cl-var--"))
+                            (progn . --cl-map) nil)
+                          ,buf ,from ,to))))
 
                ((memq word '(interval intervals))
                 (let ((buf nil) (prop nil) (from nil) (to nil)
-                      (var1 (gensym)) (var2 (gensym)))
+                      (var1 (make-symbol "--cl-var1--"))
+                      (var2 (make-symbol "--cl-var2--")))
                   (while (memq (car args) '(in of property from to))
                     (cond ((eq (car args) 'from) (setq from (cl-pop2 args)))
                           ((eq (car args) 'to) (setq to (cl-pop2 args)))
@@ -898,10 +897,9 @@ Valid clauses are:
                       (setq var1 (car var) var2 (cdr var))
                     (push (list var (list 'cons var1 var2)) loop-for-sets))
                   (setq loop-map-form
-                        (list 'cl-map-intervals
-                              (list 'function (list 'lambda (list var1 var2)
-                                                    '(progn . --cl-map)))
-                              buf prop from to))))
+                        `(cl-map-intervals
+                          (lambda (,var1 ,var2) . --cl-map)
+                          ,buf ,prop ,from ,to))))
 
                ((memq word key-types)
                 (or (memq (car args) '(in of)) (error "Expected `of'"))
@@ -912,37 +910,36 @@ Valid clauses are:
                                           (not (eq (caadr args) word)))
                                      (cadr (cl-pop2 args))
                                    (error "Bad `using' clause"))
-                               (gensym))))
+                               (make-symbol "--cl-var--"))))
                   (if (memq word '(key-binding key-bindings))
                       (setq var (prog1 other (setq other var))))
                   (setq loop-map-form
-                        (list (if (memq word '(key-seq key-seqs))
-                                  'cl-map-keymap-recursively 'map-keymap)
-                              (list 'function (list* 'lambda (list var other)
-                                                     '--cl-map)) map))))
+                        `(,(if (memq word '(key-seq key-seqs))
+                               'cl-map-keymap-recursively 'map-keymap)
+                          (lambda (,var ,other) . --cl-map) ,map))))
 
                ((memq word '(frame frames screen screens))
-                (let ((temp (gensym)))
+                (let ((temp (make-symbol "--cl-var--")))
                   (push (list var  '(selected-frame))
-                           loop-for-bindings)
+                        loop-for-bindings)
                   (push (list temp nil) loop-for-bindings)
                   (push (list 'prog1 (list 'not (list 'eq var temp))
-                                 (list 'or temp (list 'setq temp var)))
-                           loop-body)
+                              (list 'or temp (list 'setq temp var)))
+                        loop-body)
                   (push (list var (list 'next-frame var))
-                           loop-for-steps)))
+                        loop-for-steps)))
 
                ((memq word '(window windows))
                 (let ((scr (and (memq (car args) '(in of)) (cl-pop2 args)))
-                      (temp (gensym)))
+                      (temp (make-symbol "--cl-var--")))
                   (push (list var (if scr
-                                         (list 'frame-selected-window scr)
-                                       '(selected-window)))
-                           loop-for-bindings)
+                                      (list 'frame-selected-window scr)
+                                    '(selected-window)))
+                        loop-for-bindings)
                   (push (list temp nil) loop-for-bindings)
                   (push (list 'prog1 (list 'not (list 'eq var temp))
-                                 (list 'or temp (list 'setq temp var)))
-                           loop-body)
+                              (list 'or temp (list 'setq temp var)))
+                        loop-body)
                   (push (list var (list 'next-window var)) loop-for-steps)))
 
                (t
@@ -960,15 +957,15 @@ Valid clauses are:
                                      loop-bindings)))
         (if loop-for-sets
             (push (list 'progn
-                           (cl-loop-let (nreverse loop-for-sets) 'setq ands)
-                           t) loop-body))
+                        (cl-loop-let (nreverse loop-for-sets) 'setq ands)
+                        t) loop-body))
         (if loop-for-steps
             (push (cons (if ands 'psetq 'setq)
-                           (apply 'append (nreverse loop-for-steps)))
-                     loop-steps))))
+                        (apply 'append (nreverse loop-for-steps)))
+                  loop-steps))))
 
      ((eq word 'repeat)
-      (let ((temp (gensym)))
+      (let ((temp (make-symbol "--cl-var--")))
         (push (list (list temp (pop args))) loop-bindings)
         (push (list '>= (list 'setq temp (list '1- temp)) 0) loop-body)))
 
@@ -978,23 +975,23 @@ Valid clauses are:
         (if (eq var loop-accum-var)
             (push (list 'progn (list 'push what var) t) loop-body)
           (push (list 'progn
-                         (list 'setq var (list 'nconc var (list 'list what)))
-                         t) loop-body))))
+                      (list 'setq var (list 'nconc var (list 'list what)))
+                      t) loop-body))))
 
      ((memq word '(nconc nconcing append appending))
       (let ((what (pop args))
             (var (cl-loop-handle-accum nil 'nreverse)))
         (push (list 'progn
-                       (list 'setq var
-                             (if (eq var loop-accum-var)
-                                 (list 'nconc
-                                       (list (if (memq word '(nconc nconcing))
-                                                 'nreverse 'reverse)
-                                             what)
-                                       var)
-                               (list (if (memq word '(nconc nconcing))
-                                         'nconc 'append)
-                                     var what))) t) loop-body)))
+                    (list 'setq var
+                          (if (eq var loop-accum-var)
+                              (list 'nconc
+                                    (list (if (memq word '(nconc nconcing))
+                                              'nreverse 'reverse)
+                                          what)
+                                    var)
+                            (list (if (memq word '(nconc nconcing))
+                                      'nconc 'append)
+                                  var what))) t) loop-body)))
 
      ((memq word '(concat concating))
       (let ((what (pop args))
@@ -1018,19 +1015,19 @@ Valid clauses are:
 
      ((memq word '(minimize minimizing maximize maximizing))
       (let* ((what (pop args))
-             (temp (if (cl-simple-expr-p what) what (gensym)))
+             (temp (if (cl-simple-expr-p what) what (make-symbol "--cl-var--")))
              (var (cl-loop-handle-accum nil))
              (func (intern (substring (symbol-name word) 0 3)))
              (set (list 'setq var (list 'if var (list func var temp) temp))))
         (push (list 'progn (if (eq temp what) set
-                                (list 'let (list (list temp what)) set))
-                       t) loop-body)))
+                             (list 'let (list (list temp what)) set))
+                    t) loop-body)))
 
      ((eq word 'with)
       (let ((bindings nil))
         (while (progn (push (list (pop args)
-                                     (and (eq (car args) '=) (cl-pop2 args)))
-                               bindings)
+                                  (and (eq (car args) '=) (cl-pop2 args)))
+                            bindings)
                       (eq (car args) 'and))
           (pop args))
         (push (nreverse bindings) loop-bindings)))
@@ -1042,22 +1039,22 @@ Valid clauses are:
       (push (list 'not (pop args)) loop-body))
 
      ((eq word 'always)
-      (or loop-finish-flag (setq loop-finish-flag (gensym)))
+      (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-flag--")))
       (push (list 'setq loop-finish-flag (pop args)) loop-body)
       (setq loop-result t))
 
      ((eq word 'never)
-      (or loop-finish-flag (setq loop-finish-flag (gensym)))
+      (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-flag--")))
       (push (list 'setq loop-finish-flag (list 'not (pop args)))
-               loop-body)
+            loop-body)
       (setq loop-result t))
 
      ((eq word 'thereis)
-      (or loop-finish-flag (setq loop-finish-flag (gensym)))
-      (or loop-result-var (setq loop-result-var (gensym)))
+      (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-flag--")))
+      (or loop-result-var (setq loop-result-var (make-symbol "--cl-var--")))
       (push (list 'setq loop-finish-flag
-                     (list 'not (list 'setq loop-result-var (pop args))))
-               loop-body))
+                  (list 'not (list 'setq loop-result-var (pop args))))
+            loop-body))
 
      ((memq word '(if when unless))
       (let* ((cond (pop args))
@@ -1074,7 +1071,7 @@ Valid clauses are:
         (let ((form (cons (if simple (cons 'progn (nth 1 then)) (nth 2 then))
                           (if simple (nth 1 else) (list (nth 2 else))))))
           (if (cl-expr-contains form 'it)
-              (let ((temp (gensym)))
+              (let ((temp (make-symbol "--cl-var--")))
                 (push (list temp) loop-bindings)
                 (setq form (list* 'if (list 'setq temp cond)
                                   (subst temp 'it form))))
@@ -1088,10 +1085,10 @@ Valid clauses are:
         (push (cons 'progn (nreverse (cons t body))) loop-body)))
 
      ((eq word 'return)
-      (or loop-finish-flag (setq loop-finish-flag (gensym)))
-      (or loop-result-var (setq loop-result-var (gensym)))
+      (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-var--")))
+      (or loop-result-var (setq loop-result-var (make-symbol "--cl-var--")))
       (push (list 'setq loop-result-var (pop args)
-                     loop-finish-flag nil) loop-body))
+                  loop-finish-flag nil) loop-body))
 
      (t
       (let ((handler (and (symbolp word) (get word 'cl-loop-handler))))
@@ -1109,7 +1106,7 @@ Valid clauses are:
            (setq par nil p specs)
            (while p
              (or (cl-const-expr-p (cadar p))
-                 (let ((temp (gensym)))
+                 (let ((temp (make-symbol "--cl-var--")))
                    (push (list temp (cadar p)) temps)
                    (setcar (cdar p) temp)))
              (setq p (cdr p)))))
@@ -1119,8 +1116,8 @@ Valid clauses are:
                  (expr (cadr (pop specs)))
                  (temp (cdr (or (assq spec loop-destr-temps)
                                 (car (push (cons spec (or (last spec 0)
-                                                             (gensym)))
-                                              loop-destr-temps))))))
+                                                          (make-symbol "--cl-var--")))
+                                           loop-destr-temps))))))
             (push (list temp expr) new)
             (while (consp spec)
               (push (list (pop spec)
@@ -1143,7 +1140,7 @@ Valid clauses are:
         var)
     (or loop-accum-var
         (progn
-          (push (list (list (setq loop-accum-var (gensym)) def))
+          (push (list (list (setq loop-accum-var (make-symbol "--cl-var--")) def))
                    loop-bindings)
           (setq loop-result (if func (list func loop-accum-var)
                               loop-accum-var))
@@ -1214,7 +1211,7 @@ Evaluate BODY with VAR bound to each `car' from LIST, in turn.
 Then evaluate RESULT to get return value, default nil.
 
 \(fn (VAR LIST [RESULT]) BODY...)"
-  (let ((temp (gensym "--dolist-temp--")))
+  (let ((temp (make-symbol "--cl-dolist-temp--")))
     (list 'block nil
           (list* 'let (list (list temp (nth 1 spec)) (car spec))
                  (list* 'while temp (list 'setq (car spec) (list 'car temp))
@@ -1231,7 +1228,7 @@ to COUNT, exclusive.  Then evaluate RESULT to get return value, default
 nil.
 
 \(fn (VAR COUNT [RESULT]) BODY...)"
-  (let ((temp (gensym "--dotimes-temp--")))
+  (let ((temp (make-symbol "--cl-dotimes-temp--")))
     (list 'block nil
           (list* 'let (list (list temp (nth 1 spec)) (list (car spec) 0))
                  (list* 'while (list '< (car spec) temp)
@@ -1317,7 +1314,7 @@ Unlike `flet', this macro is fully compliant with the Common Lisp standard.
 \(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
   (let ((vars nil) (sets nil) (cl-macro-environment cl-macro-environment))
     (while bindings
-      (let ((var (gensym)))
+      (let ((var (make-symbol "--cl-var--")))
         (push var vars)
         (push (list 'function* (cons 'lambda (cdar bindings))) sets)
         (push var sets)
@@ -1370,8 +1367,8 @@ lexical closures as in Common Lisp."
          (vars (mapcar (function
                         (lambda (x)
                           (or (consp x) (setq x (list x)))
-                          (push (gensym (format "--%s--" (car x)))
-                                   cl-closure-vars)
+                          (push (make-symbol (format "--cl-%s--" (car x)))
+                                cl-closure-vars)
                           (set (car cl-closure-vars) [bad-lexical-ref])
                           (list (car x) (cadr x) (car cl-closure-vars))))
                        bindings))
@@ -1432,7 +1429,7 @@ simulate true multiple return values.  For compatibility, (values A B C) is
 a synonym for (list A B C).
 
 \(fn (SYM SYM...) FORM BODY)"
-  (let ((temp (gensym)) (n -1))
+  (let ((temp (make-symbol "--cl-var--")) (n -1))
     (list* 'let* (cons (list temp form)
                        (mapcar (function
                                 (lambda (v)
@@ -1451,7 +1448,7 @@ values.  For compatibility, (values A B C) is a synonym for (list A B C).
   (cond ((null vars) (list 'progn form nil))
         ((null (cdr vars)) (list 'setq (car vars) (list 'car form)))
         (t
-         (let* ((temp (gensym)) (n 0))
+         (let* ((temp (make-symbol "--cl-var--")) (n 0))
            (list 'let (list (list temp form))
                  (list 'prog1 (list 'setq (pop vars) (list 'car temp))
                        (cons 'setq (apply 'nconc
@@ -1590,44 +1587,41 @@ Example: (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))."
           (setq largsr largs tempsr temps))
         (let ((p1 largs) (p2 temps))
           (while p1
-            (setq lets1 (cons (list (car p2)
-                                    (list 'gensym (format "--%s--" (car p1))))
+            (setq lets1 (cons `(,(car p2)
+                                (make-symbol ,(format "--cl-%s--" (car p1))))
                               lets1)
                   lets2 (cons (list (car p1) (car p2)) lets2)
                   p1 (cdr p1) p2 (cdr p2))))
         (if restarg (setq lets2 (cons (list restarg rest-temps) lets2)))
-        (append (list 'define-setf-method func arg1)
-                (and docstr (list docstr))
-                (list
-                 (list 'let*
-                       (nreverse
-                        (cons (list store-temp
-                                    (list 'gensym (format "--%s--" store-var)))
-                              (if restarg
-                                  (append
-                                   (list
-                                    (list rest-temps
-                                          (list 'mapcar '(quote gensym)
-                                                restarg)))
-                                   lets1)
-                                lets1)))
-                       (list 'list  ; 'values
-                             (cons (if restarg 'list* 'list) tempsr)
-                             (cons (if restarg 'list* 'list) largsr)
-                             (list 'list store-temp)
-                             (cons 'let*
-                                   (cons (nreverse
-                                          (cons (list store-var store-temp)
-                                                lets2))
-                                         args))
-                             (cons (if restarg 'list* 'list)
-                                   (cons (list 'quote func) tempsr)))))))
-    (list 'defsetf func '(&rest args) '(store)
-          (let ((call (list 'cons (list 'quote arg1)
-                            '(append args (list store)))))
-            (if (car args)
-                (list 'list '(quote progn) call 'store)
-              call)))))
+        `(define-setf-method ,func ,arg1
+           ,@(and docstr (list docstr))
+           (let*
+               ,(nreverse
+                 (cons `(,store-temp
+                         (make-symbol ,(format "--cl-%s--" store-var)))
+                       (if restarg
+                           `((,rest-temps
+                              (mapcar (lambda (_) (make-symbol "--cl-var--"))
+                                      ,restarg))
+                             ,@lets1)
+                         lets1)))
+             (list                      ; 'values
+              (,(if restarg 'list* 'list) ,@tempsr)
+              (,(if restarg 'list* 'list) ,@largsr)
+              (list ,store-temp)
+              (let*
+                  ,(nreverse
+                    (cons (list store-var store-temp)
+                          lets2))
+                ,@args)
+              (,(if restarg 'list* 'list)
+               ,@(cons (list 'quote func) tempsr))))))
+    `(defsetf ,func (&rest args) (store)
+       ,(let ((call `(cons ',arg1
+                           (append args (list store)))))
+          (if (car args)
+              `(list 'progn ,call store)
+            call)))))
 
 ;;; Some standard place types from Common Lisp.
 (defsetf aref aset)
@@ -1781,8 +1775,8 @@ Example: (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))."
 
 (define-setf-method nthcdr (n place)
   (let ((method (get-setf-method place cl-macro-environment))
-        (n-temp (gensym "--nthcdr-n--"))
-        (store-temp (gensym "--nthcdr-store--")))
+        (n-temp (make-symbol "--cl-nthcdr-n--"))
+        (store-temp (make-symbol "--cl-nthcdr-store--")))
     (list (cons n-temp (car method))
           (cons n (nth 1 method))
           (list store-temp)
@@ -1794,9 +1788,9 @@ Example: (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))."
 
 (define-setf-method getf (place tag &optional def)
   (let ((method (get-setf-method place cl-macro-environment))
-        (tag-temp (gensym "--getf-tag--"))
-        (def-temp (gensym "--getf-def--"))
-        (store-temp (gensym "--getf-store--")))
+        (tag-temp (make-symbol "--cl-getf-tag--"))
+        (def-temp (make-symbol "--cl-getf-def--"))
+        (store-temp (make-symbol "--cl-getf-store--")))
     (list (append (car method) (list tag-temp def-temp))
           (append (nth 1 method) (list tag def))
           (list store-temp)
@@ -1808,9 +1802,9 @@ Example: (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))."
 
 (define-setf-method substring (place from &optional to)
   (let ((method (get-setf-method place cl-macro-environment))
-        (from-temp (gensym "--substring-from--"))
-        (to-temp (gensym "--substring-to--"))
-        (store-temp (gensym "--substring-store--")))
+        (from-temp (make-symbol "--cl-substring-from--"))
+        (to-temp (make-symbol "--cl-substring-to--"))
+        (store-temp (make-symbol "--cl-substring-store--")))
     (list (append (car method) (list from-temp to-temp))
           (append (nth 1 method) (list from to))
           (list store-temp)
@@ -1826,7 +1820,7 @@ Example: (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))."
 PLACE may be any Lisp form which can appear as the PLACE argument to
 a macro like `setf' or `incf'."
   (if (symbolp place)
-      (let ((temp (gensym "--setf--")))
+      (let ((temp (make-symbol "--cl-setf--")))
         (list nil nil (list temp) (list 'setq place temp) place))
     (or (and (symbolp (car place))
              (let* ((func (car place))
@@ -1933,7 +1927,7 @@ before assigning any PLACEs to the corresponding values.
   (if (cl-simple-expr-p place)
       (list 'prog1 (list 'car place) (list 'setf place (list 'cdr place)))
     (let* ((method (cl-setf-do-modify place t))
-           (temp (gensym "--pop--")))
+           (temp (make-symbol "--cl-pop--")))
       (list 'let*
             (append (car method)
                     (list (list temp (nth 2 method))))
@@ -1946,9 +1940,9 @@ before assigning any PLACEs to the corresponding values.
 PLACE may be a symbol, or any generalized variable allowed by `setf'.
 The form returns true if TAG was found and removed, nil otherwise."
   (let* ((method (cl-setf-do-modify place t))
-         (tag-temp (and (not (cl-const-expr-p tag)) (gensym "--remf-tag--")))
+         (tag-temp (and (not (cl-const-expr-p tag)) (make-symbol "--cl-remf-tag--")))
          (val-temp (and (not (cl-simple-expr-p place))
-                        (gensym "--remf-place--")))
+                        (make-symbol "--cl-remf-place--")))
          (ttag (or tag-temp tag))
          (tval (or val-temp (nth 2 method))))
     (list 'let*
@@ -1990,7 +1984,7 @@ Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
                (setq sets (nconc sets (list (pop args) (car args)))))
              (nconc (list 'psetf) sets (list (car args) first))))
     (let* ((places (reverse args))
-           (temp (gensym "--rotatef--"))
+           (temp (make-symbol "--cl-rotatef--"))
            (form temp))
       (while (cdr places)
         (let ((method (cl-setf-do-modify (pop places) 'unsafe)))
@@ -2022,11 +2016,11 @@ the PLACE is not modified before executing BODY.
                         (caar rev)))
                (value (cadar rev))
                (method (cl-setf-do-modify place 'no-opt))
-               (save (gensym "--letf-save--"))
+               (save (make-symbol "--cl-letf-save--"))
                (bound (and (memq (car place) '(symbol-value symbol-function))
-                           (gensym "--letf-bound--")))
+                           (make-symbol "--cl-letf-bound--")))
                (temp (and (not (cl-const-expr-p value)) (cdr bindings)
-                          (gensym "--letf-val--"))))
+                          (make-symbol "--cl-letf-val--"))))
           (setq lets (nconc (car method)
                             (if bound
                                 (list (list bound
@@ -2097,7 +2091,7 @@ Like `callf', but PLACE is the second argument of FUNC, not the first.
   (if (and (cl-safe-expr-p arg1) (cl-simple-expr-p place) (symbolp func))
       (list 'setf place (list* func arg1 place args))
     (let* ((method (cl-setf-do-modify place (cons 'list args)))
-           (temp (and (not (cl-const-expr-p arg1)) (gensym "--arg1--")))
+           (temp (and (not (cl-const-expr-p arg1)) (make-symbol "--cl-arg1--")))
            (rargs (list* (or temp arg1) (nth 2 method) args)))
       (list 'let* (append (and temp (list (list temp arg1))) (car method))
             (cl-setf-do-store (nth 1 method)
@@ -2110,7 +2104,7 @@ Like `callf', but PLACE is the second argument of FUNC, not the first.
 If NAME is called, it combines its PLACE argument with the other arguments
 from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)"
   (if (memq '&key arglist) (error "&key not allowed in define-modify-macro"))
-  (let ((place (gensym "--place--")))
+  (let ((place (make-symbol "--cl-place--")))
     (list 'defmacro* name (cons place arglist) doc
           (list* (if (memq '&rest arglist) 'list* 'list)
                  '(quote callf) (list 'quote func) place
@@ -2334,7 +2328,7 @@ copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors.
     (cons 'progn (nreverse (cons (list 'quote name) forms)))))
 
 (defun cl-struct-setf-expander (x name accessor pred-form pos)
-  (let* ((temp (gensym "--x--")) (store (gensym "--store--")))
+  (let* ((temp (make-symbol "--cl-x--")) (store (make-symbol "--cl-store--")))
     (list (list temp) (list x) (list store)
           (append '(progn)
                   (and pred-form
@@ -2410,7 +2404,8 @@ TYPE is a Common Lisp-style type specifier."
 STRING is an optional description of the desired type."
   (and (or (not (cl-compiling-file))
            (< cl-optimize-speed 3) (= cl-optimize-safety 3))
-       (let* ((temp (if (cl-simple-expr-p form 3) form (gensym)))
+       (let* ((temp (if (cl-simple-expr-p form 3)
+                        form (make-symbol "--cl-var--")))
               (body (list 'or (cl-make-type-test temp type)
                           (list 'signal '(quote wrong-type-argument)
                                 (list 'list (or string (list 'quote type))
@@ -2607,48 +2602,47 @@ surrounded by (block NAME ...).
       (let ((res (cl-make-type-test val (cl-const-expr-val type))))
         (if (or (memq (cl-expr-contains res val) '(nil 1))
                 (cl-simple-expr-p val)) res
-          (let ((temp (gensym)))
+          (let ((temp (make-symbol "--cl-var--")))
             (list 'let (list (list temp val)) (subst temp val res)))))
     form))
 
 
-(mapcar (function
-         (lambda (y)
-           (put (car y) 'side-effect-free t)
-           (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro)
-           (put (car y) 'cl-compiler-macro
-                (list 'lambda '(w x)
-                      (if (symbolp (cadr y))
-                          (list 'list (list 'quote (cadr y))
-                                (list 'list (list 'quote (caddr y)) 'x))
-                        (cons 'list (cdr y)))))))
-        '((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x)
-          (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x)
-          (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x)
-          (rest 'cdr x) (endp 'null x) (plusp '> x 0) (minusp '< x 0)
-          (caaar car caar) (caadr car cadr) (cadar car cdar)
-          (caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr)
-          (cddar cdr cdar) (cdddr cdr cddr) (caaaar car caaar)
-          (caaadr car caadr) (caadar car cadar) (caaddr car caddr)
-          (cadaar car cdaar) (cadadr car cdadr) (caddar car cddar)
-          (cadddr car cdddr) (cdaaar cdr caaar) (cdaadr cdr caadr)
-          (cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar)
-          (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr) ))
+(mapc (lambda (y)
+        (put (car y) 'side-effect-free t)
+        (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro)
+        (put (car y) 'cl-compiler-macro
+             `(lambda (w x)
+                ,(if (symbolp (cadr y))
+                     `(list ',(cadr y)
+                            (list ',(caddr y) x))
+                   (cons 'list (cdr y))))))
+      '((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x)
+        (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x)
+        (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x)
+        (rest 'cdr x) (endp 'null x) (plusp '> x 0) (minusp '< x 0)
+        (caaar car caar) (caadr car cadr) (cadar car cdar)
+        (caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr)
+        (cddar cdr cdar) (cdddr cdr cddr) (caaaar car caaar)
+        (caaadr car caadr) (caadar car cadar) (caaddr car caddr)
+        (cadaar car cdaar) (cadadr car cdadr) (caddar car cddar)
+        (cadddr car cdddr) (cdaaar cdr caaar) (cdaadr cdr caadr)
+        (cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar)
+        (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr) ))
 
 ;;; Things that are inline.
 (proclaim '(inline floatp-safe acons map concatenate notany notevery
                    cl-set-elt revappend nreconc gethash))
 
 ;;; Things that are side-effect-free.
-(mapcar (function (lambda (x) (put x 'side-effect-free t)))
-        '(oddp evenp signum last butlast ldiff pairlis gcd lcm
-          isqrt floor* ceiling* truncate* round* mod* rem* subseq
-          list-length get* getf))
+(mapc (lambda (x) (put x 'side-effect-free t))
+      '(oddp evenp signum last butlast ldiff pairlis gcd lcm
+        isqrt floor* ceiling* truncate* round* mod* rem* subseq
+        list-length get* getf))
 
 ;;; Things that are side-effect-and-error-free.
-(mapcar (function (lambda (x) (put x 'side-effect-free 'error-free)))
-        '(eql floatp-safe list* subst acons equalp random-state-p
-          copy-tree sublis))
+(mapc (lambda (x) (put x 'side-effect-free 'error-free))
+      '(eql floatp-safe list* subst acons equalp random-state-p
+        copy-tree sublis))
 
 
 (run-hooks 'cl-macs-load-hook)
@@ -2657,5 +2651,5 @@ surrounded by (block NAME ...).
 ;;; byte-compile-warnings: (redefine callargs free-vars unresolved obsolete noruntime)
 ;;; End:
 
-;;; arch-tag: afd947a6-b553-4df1-bba5-000be6388f46
+;; arch-tag: afd947a6-b553-4df1-bba5-000be6388f46
 ;;; cl-macs.el ends here