From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Christopher Schmidt Newsgroups: gmane.emacs.bugs Subject: bug#11038: 24.0.94; 24.0.94; cl loop macroexpand fails with (wrong-type-argument listp emacs) Date: Sat, 17 Mar 2012 23:27:13 +0100 Message-ID: <20120317222717.4B9EF1FE38@saturn.ch.ristopher.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1332023335 12448 80.91.229.3 (17 Mar 2012 22:28:55 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Sat, 17 Mar 2012 22:28:55 +0000 (UTC) To: 11038@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sat Mar 17 23:28:53 2012 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1S927F-0006KV-KU for geb-bug-gnu-emacs@m.gmane.org; Sat, 17 Mar 2012 23:28:50 +0100 Original-Received: from localhost ([::1]:46099 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S927F-0000LL-1D for geb-bug-gnu-emacs@m.gmane.org; Sat, 17 Mar 2012 18:28:49 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:59620) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S927A-0000Kg-Qm for bug-gnu-emacs@gnu.org; Sat, 17 Mar 2012 18:28:47 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1S9277-0001xJ-LS for bug-gnu-emacs@gnu.org; Sat, 17 Mar 2012 18:28:44 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:48259) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S9277-0001vv-ES for bug-gnu-emacs@gnu.org; Sat, 17 Mar 2012 18:28:41 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.72) (envelope-from ) id 1S92aU-00020g-7l for bug-gnu-emacs@gnu.org; Sat, 17 Mar 2012 18:59:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Christopher Schmidt Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 17 Mar 2012 22:59:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 11038 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.13320250827656 (code B ref -1); Sat, 17 Mar 2012 22:59:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 17 Mar 2012 22:58:02 +0000 Original-Received: from localhost ([127.0.0.1]:55091 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1S92ZU-0001z8-Pp for submit@debbugs.gnu.org; Sat, 17 Mar 2012 18:58:02 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:40028) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1S92ZQ-0001yy-5f for submit@debbugs.gnu.org; Sat, 17 Mar 2012 18:57:59 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1S925x-0001qJ-RB for submit@debbugs.gnu.org; Sat, 17 Mar 2012 18:27:34 -0400 Original-Received: from lists.gnu.org ([208.118.235.17]:41592) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S925x-0001qD-Lv for submit@debbugs.gnu.org; Sat, 17 Mar 2012 18:27:29 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:37347) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S925u-0008Sp-Gq for bug-gnu-emacs@gnu.org; Sat, 17 Mar 2012 18:27:29 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1S925q-0001pF-Ka for bug-gnu-emacs@gnu.org; Sat, 17 Mar 2012 18:27:25 -0400 Original-Received: from ristopher.com ([146.185.21.93]:42384 helo=saturn.ch.ristopher.com) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S925p-0001p9-Uw for bug-gnu-emacs@gnu.org; Sat, 17 Mar 2012 18:27:22 -0400 Original-Received: by saturn.ch.ristopher.com (Postfix, from userid 0) id 4B9EF1FE38; Sat, 17 Mar 2012 22:27:17 +0000 (GMT) DKIM-Signature: v=1; a=rsa-sha256; c=simple/simple; d=ch.ristopher.com; s=mail; t=1332023237; bh=GAa4rbxCxlIsvI4mW4MT5cYpVb4oR3gmauxHGuvVKjw=; h=From:To:Subject:Date:MIME-Version:Content-Type:Message-Id; b=1PHG4DWtYw/uDesHVN4+MWfc0cKk7mCIvYmpySzSd1676AtlsmKy6LVgZVVqdkUYP HQ6moAGg3054x+PNwlwLZA6FAf1JifNT0XC81xyufkp1nUqsAwZOwHmzCRS3OrO1tI GdK/mDk0VRIYJwUljXU8xu2SfbNX1fIFfghAXsDo= Mail-Followup-To: bug-gnu-emacs@gnu.org X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6, seldom 2.4 (older, 4) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.13 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 2) X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:57869 Archived-At: --=-=-= Content-Type: text/plain Hi, I think I hit on a bug in GNU Emacs 24.0.94.1 (x86_64-unknown-linux-gnu, GTK+ Version 2.24.10) of 2012-03-11. This cl loop is not parsed correctly. (loop for rms in nil when t do (loop for (gnu . emacs) in nil) end) Backtrace when evaling this form: --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=backtrace Content-Transfer-Encoding: quoted-printable Debugger entered--Lisp error: (wrong-type-argument listp emacs) cdr(emacs) (setq x (cdr x)) (prog1 x (setq x (cdr x))) (car (prog1 x (setq x (cdr x)))) (pop x) (cl-expr-contains (pop x) y) (or (cl-expr-contains (pop x) y) 0) (+ sum (or (cl-expr-contains (pop x) y) 0)) (setq sum (+ sum (or (cl-expr-contains (pop x) y) 0))) (while x (setq sum (+ sum (or (cl-expr-contains (pop x) y) 0)))) (let ((sum 0)) (while x (setq sum (+ sum (or (cl-expr-contains (pop x) y)= 0)))) (and (> sum 0) sum)) (cond ((equal y x) 1) ((and (consp x) (not (memq (car-safe x) (quote (quo= te function function*))))) (let ((sum 0)) (while x (setq sum (+ sum (or (cl= -expr-contains ... y) 0)))) (and (> sum 0) sum))) (t nil)) cl-expr-contains((gnu . emacs) it) (or (cl-expr-contains (pop x) y) 0) (+ sum (or (cl-expr-contains (pop x) y) 0)) (setq sum (+ sum (or (cl-expr-contains (pop x) y) 0))) (while x (setq sum (+ sum (or (cl-expr-contains (pop x) y) 0)))) (let ((sum 0)) (while x (setq sum (+ sum (or (cl-expr-contains (pop x) y)= 0)))) (and (> sum 0) sum)) (cond ((equal y x) 1) ((and (consp x) (not (memq (car-safe x) (quote (quo= te function function*))))) (let ((sum 0)) (while x (setq sum (+ sum (or (cl= -expr-contains ... y) 0)))) (and (> sum 0) sum))) (t nil)) cl-expr-contains((loop for (gnu . emacs) in nil) it) (or (cl-expr-contains (pop x) y) 0) (+ sum (or (cl-expr-contains (pop x) y) 0)) (setq sum (+ sum (or (cl-expr-contains (pop x) y) 0))) (while x (setq sum (+ sum (or (cl-expr-contains (pop x) y) 0)))) (let ((sum 0)) (while x (setq sum (+ sum (or (cl-expr-contains (pop x) y)= 0)))) (and (> sum 0) sum)) (cond ((equal y x) 1) ((and (consp x) (not (memq (car-safe x) (quote (quo= te function function*))))) (let ((sum 0)) (while x (setq sum (+ sum (or (cl= -expr-contains ... y) 0)))) (and (> sum 0) sum))) (t nil)) cl-expr-contains((progn (loop for (gnu . emacs) in nil)) it) (or (cl-expr-contains (pop x) y) 0) (+ sum (or (cl-expr-contains (pop x) y) 0)) (setq sum (+ sum (or (cl-expr-contains (pop x) y) 0))) (while x (setq sum (+ sum (or (cl-expr-contains (pop x) y) 0)))) (let ((sum 0)) (while x (setq sum (+ sum (or (cl-expr-contains (pop x) y)= 0)))) (and (> sum 0) sum)) (cond ((equal y x) 1) ((and (consp x) (not (memq (car-safe x) (quote (quo= te function function*))))) (let ((sum 0)) (while x (setq sum (+ sum (or (cl= -expr-contains ... y) 0)))) (and (> sum 0) sum))) (t nil)) cl-expr-contains(((progn (loop for (gnu . emacs) in nil))) it) (if (cl-expr-contains form (quote it)) (let ((temp (make-symbol "--cl-var= --"))) (push (list temp) loop-bindings) (setq form (list* (quote if) (list = (quote setq) temp cond) (subst temp (quote it) form)))) (setq form (list* (= quote if) cond form))) (let ((form (cons (if simple (cons (quote progn) (nth 1 then)) (nth 2 the= n)) (if simple (nth 1 else) (list (nth 2 else)))))) (if (cl-expr-contains f= orm (quote it)) (let ((temp (make-symbol "--cl-var--"))) (push (list temp) = loop-bindings) (setq form (list* (quote if) (list (quote setq) temp cond) (= subst temp (quote it) form)))) (setq form (list* (quote if) cond form))) (p= ush (if simple (list (quote progn) form t) form) loop-body)) (let* ((cond (pop loop-args)) (then (let ((loop-body nil)) (cl-parse-loop= -clause) (cl-loop-build-ands (nreverse loop-body)))) (else (let ((loop-body= nil)) (if (eq (car loop-args) (quote else)) (progn (pop loop-args) (cl-par= se-loop-clause))) (cl-loop-build-ands (nreverse loop-body)))) (simple (and = (eq (car then) t) (eq (car else) t)))) (if (eq (car loop-args) (quote end))= (pop loop-args)) (if (eq word (quote unless)) (setq then (prog1 else (setq= else then)))) (let ((form (cons (if simple (cons (quote progn) (nth 1 then= )) (nth 2 then)) (if simple (nth 1 else) (list (nth 2 else)))))) (if (cl-ex= pr-contains form (quote it)) (let ((temp (make-symbol "--cl-var--"))) (push= (list temp) loop-bindings) (setq form (list* (quote if) (list (quote setq)= temp cond) (subst temp (quote it) form)))) (setq form (list* (quote if) co= nd form))) (push (if simple (list (quote progn) form t) form) loop-body))) (cond ((null loop-args) (error "Malformed `loop' macro")) ((eq word (quot= e named)) (setq loop-name (pop loop-args))) ((eq word (quote initially)) (i= f (memq (car loop-args) (quote (do doing))) (pop loop-args)) (or (consp (ca= r loop-args)) (error "Syntax error on `initially' clause")) (while (consp (= car loop-args)) (push (pop loop-args) loop-initially))) ((eq word (quote fi= nally)) (if (eq (car loop-args) (quote return)) (setq loop-result-explicit = (or (cl-pop2 loop-args) (quote (quote nil)))) (if (memq (car loop-args) (qu= ote (do doing))) (pop loop-args)) (or (consp (car loop-args)) (error "Synta= x error on `finally' clause")) (if (and (eq (caar loop-args) (quote return)= ) (null loop-name)) (setq loop-result-explicit (or (nth 1 (pop loop-args)) = (quote (quote nil)))) (while (consp (car loop-args)) (push (pop loop-args) = loop-finally))))) ((memq word (quote (for as))) (let ((loop-for-bindings ni= l) (loop-for-sets nil) (loop-for-steps nil) (ands nil)) (while (let ((var (= or ... ...))) (setq word (pop loop-args)) (if (eq word (quote being)) (setq= word (pop loop-args))) (if (memq word (quote ...)) (setq word (pop loop-ar= gs))) (if (memq word (quote ...)) (setq word (quote in) loop-args (cons ...= loop-args))) (cond ((memq word ...) (push word loop-args) (if ... ...) (le= t* ... ... ... ... ... ... ...)) ((memq word ...) (let* ... ... ... ... ...= )) ((eq word ...) (let* ... ... ...)) ((memq word ...) (let ... ... ... ...= ...)) ((memq word ...) (let ... ... ... ... ...)) ((memq word hash-types) = (or ... ...) (let* ... ... ...)) ((memq word ...) (let ... ...)) ((memq wor= d ...) (let ... ... ...)) ((memq word ...) (let ... ... ... ...)) ((memq wo= rd key-types) (or ... ...) (let ... ... ...)) ((memq word ...) (let ... ...= ... ... ...)) ((memq word ...) (let ... ... ... ... ... ...)) (t (let ... = ...))) (eq (car loop-args) (quote and))) (setq ands t) (pop loop-args)) (if= (and ands loop-for-bindings) (push (nreverse loop-for-bindings) loop-bindi= ngs) (setq loop-bindings (nconc (mapcar (quote list) loop-for-bindings) loo= p-bindings))) (if loop-for-sets (push (list (quote progn) (cl-loop-let (nre= verse loop-for-sets) (quote setq) ands) t) loop-body)) (if loop-for-steps (= push (cons (if ands (quote psetq) (quote setq)) (apply (quote append) (nrev= erse loop-for-steps))) loop-steps)))) ((eq word (quote repeat)) (let ((temp= (make-symbol "--cl-var--"))) (push (list (list temp (pop loop-args))) loop= -bindings) (push (list (quote >=3D) (list (quote setq) temp (list (quote 1-= ) temp)) 0) loop-body))) ((memq word (quote (collect collecting))) (let ((w= hat (pop loop-args)) (var (cl-loop-handle-accum nil (quote nreverse)))) (if= (eq var loop-accum-var) (push (list (quote progn) (list (quote push) what = var) t) loop-body) (push (list (quote progn) (list (quote setq) var (list .= .. var ...)) t) loop-body)))) ((memq word (quote (nconc nconcing append app= ending))) (let ((what (pop loop-args)) (var (cl-loop-handle-accum nil (quot= e nreverse)))) (push (list (quote progn) (list (quote setq) var (if (eq var= loop-accum-var) (list ... ... var) (list ... var what))) t) loop-body))) (= (memq word (quote (concat concating))) (let ((what (pop loop-args)) (var (c= l-loop-handle-accum ""))) (push (list (quote progn) (list (quote callf) (qu= ote concat) var what) t) loop-body))) ((memq word (quote (vconcat vconcatin= g))) (let ((what (pop loop-args)) (var (cl-loop-handle-accum []))) (push (l= ist (quote progn) (list (quote callf) (quote vconcat) var what) t) loop-bod= y))) ((memq word (quote (sum summing))) (let ((what (pop loop-args)) (var (= cl-loop-handle-accum 0))) (push (list (quote progn) (list (quote incf) var = what) t) loop-body))) ((memq word (quote (count counting))) (let ((what (po= p loop-args)) (var (cl-loop-handle-accum 0))) (push (list (quote progn) (li= st (quote if) what (list (quote incf) var)) t) loop-body))) ((memq word (qu= ote (minimize minimizing maximize maximizing))) (let* ((what (pop loop-args= )) (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 (quote setq) var (list (quote if) var (list func var temp) = temp)))) (push (list (quote progn) (if (eq temp what) set (list (quote let)= (list ...) set)) t) loop-body))) ((eq word (quote with)) (let ((bindings n= il)) (while (progn (push (list (pop loop-args) (and ... ...)) bindings) (eq= (car loop-args) (quote and))) (pop loop-args)) (push (nreverse bindings) l= oop-bindings))) ((eq word (quote while)) (push (pop loop-args) loop-body)) = ((eq word (quote until)) (push (list (quote not) (pop loop-args)) loop-body= )) ((eq word (quote always)) (or loop-finish-flag (setq loop-finish-flag (m= ake-symbol "--cl-flag--"))) (push (list (quote setq) loop-finish-flag (pop = loop-args)) loop-body) (setq loop-result t)) ((eq word (quote never)) (or l= oop-finish-flag (setq loop-finish-flag (make-symbol "--cl-flag--"))) (push = (list (quote setq) loop-finish-flag (list (quote not) (pop loop-args))) loo= p-body) (setq loop-result t)) ((eq word (quote thereis)) (or loop-finish-fl= ag (setq loop-finish-flag (make-symbol "--cl-flag--"))) (or loop-result-var= (setq loop-result-var (make-symbol "--cl-var--"))) (push (list (quote setq= ) loop-finish-flag (list (quote not) (list (quote setq) loop-result-var (po= p loop-args)))) loop-body)) ((memq word (quote (if when unless))) (let* ((c= ond (pop loop-args)) (then (let ((loop-body nil)) (cl-parse-loop-clause) (c= l-loop-build-ands (nreverse loop-body)))) (else (let ((loop-body nil)) (if = (eq ... ...) (progn ... ...)) (cl-loop-build-ands (nreverse loop-body)))) (= simple (and (eq (car then) t) (eq (car else) t)))) (if (eq (car loop-args) = (quote end)) (pop loop-args)) (if (eq word (quote unless)) (setq then (prog= 1 else (setq else then)))) (let ((form (cons (if simple ... ...) (if simple= ... ...)))) (if (cl-expr-contains form (quote it)) (let ((temp ...)) (push= (list temp) loop-bindings) (setq form (list* ... ... ...))) (setq form (li= st* (quote if) cond form))) (push (if simple (list (quote progn) form t) fo= rm) loop-body)))) ((memq word (quote (do doing))) (let ((body nil)) (or (co= nsp (car loop-args)) (error "Syntax error on `do' clause")) (while (consp (= car loop-args)) (push (pop loop-args) body)) (push (cons (quote progn) (nre= verse (cons t body))) loop-body))) ((eq word (quote return)) (or loop-finis= h-flag (setq loop-finish-flag (make-symbol "--cl-var--"))) (or loop-result-= var (setq loop-result-var (make-symbol "--cl-var--"))) (push (list (quote s= etq) loop-result-var (pop loop-args) loop-finish-flag nil) loop-body)) (t (= let ((handler (and (symbolp word) (get word (quote cl-loop-handler))))) (or= handler (error "Expected a loop keyword, found %s" word)) (funcall handler= )))) (let ((word (pop loop-args)) (hash-types (quote (hash-key hash-keys hash-= value hash-values))) (key-types (quote (key-code key-codes key-seq key-seqs= key-binding key-bindings)))) (cond ((null loop-args) (error "Malformed `lo= op' macro")) ((eq word (quote named)) (setq loop-name (pop loop-args))) ((e= q word (quote initially)) (if (memq (car loop-args) (quote (do doing))) (po= p loop-args)) (or (consp (car loop-args)) (error "Syntax error on `initiall= y' clause")) (while (consp (car loop-args)) (push (pop loop-args) loop-init= ially))) ((eq word (quote finally)) (if (eq (car loop-args) (quote return))= (setq loop-result-explicit (or (cl-pop2 loop-args) (quote (quote nil)))) (= if (memq (car loop-args) (quote (do doing))) (pop loop-args)) (or (consp (c= ar loop-args)) (error "Syntax error on `finally' clause")) (if (and (eq (ca= ar loop-args) (quote return)) (null loop-name)) (setq loop-result-explicit = (or (nth 1 ...) (quote ...))) (while (consp (car loop-args)) (push (pop loo= p-args) loop-finally))))) ((memq word (quote (for as))) (let ((loop-for-bin= dings nil) (loop-for-sets nil) (loop-for-steps nil) (ands nil)) (while (let= ((var ...)) (setq word (pop loop-args)) (if (eq word ...) (setq word ...))= (if (memq word ...) (setq word ...)) (if (memq word ...) (setq word ... lo= op-args ...)) (cond (... ... ... ...) (... ...) (... ...) (... ...) (... ..= .) (... ... ...) (... ...) (... ...) (... ...) (... ... ...) (... ...) (...= ...) (t ...)) (eq (car loop-args) (quote and))) (setq ands t) (pop loop-ar= gs)) (if (and ands loop-for-bindings) (push (nreverse loop-for-bindings) lo= op-bindings) (setq loop-bindings (nconc (mapcar ... loop-for-bindings) loop= -bindings))) (if loop-for-sets (push (list (quote progn) (cl-loop-let ... .= .. ands) t) loop-body)) (if loop-for-steps (push (cons (if ands ... ...) (a= pply ... ...)) loop-steps)))) ((eq word (quote repeat)) (let ((temp (make-s= ymbol "--cl-var--"))) (push (list (list temp (pop loop-args))) loop-binding= s) (push (list (quote >=3D) (list (quote setq) temp (list ... temp)) 0) loo= p-body))) ((memq word (quote (collect collecting))) (let ((what (pop loop-a= rgs)) (var (cl-loop-handle-accum nil (quote nreverse)))) (if (eq var loop-a= ccum-var) (push (list (quote progn) (list ... what var) t) loop-body) (push= (list (quote progn) (list ... var ...) t) loop-body)))) ((memq word (quote= (nconc nconcing append appending))) (let ((what (pop loop-args)) (var (cl-= loop-handle-accum nil (quote nreverse)))) (push (list (quote progn) (list (= quote setq) var (if ... ... ...)) t) loop-body))) ((memq word (quote (conca= t concating))) (let ((what (pop loop-args)) (var (cl-loop-handle-accum ""))= ) (push (list (quote progn) (list (quote callf) (quote concat) var what) t)= loop-body))) ((memq word (quote (vconcat vconcating))) (let ((what (pop lo= op-args)) (var (cl-loop-handle-accum []))) (push (list (quote progn) (list = (quote callf) (quote vconcat) var what) t) loop-body))) ((memq word (quote = (sum summing))) (let ((what (pop loop-args)) (var (cl-loop-handle-accum 0))= ) (push (list (quote progn) (list (quote incf) var what) t) loop-body))) ((= memq word (quote (count counting))) (let ((what (pop loop-args)) (var (cl-l= oop-handle-accum 0))) (push (list (quote progn) (list (quote if) what (list= ... var)) t) loop-body))) ((memq word (quote (minimize minimizing maximize= maximizing))) (let* ((what (pop loop-args)) (temp (if (cl-simple-expr-p wh= at) what (make-symbol "--cl-var--"))) (var (cl-loop-handle-accum nil)) (fun= c (intern (substring ... 0 3))) (set (list (quote setq) var (list ... var .= .. temp)))) (push (list (quote progn) (if (eq temp what) set (list ... ... = set)) t) loop-body))) ((eq word (quote with)) (let ((bindings nil)) (while = (progn (push (list ... ...) bindings) (eq (car loop-args) (quote and))) (po= p loop-args)) (push (nreverse bindings) loop-bindings))) ((eq word (quote w= hile)) (push (pop loop-args) loop-body)) ((eq word (quote until)) (push (li= st (quote not) (pop loop-args)) loop-body)) ((eq word (quote always)) (or l= oop-finish-flag (setq loop-finish-flag (make-symbol "--cl-flag--"))) (push = (list (quote setq) loop-finish-flag (pop loop-args)) loop-body) (setq loop-= result t)) ((eq word (quote never)) (or loop-finish-flag (setq loop-finish-= flag (make-symbol "--cl-flag--"))) (push (list (quote setq) loop-finish-fla= g (list (quote not) (pop loop-args))) loop-body) (setq loop-result t)) ((eq= word (quote thereis)) (or loop-finish-flag (setq loop-finish-flag (make-sy= mbol "--cl-flag--"))) (or loop-result-var (setq loop-result-var (make-symbo= l "--cl-var--"))) (push (list (quote setq) loop-finish-flag (list (quote no= t) (list (quote setq) loop-result-var (pop loop-args)))) loop-body)) ((memq= word (quote (if when unless))) (let* ((cond (pop loop-args)) (then (let (.= ..) (cl-parse-loop-clause) (cl-loop-build-ands ...))) (else (let (...) (if = ... ...) (cl-loop-build-ands ...))) (simple (and (eq ... t) (eq ... t)))) (= if (eq (car loop-args) (quote end)) (pop loop-args)) (if (eq word (quote un= less)) (setq then (prog1 else (setq else then)))) (let ((form (cons ... ...= ))) (if (cl-expr-contains form (quote it)) (let (...) (push ... loop-bindin= gs) (setq form ...)) (setq form (list* ... cond form))) (push (if simple (l= ist ... form t) form) loop-body)))) ((memq word (quote (do doing))) (let ((= body nil)) (or (consp (car loop-args)) (error "Syntax error on `do' clause"= )) (while (consp (car loop-args)) (push (pop loop-args) body)) (push (cons = (quote progn) (nreverse (cons t body))) loop-body))) ((eq word (quote retur= n)) (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-var--"))= ) (or loop-result-var (setq loop-result-var (make-symbol "--cl-var--"))) (p= ush (list (quote setq) loop-result-var (pop loop-args) loop-finish-flag nil= ) loop-body)) (t (let ((handler (and (symbolp word) (get word ...)))) (or h= andler (error "Expected a loop keyword, found %s" word)) (funcall handler))= )) (if (eq (car loop-args) (quote and)) (progn (pop loop-args) (cl-parse-lo= op-clause)))) cl-parse-loop-clause() (while (not (eq (car loop-args) (quote cl-end-loop))) (cl-parse-loop-clau= se)) (let ((loop-name nil) (loop-bindings nil) (loop-body nil) (loop-steps nil= ) (loop-result nil) (loop-result-explicit nil) (loop-result-var nil) (loop-= finish-flag nil) (loop-accum-var nil) (loop-accum-vars nil) (loop-initially= nil) (loop-finally nil) (loop-map-form nil) (loop-first-flag nil) (loop-de= str-temps nil) (loop-symbol-macs nil)) (setq loop-args (append loop-args (q= uote (cl-end-loop)))) (while (not (eq (car loop-args) (quote cl-end-loop)))= (cl-parse-loop-clause)) (if loop-finish-flag (push (\` (((\, loop-finish-f= lag) t))) loop-bindings)) (if loop-first-flag (progn (push (\` (((\, loop-f= irst-flag) t))) loop-bindings) (push (\` (setq (\, loop-first-flag) nil)) l= oop-steps))) (let* ((epilogue (nconc (nreverse loop-finally) (list (or loop= -result-explicit loop-result)))) (ands (cl-loop-build-ands (nreverse loop-b= ody))) (while-body (nconc (cadr ands) (nreverse loop-steps))) (body (append= (nreverse loop-initially) (list (if loop-map-form (list ... ... ...) (list= * ... ... while-body))) (if loop-finish-flag (if (equal epilogue ...) (list= loop-result-var) (\` ...)) epilogue)))) (if loop-result-var (push (list lo= op-result-var) loop-bindings)) (while loop-bindings (if (cdar loop-bindings= ) (setq body (list (cl-loop-let (pop loop-bindings) body t))) (let ((lets n= il)) (while (and loop-bindings (not ...)) (push (car ...) lets)) (setq body= (list (cl-loop-let lets body nil)))))) (if loop-symbol-macs (setq body (li= st (list* (quote symbol-macrolet) loop-symbol-macs body)))) (list* (quote b= lock) loop-name body))) (if (not (memq t (mapcar (quote symbolp) (delq nil (delq t (copy-list loo= p-args)))))) (list (quote block) nil (list* (quote while) t loop-args)) (le= t ((loop-name nil) (loop-bindings nil) (loop-body nil) (loop-steps nil) (lo= op-result nil) (loop-result-explicit nil) (loop-result-var nil) (loop-finis= h-flag nil) (loop-accum-var nil) (loop-accum-vars nil) (loop-initially nil)= (loop-finally nil) (loop-map-form nil) (loop-first-flag nil) (loop-destr-t= emps nil) (loop-symbol-macs nil)) (setq loop-args (append loop-args (quote = (cl-end-loop)))) (while (not (eq (car loop-args) (quote cl-end-loop))) (cl-= parse-loop-clause)) (if loop-finish-flag (push (\` (((\, loop-finish-flag) = t))) loop-bindings)) (if loop-first-flag (progn (push (\` ((... t))) loop-b= indings) (push (\` (setq (\, loop-first-flag) nil)) loop-steps))) (let* ((e= pilogue (nconc (nreverse loop-finally) (list (or loop-result-explicit loop-= result)))) (ands (cl-loop-build-ands (nreverse loop-body))) (while-body (nc= onc (cadr ands) (nreverse loop-steps))) (body (append (nreverse loop-initia= lly) (list (if loop-map-form ... ...)) (if loop-finish-flag (if ... ... ...= ) epilogue)))) (if loop-result-var (push (list loop-result-var) loop-bindin= gs)) (while loop-bindings (if (cdar loop-bindings) (setq body (list (cl-loo= p-let ... body t))) (let ((lets nil)) (while (and loop-bindings ...) (push = ... lets)) (setq body (list ...))))) (if loop-symbol-macs (setq body (list = (list* (quote symbol-macrolet) loop-symbol-macs body)))) (list* (quote bloc= k) loop-name body)))) (lambda (&rest loop-args) "The Common Lisp `loop' macro.\nValid clauses a= re:\n for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by N= UM,\n for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR =3D INIT t= hen EXPR,\n for VAR across ARRAY, repeat NUM, with VAR =3D INIT, while CON= D, until COND,\n always COND, never COND, thereis COND, collect EXPR into = VAR,\n append EXPR into VAR, nconc EXPR into VAR, sum EXPR into VAR,\n co= unt EXPR into VAR, maximize EXPR into VAR, minimize EXPR into VAR,\n if CO= ND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...],\n unless COND CLAUS= E [and CLAUSE]... else CLAUSE [and CLAUSE...],\n do EXPRS..., initially EX= PRS..., finally EXPRS..., return EXPR,\n finally return EXPR, named NAME.\= n\n(fn CLAUSE...)" (if (not (memq t (mapcar (quote symbolp) (delq nil (delq= t (copy-list loop-args)))))) (list (quote block) nil (list* (quote while) = t loop-args)) (let ((loop-name nil) (loop-bindings nil) (loop-body nil) (lo= op-steps nil) (loop-result nil) (loop-result-explicit nil) (loop-result-var= nil) (loop-finish-flag nil) (loop-accum-var nil) (loop-accum-vars nil) (lo= op-initially nil) (loop-finally nil) (loop-map-form nil) (loop-first-flag n= il) (loop-destr-temps nil) (loop-symbol-macs nil)) (setq loop-args (append = loop-args (quote (cl-end-loop)))) (while (not (eq (car loop-args) (quote cl= -end-loop))) (cl-parse-loop-clause)) (if loop-finish-flag (push (\` ((... t= ))) loop-bindings)) (if loop-first-flag (progn (push (\` (...)) loop-bindin= gs) (push (\` (setq ... nil)) loop-steps))) (let* ((epilogue (nconc (nrever= se loop-finally) (list ...))) (ands (cl-loop-build-ands (nreverse loop-body= ))) (while-body (nconc (cadr ands) (nreverse loop-steps))) (body (append (n= reverse loop-initially) (list ...) (if loop-finish-flag ... epilogue)))) (i= f loop-result-var (push (list loop-result-var) loop-bindings)) (while loop-= bindings (if (cdar loop-bindings) (setq body (list ...)) (let (...) (while = ... ...) (setq body ...)))) (if loop-symbol-macs (setq body (list (list* ..= . loop-symbol-macs body)))) (list* (quote block) loop-name body)))))(for rm= s in nil when t do (loop for (gnu . emacs) in nil) end) #((loop for rms in nil when t do (loop for (gnu . emacs= ) in nil) end) nil) macroexpand((loop for rms in nil when t do (loop for (gnu . emacs) in nil= ) end)) eval-defun-2() eval-defun(nil) call-interactively(eval-defun nil nil) --=-=-= Content-Type: text/plain (loop for (gnu . emacs) in nil) is parsed and executed correctly, so is (loop for rms in nil do (loop for (gnu . emacs) in nil)) Christopher --=-=-=--