bug#27177: 26.0.50: Macroexpanding cl-loop and friends (make-symbol usage)

[Alex]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> I've browsed around for a few common loop implementations and they all
>> use gensym (CCL uses gentemp) and descriptive naming:
>
> gensym is the indeed what is commonly used in Common-Lisp, whereas
> make-symbol is what is commonly used in ELisp.

Right, but it seems natural that the CL compatibility macros would use
gensym since CL does it that way.

>> I also found a CHICKEN Scheme egg for CL's loop, and it uses gensym (but
>> generic names, unfortunately).
>
> Does Scheme have make-symbol or something equivalent?

The RnRS standards don't specify uninterned symbols, but they mention
that some implementations have them. A quick check shows that Guile has
make-symbol, and CHICKEN and Racket have equivalents to make-symbol
(string->uninterned-symbol). All 3 have gensym.

>> If there's a good reason to not use gensym, then that's fine, but if the
>> problem is easy enough to work around (perhaps per-expansion counter so
>> that it will never realistically hit most-positive-fixnum), then I think
>> cl-loop should use it.
>
> I'd prefer to solve it in the printer, but that's just my opinion.
> FWIW, I've found print-gensym to be sufficient.

How do you want to solve it in the printer? One way I thought of was to
keep a counter similar to cl--gensym-counter, and make a hash table of
uninterned symbols with values being the prefix to concat to the end of
the print name of the symbol. At this point, though, why not port gensym
to ELisp proper and encourage use of gensym? I don't see the use for
extra complexity if it's not needed.

