loop-func.l

(defmacro dolist (vars &rest forms)
  (let ((lists (gensym "DOLIST"))
        (loop-tag (gensym "DOLIST"))
        (maybe-decl (car forms)))
    (if (and (consp maybe-decl) (eq (car maybe-decl) 'declare))
        (setq forms (cdr forms))
        (setq maybe-decl nil))
    `(block nil
       (let ((,(car vars) nil)
             (,lists ,(cadr vars)))
         ,maybe-decl
         (tagbody ,loop-tag
            (if (not (endp ,lists))
                (tagbody
                  (setq ,(car vars) (pop ,lists))
                  ,@forms
                  (go ,loop-tag))))
         ,(caddr vars)
         ))))

(defmacro dotimes (vars &rest forms)
  (let ((endvar (gensym "DOTIMES"))
        (loop-tag (gensym "DOTIMES")))
    `(block nil
       (let ((,(car vars) 0)
             (,endvar ,(cadr vars)))
         (declare (integer ,(car vars) ,endvar))
         (tagbody ,loop-tag
            (if (> ,endvar ,(car vars))
                (tagbody
                   ,@forms
                   (setq ,(car vars) (1+ ,(car vars)))
                   (go ,loop-tag))))
         ,(caddr vars)
         ))))

loop-test.l

#!/usr/bin/env roseus
;; loop-test.l
;; Author: furushchev <[email protected]>



(defun iota (n)
  (let ((l (make-sequence cons n)))
    (dotimes (i n)
      (setf (elt l i) i))
    l))

(setq ndolist 10000
      ndotimes 1000000)

(warn "~%")
(warning-message 1 "DOLIST WHILE~%")
(print (dolist (i (iota 5) 'retval) (print i)))
(pprint (macroexpand '(dolist (i (iota ndolist)))))
(bench (dolist (i (iota ndolist))))

(warning-message 1 "DOTIMES WHILE~%")
(dotimes (i 5) (print i))
(pprint (macroexpand '(dotimes (i ndotimes))))
(bench (dotimes (i ndotimes)))

(compiler:compile-file-if-src-newer "loop-func")
(load "loop-func")

(warning-message 1 "DOLIST TAGBODY~%")
(print (dolist (i (iota 5) 'retval) (print i)))
(pprint (macroexpand '(dolist (i (iota ndolist)))))
(bench (dolist (i (iota ndolist))))

(warning-message 1 "DOTIMES TAGBODY~%")
(dotimes (i 5) (print i))
(pprint (macroexpand '(dotimes (i ndotimes))))
(bench (dotimes (i ndotimes)))

output

$ roseus loop-test.l
configuring by "/home/furushchev/ros/kinetic_parent/devel/share/euslisp/jskeus/eus//lib/eusrt.l"
;; readmacro ;; object ;; packsym ;; common ;; constants ;; stream ;; string ;; loader ;; pprint ;; process ;; hashtab ;; array ;; mathtran ;; eusdebug ;; eusforeign ;; coordinates ;; tty ;; history ;; toplevel ;; trans ;; comp ;; builtins ;; par ;; intersection ;; geoclasses ;; geopack ;; geobody ;; primt ;; compose ;; polygon ;; viewing ;; viewport ;; viewsurface ;; hid ;; shadow ;; bodyrel ;; dda ;; helpsub ;; eushelp ;; xforeign ;; Xdecl ;; Xgraphics ;; Xcolor ;; Xeus ;; Xevent ;; Xpanel ;; Xitem ;; Xtext ;; Xmenu ;; Xscroll ;; Xcanvas ;; Xtop ;; Xapplwin 
connected to Xserver DISPLAY=:0
X events are being asynchronously monitored.
;; pixword ;; RGBHLS ;; convolve ;; piximage ;; pbmfile ;; image_correlation ;; oglforeign ;; gldecl ;; glconst ;; glforeign ;; gluconst ;; gluforeign ;; glxconst ;; glxforeign ;; eglforeign ;; eglfunc ;; glutil ;; gltexture ;; glprim ;; gleus ;; glview ;; toiv-undefined ;; fstringdouble irtmath irtutil irtc irtgeoc irtgraph ___time ___pgsql irtgeo euspqp pqp irtscene irtmodel irtdyna irtrobot irtsensor irtbvh irtcollada irtpointcloud irtx eusjpeg euspng png irtimage irtglrgb 
;; extending gcstack 0x48fc8c0[16374] --> 0x4d7c010[32748] top=3d57
irtgl irtglc irtviewer 
EusLisp 9.23(b7c1616 1.1.0) for Linux64 created on mochi(Sat Jul 14 01:45:18 JST 2018)
roseus ;; loading roseus("1.7.0-2-g7b6a882") on euslisp((9.23 mochi Sat Jul 14 01:45:18 JST 2018 b7c1616 1.1.0))
eustf roseus_c_util 
DOLIST WHILE
0
1
2
3
4
retval
(let
   ((i nil) (#:dolist360 (iota ndolist)))
   nil
   (while #:dolist360 (setq i (pop #:dolist360)))
   nil)
;; time -> 0.161214[s]
DOTIMES WHILE
0
1
2
3
4
(let
   ((i 0) (#:dotimes10368 ndotimes))
   (declare (integer i #:dotimes10368))
   (while (< i #:dotimes10368) (setq i (1+ i)))
   nil)
;; time -> 0.070899[s]
DOLIST TAGBODY
0
1
2
3
4
retval
(block
   nil
   (let
      ((i nil) (#:dolist10383 (iota ndolist)))
      nil
      (tagbody
         #:dolist10384
         (if
            (not (endp #:dolist10383))
            (tagbody (setq i (pop #:dolist10383)) (go #:dolist10384))))
      nil))
;; time -> 0.127658[s]
DOTIMES TAGBODY
0
1
2
3
4
(block
   nil
   (let
      ((i 0) (#:dotimes20395 ndotimes))
      (declare (integer i #:dotimes20395))
      (tagbody
         #:dotimes20396
         (if
            (> #:dotimes20395 i)
            (tagbody (setq i (1+ i)) (go #:dotimes20396))))
      nil))
;; time -> 0.146699[s]
1.irteusgl$

(defmacro dolist (vars &rest forms)
  (let ((lists (gensym "DOLIST"))
        (loop-tag (gensym "DOLIST"))
        (maybe-decl (car forms)))
    (if (and (consp maybe-decl) (eq (car maybe-decl) 'declare))
        (setq forms (cdr forms))
        (setq maybe-decl nil))
    `(block nil
       (let ((,(car vars) nil)
             (,lists ,(cadr vars)))
         ,maybe-decl
         (tagbody ,loop-tag
            (if (endp ,lists)
		(setq ,(car vars) nil)
		(progn
		  (setq ,(car vars) (pop ,lists))
		  (tagbody
		     ,@forms
		     (go ,loop-tag)))))
         ,(caddr vars)
         ))))

(defmacro dotimes (vars &rest forms)
  (let ((endvar (gensym "DOTIMES"))
        (loop-tag (gensym "DOTIMES")))
    `(block nil
       (let ((,(car vars) 0)
             (,endvar ,(cadr vars)))
         (declare (integer ,(car vars) ,endvar))
         (tagbody ,loop-tag
            (if (> ,endvar ,(car vars))
                (tagbody
                  ,@forms
                  (setq ,(car vars) (1+ ,(car vars)))
                  (go ,loop-tag))))
         ,(caddr vars)
         ))))