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