A seemingly simple option, as mentioned before, is to bind
cl--gensym-counter to 0 at the start of cl-loop. That means cl-loop
won't increase the global counter, and it fixes the readability of the
macro. I attached a sample diff below, which seems to work fine.

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index db1518ce61..5b711a2a79 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -544,7 +544,7 @@ cl--do-arglist
          (laterarg nil) (exactarg nil) minarg)
       (or num (setq num 0))
       (setq restarg (if (listp (cadr restarg))
-                        (make-symbol "--cl-rest--")
+                        (cl-gensym "--cl-rest--")
                       (cadr restarg)))
       (push (list restarg expr) cl--bind-lets)
       (if (eq (car args) '&whole)
@@ -617,7 +617,7 @@ cl--do-arglist
                    (look `(plist-member ,restarg ',karg)))
              (and def cl--bind-enquote (setq def `',def))
              (if (cddr arg)
-                 (let* ((temp (or (nth 2 arg) (make-symbol "--cl-var--")))
+                 (let* ((temp (or (nth 2 arg) (cl-gensym "--cl-var--")))
                         (val `(car (cdr ,temp))))
                    (cl--do-arglist temp look)
                    (cl--do-arglist varg
@@ -636,7 +636,7 @@ cl--do-arglist
       (setq keys (nreverse keys))
       (or (and (eq (car args) '&allow-other-keys) (pop args))
          (null keys) (= safety 0)
-         (let* ((var (make-symbol "--cl-keys--"))
+         (let* ((var (cl-gensym "--cl-keys--"))
                 (allow '(:allow-other-keys))
                 (check `(while ,var
                            (cond
@@ -936,7 +936,8 @@ cl-loop
          (cl--loop-accum-var nil)      (cl--loop-accum-vars nil)
          (cl--loop-initially nil)      (cl--loop-finally nil)
          (cl--loop-iterator-function nil) (cl--loop-first-flag nil)
-          (cl--loop-symbol-macs nil))
+          (cl--loop-symbol-macs nil)
+          (cl--gensym-counter 0))
       ;; Here is more or less how those dynbind vars are used after looping
       ;; over cl--parse-loop-clause:
       ;;
@@ -1225,9 +1226,9 @@ cl--parse-loop-clause
                       (step (and (eq (car cl--loop-args) 'by)
                                   (cl--pop2 cl--loop-args)))
                       (end-var (and (not (macroexp-const-p end))
-                                    (make-symbol "--cl-var--")))
+                                    (cl-gensym "--cl-var--")))
                       (step-var (and (not (macroexp-const-p step))
-                                     (make-symbol "--cl-var--"))))
+                                     (cl-gensym "--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)
@@ -1246,7 +1247,7 @@ cl--parse-loop-clause
               ((memq word '(in in-ref on))
                (let* ((on (eq word 'on))
                       (temp (if (and on (symbolp var))
-                                var (make-symbol "--cl-var--"))))
+                                var (cl-gensym "--cl-var--"))))
                  (push (list temp (pop cl--loop-args)) loop-for-bindings)
                  (push `(consp ,temp) cl--loop-body)
                  (if (eq word 'in-ref)
@@ -1278,7 +1279,7 @@ cl--parse-loop-clause
                        (push `(,var
                                (if ,(or cl--loop-first-flag
                                         (setq cl--loop-first-flag
-                                              (make-symbol "--cl-var--")))
+                                              (cl-gensym "--cl-var--")))
                                    ,start ,var))
                              loop-for-sets)
                        (push (list var then) loop-for-steps))
@@ -1286,13 +1287,13 @@ cl--parse-loop-clause
                                (if (eq start then) start
                                  `(if ,(or cl--loop-first-flag
                                            (setq cl--loop-first-flag
-                                                 (make-symbol "--cl-var--")))
+                                                 (cl-gensym "--cl-var--")))
                                       ,start ,then)))
                          loop-for-sets))))
 
               ((memq word '(across across-ref))
-               (let ((temp-vec (make-symbol "--cl-vec--"))
-                     (temp-idx (make-symbol "--cl-idx--")))
+               (let ((temp-vec (cl-gensym "--cl-vec--"))
+                     (temp-idx (cl-gensym "--cl-idx--")))
                  (push (list temp-vec (pop cl--loop-args)) loop-for-bindings)
                  (push (list temp-idx -1) loop-for-bindings)
                  (push `(< (setq ,temp-idx (1+ ,temp-idx))
@@ -1310,18 +1311,18 @@ cl--parse-loop-clause
                               (and (not (memq (car cl--loop-args) '(in of)))
                                    (error "Expected `of'"))))
                      (seq (cl--pop2 cl--loop-args))
-                     (temp-seq (make-symbol "--cl-seq--"))
+                     (temp-seq (cl-gensym "--cl-seq--"))
                      (temp-idx
                        (if (eq (car cl--loop-args) 'using)
                            (if (and (= (length (cadr cl--loop-args)) 2)
                                     (eq (cl-caadr cl--loop-args) 'index))
                                (cadr (cl--pop2 cl--loop-args))
                              (error "Bad `using' clause"))
-                         (make-symbol "--cl-idx--"))))
+                         (cl-gensym "--cl-idx--"))))
                  (push (list temp-seq seq) loop-for-bindings)
                  (push (list temp-idx 0) loop-for-bindings)
                  (if ref
-                     (let ((temp-len (make-symbol "--cl-len--")))
+                     (let ((temp-len (cl-gensym "--cl-len--")))
                        (push (list temp-len `(length ,temp-seq))
                              loop-for-bindings)
                        (push (list var `(elt ,temp-seq ,temp-idx))
@@ -1350,7 +1351,7 @@ cl--parse-loop-clause
                                      (not (eq (cl-caadr cl--loop-args) word)))
                                 (cadr (cl--pop2 cl--loop-args))
                               (error "Bad `using' clause"))
-                          (make-symbol "--cl-var--"))))
+                          (cl-gensym "--cl-var--"))))
                  (if (memq word '(hash-value hash-values))
                      (setq var (prog1 other (setq other var))))
                  (cl--loop-set-iterator-function
@@ -1377,14 +1378,14 @@ cl--parse-loop-clause
                  (cl--loop-set-iterator-function
                    'overlays (lambda (body)
                                `(cl--map-overlays
-                                 (lambda (,var ,(make-symbol "--cl-var--"))
+                                 (lambda (,var ,(cl-gensym "--cl-var--"))
                                    (progn . ,body) nil)
                                  ,buf ,from ,to)))))
 
               ((memq word '(interval intervals))
                (let ((buf nil) (prop nil) (from nil) (to nil)
-                     (var1 (make-symbol "--cl-var1--"))
-                     (var2 (make-symbol "--cl-var2--")))
+                     (var1 (cl-gensym "--cl-var1--"))
+                     (var2 (cl-gensym "--cl-var2--")))
                  (while (memq (car cl--loop-args) '(in of property from to))
                    (cond ((eq (car cl--loop-args) 'from)
                            (setq from (cl--pop2 cl--loop-args)))
@@ -1413,7 +1414,7 @@ cl--parse-loop-clause
                                     (not (eq (cl-caadr cl--loop-args) word)))
                                (cadr (cl--pop2 cl--loop-args))
                              (error "Bad `using' clause"))
-                         (make-symbol "--cl-var--"))))
+                         (cl-gensym "--cl-var--"))))
                  (if (memq word '(key-binding key-bindings))
                      (setq var (prog1 other (setq other var))))
                  (cl--loop-set-iterator-function
@@ -1423,7 +1424,7 @@ cl--parse-loop-clause
                              (lambda (,var ,other) . ,body) ,cl-map)))))
 
               ((memq word '(frame frames screen screens))
-               (let ((temp (make-symbol "--cl-var--")))
+               (let ((temp (cl-gensym "--cl-var--")))
                  (push (list var  '(selected-frame))
                        loop-for-bindings)
                  (push (list temp nil) loop-for-bindings)
@@ -1436,8 +1437,8 @@ cl--parse-loop-clause
               ((memq word '(window windows))
                (let ((scr (and (memq (car cl--loop-args) '(in of))
                                 (cl--pop2 cl--loop-args)))
-                     (temp (make-symbol "--cl-var--"))
-                     (minip (make-symbol "--cl-minip--")))
+                     (temp (cl-gensym "--cl-var--"))
+                     (minip (cl-gensym "--cl-minip--")))
                  (push (list var (if scr
                                      `(frame-selected-window ,scr)
                                    '(selected-window)))
@@ -1481,7 +1482,7 @@ cl--parse-loop-clause
                  cl--loop-steps))))
 
      ((eq word 'repeat)
-      (let ((temp (make-symbol "--cl-var--")))
+      (let ((temp (cl-gensym "--cl-var--")))
        (push (list (list temp (pop cl--loop-args))) cl--loop-bindings)
        (push `(>= (setq ,temp (1- ,temp)) 0) cl--loop-body)))
 
@@ -1560,22 +1561,22 @@ cl--parse-loop-clause
 
      ((eq word 'always)
       (or cl--loop-finish-flag
-          (setq cl--loop-finish-flag (make-symbol "--cl-flag--")))
+          (setq cl--loop-finish-flag (cl-gensym "--cl-flag--")))
       (push `(setq ,cl--loop-finish-flag ,(pop cl--loop-args)) cl--loop-body)
       (setq cl--loop-result t))
 
      ((eq word 'never)
       (or cl--loop-finish-flag
-          (setq cl--loop-finish-flag (make-symbol "--cl-flag--")))
+          (setq cl--loop-finish-flag (cl-gensym "--cl-flag--")))
       (push `(setq ,cl--loop-finish-flag (not ,(pop cl--loop-args)))
            cl--loop-body)
       (setq cl--loop-result t))
 
      ((eq word 'thereis)
       (or cl--loop-finish-flag
-          (setq cl--loop-finish-flag (make-symbol "--cl-flag--")))
+          (setq cl--loop-finish-flag (cl-gensym "--cl-flag--")))
       (or cl--loop-result-var
-          (setq cl--loop-result-var (make-symbol "--cl-var--")))
+          (setq cl--loop-result-var (cl-gensym "--cl-var--")))
       (push `(setq ,cl--loop-finish-flag
                    (not (setq ,cl--loop-result-var ,(pop cl--loop-args))))
            cl--loop-body))
@@ -1607,9 +1608,9 @@ cl--parse-loop-clause
 
      ((eq word 'return)
       (or cl--loop-finish-flag
-          (setq cl--loop-finish-flag (make-symbol "--cl-var--")))
+          (setq cl--loop-finish-flag (cl-gensym "--cl-var--")))
       (or cl--loop-result-var
-          (setq cl--loop-result-var (make-symbol "--cl-var--")))
+          (setq cl--loop-result-var (cl-gensym "--cl-var--")))
       (push `(setq ,cl--loop-result-var ,(pop cl--loop-args)
                    ,cl--loop-finish-flag nil)
             cl--loop-body))
@@ -1640,7 +1641,7 @@ cl--loop-let
           (setq par nil)
           (dolist (spec specs)
             (or (macroexp-const-p (cadr spec))
-                (let ((temp (make-symbol "--cl-var--")))
+                (let ((temp (cl-gensym "--cl-var--")))
                   (push (list temp (cadr spec)) temps)
                   (setcar (cdr spec) temp)))))))
     (while specs
@@ -1657,7 +1658,7 @@ cl--loop-let
                           (and (eq body 'setq) (cl--unused-var-p temp)))
                   ;; Prefer a fresh uninterned symbol over "_to", to avoid
                   ;; warnings that we set an unused variable.
-                  (setq temp (make-symbol "--cl-var--"))
+                  (setq temp (cl-gensym "--cl-var--"))
                   ;; Make sure this temp variable is locally declared.
                   (when (eq body 'setq)
                     (push (list (list temp)) cl--loop-bindings)))
@@ -1685,7 +1686,7 @@ cl--loop-handle-accum
     (or cl--loop-accum-var
        (progn
          (push (list (list
-                       (setq cl--loop-accum-var (make-symbol "--cl-var--"))
+                       (setq cl--loop-accum-var (cl-gensym "--cl-var--"))
                        def))
                 cl--loop-bindings)
          (setq cl--loop-result (if func (list func cl--loop-accum-var)
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 87531110b8..3eee3f3878 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1326,7 +1326,8 @@ ffap-file-at-point
         ;; If it contains a colon, get rid of it (and return if exists)
         ((and (string-match path-separator name)
               (setq name (ffap-string-at-point 'nocolon))
-              (ffap-file-exists-string name)))
+               (not (string-empty-p name))
+               (ffap-file-exists-string name)))
         ;; File does not exist, try the alist:
         ((let ((alist ffap-alist) tem try case-fold-search)
            (while (and alist (not try))