GNU bug report logs - #7408
23.2.1 dolist -- subr.el and cl-macs differ with nil-block return

Previous Next

Full log

Message #67 received at 7408 <at> debbugs.gnu.org (full text, mbox):

From: MON KEY <monkey <at> sandpframing.com>
To: 7408 <at> debbugs.gnu.org
Cc: Štěpán Němec <stepnem <at> gmail.com>,
	Stefan Monnier <monnier <at> iro.umontreal.ca>, jari.aalto <at> cante.net
Subject: bug#7408: Linux patchutils: Development of the project?
Date: Sun, 21 Nov 2010 18:19:13 -0500

> Show me a piece of code which would work with CL's dolist (but without
> CL's return) and yet doesn't work with subr.el's dolist.

Well, FWIW following is the toplevel/main interface to my elisp
implementation of Steel Bank Common Lisp's `map1' which in turn is
that implementation's high-level driver for its portable Common Lisp
mapping procedures.

Among other things, my port to elisp required adding a cath/throw
inside of a dolist b/c Elisp's `dolist' doesn't have `return'.

Indeed, I was as surprised by the same `dolist' disconnect which Jari
is currently poking at. What I found troubling was the process
required to locate the locus of this disconnect...  In so much as
Elisp code transitions silently between the two versions of dolist it
should do transparently.

BTW - the impetus for this routine was w/re incorporating more cl seq
fun into core but without the keyword overhead...

;;; :COURTESY SBCL :FILE sbcl/src/code/list.lisp
(defun mon-map1 (fun-designator original-arglists accumulate take-car)
  (unless
      (functionp fun-designator)
    (error (concat ":FUNCTION `mon-map1' "
                   "-- arg FUN-DESIGNATOR does not satisfy `functionp'")))
  (let* ((mmp1-arg-lsts (mon-copy-list-mac original-arglists))
         (mmp1-rtn-list (list nil))
         (mmp1-tmp mmp1-rtn-list))
    (do ((mmp1-rslt nil)
         (mmp1-args '() '()))
        ((catch 'is-null ;; :ADDED
           (dolist (mmp1-thrw mmp1-arg-lsts nil)
             (when (null mmp1-thrw) ;; :WAS (return t)))
               (throw 'is-null t))))
         (if accumulate
             (cdr mmp1-rtn-list)
           (car original-arglists)))
      (do ((mmp1-arg-l mmp1-arg-lsts (cdr mmp1-arg-l)))
          ((null mmp1-arg-l))
        (push (if take-car (caar mmp1-arg-l) (car mmp1-arg-l)) mmp1-args)
        (setf (car mmp1-arg-l) (cdar mmp1-arg-l)))
      (setq mmp1-rslt
            (apply fun-designator (nreverse mmp1-args)))
      (case accumulate
        (:nconc (setq mmp1-tmp (last (nconc mmp1-tmp mmp1-rslt))))
        (:list (setcdr mmp1-tmp (list mmp1-rslt))
               (setq mmp1-tmp (cdr mmp1-tmp)))))))

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.