From: Alex <agrambot@gmail.com>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: Michael Heerdegen <michael_heerdegen@web.de>,
27177@debbugs.gnu.org, npostavs@users.sourceforge.net
Subject: bug#27177: 26.0.50: Macroexpanding cl-loop and friends (make-symbol usage)
Date: Tue, 06 Jun 2017 14:31:32 -0600 [thread overview]
Message-ID: <87vao83ljv.fsf@gmail.com> (raw)
In-Reply-To: <8737bk8vba.fsf@gmail.com>
[-- Attachment #1: Type: text/plain, Size: 1871 bytes --]
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.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: gensym.diff --]
[-- Type: text/x-diff, Size: 11329 bytes --]
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))
next prev parent reply other threads:[~2017-06-06 20:31 UTC|newest]
Thread overview: 17+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-05-31 23:23 bug#27177: 26.0.50: Macroexpanding cl-loop and friends (make-symbol usage) Alex
2017-05-31 23:51 ` Michael Heerdegen
2017-06-01 0:29 ` Alex
2017-06-01 0:52 ` npostavs
2017-06-01 1:01 ` Michael Heerdegen
2017-06-01 2:02 ` Alex
2017-06-02 3:27 ` Michael Heerdegen
2017-06-02 4:42 ` Alex
2017-06-02 23:09 ` Michael Heerdegen
2017-06-02 23:17 ` npostavs
2017-06-02 23:46 ` Alex
2017-06-03 2:33 ` Stefan Monnier
2017-06-04 0:24 ` Alex
2017-06-06 4:20 ` Stefan Monnier
2017-06-06 20:31 ` Alex [this message]
2020-08-24 14:53 ` Lars Ingebrigtsen
2017-06-01 0:29 ` npostavs
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87vao83ljv.fsf@gmail.com \
--to=agrambot@gmail.com \
--cc=27177@debbugs.gnu.org \
--cc=michael_heerdegen@web.de \
--cc=monnier@iro.umontreal.ca \
--cc=npostavs@users.sourceforge.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.