From Newsgroup: comp.lang.lisp

Simon Alexander wrote:

(defun sum-of-list (list)
(loop for x in list summing x))

Ridiculous. This is a job for reduce or fold.

Scheme:

(reduce + #f '(1 3 5 7 9))
===>
25

Paul Graham:

I consider Loop one of the worst flaws in CL, and an example
to be borne in mind by both macro writers and language designers.


Using my supercharged do*:

(let1 List '(1 3 5 7 9)
(do* ((s :+ x)
(x :in List))))

(define-syntax do*-aux
(syntax-rules ( <> @ :in :on :across :to-till :su :+ :cons :* : )
;; Simultaneous updates.
[ (do*-aux ((:su (v i u) ...) z ...) stuff ...)
(do*-aux ((v i) ...
(dummy #f
(set!-values (v ...) (apply values (list u ...))))
z ...) stuff ...) ]
[ (do*-aux ((:to-till a ...) z ...) lets sets (bool r ...) stuff ...)
(do*-aux (z ...) lets sets ((or a ... bool) r ...) stuff ...) ]
[ (do*-aux ((v i : fn u) z ...) stuff ...)
(do*-aux ((v i (fn u v)) z ...) stuff ...) ]
[ (do*-aux ((v : fn u) z ...) stuff ...)
(do*-aux ((v #f : fn u) z ...) stuff ...) ]
[ (do*-aux ((v :+ u ...) z ...) stuff ...)
(do*-aux ((v 0 :+ u ...) z ...) stuff ...) ]
[ (do*-aux ((v i :+ u) z ...) stuff ...)
(do*-aux ((v i (+ v u)) z ...) stuff ...) ]
[ (do*-aux ((v i :+ u ...) z ...) stuff ...)
(do*-aux ((v i (+ v (u ...))) z ...) stuff ...) ]
[ (do*-aux ((v :cons u) z ...) stuff ...)
(do*-aux ((v '() (cons u v)) z ...) stuff ...) ]
[ (do*-aux ((v i :cons u) z ...) stuff ...)
(do*-aux ((v i (cons u v)) z ...) stuff ...) ]
[ (do*-aux ((v :* u) z ...) stuff ...)
(do*-aux ((v 1 :* u) z ...) stuff ...) ]
[ (do*-aux ((v i :* u) z ...) stuff ...)
(do*-aux ((v i (* v u)) z ...) stuff ...) ]
[ (do*-aux s lets sets (bool more ... @ r) body ...)
(do*-aux s lets sets (bool more ... (reverse r)) body ...) ]
[ (do*-aux ((e :across sequence) z ...) stuff ...)
(do*-aux ((:to-till (= i size))
(seq sequence)
(size (if (vector? seq) (vector-length seq)(string-length seq)))
(i 0 (+ i 1))
(e (ref seq i #f) <> ) z ...) stuff ...) ]
[ (do*-aux (((v ...) :on xs) z ...) stuff ...)
(do*-aux ((:to-till (null? xlist) (begin (set! v (pop~ xlist)) ... #f))
(xlist xs) (v #f) ... z ...) stuff ...) ]
[ (do*-aux ((ys :on xs kdr) z ...) stuff ...)
(do*-aux ((:to-till (null? ys))
(ys xs (kdr ys)) z ...) stuff ...) ]
[ (do*-aux ((ys :on xs) z ...) stuff ...)
(do*-aux ((ys :on xs cdr) z ...) stuff ...) ]
[ (do*-aux (((v ...) :in xs) z ...) stuff ...)
(do*-aux ((:to-till (null? xlist))
(xlist xs (cdr xlist))
(v #f) ...
(dummy (and (pair? xlist)
(set!-values (v ...) (apply values (car xlist))))
<>) z ...) stuff ...) ]
[ (do*-aux ((x :in xs) z ...) stuff ...)
(do*-aux ((:to-till (null? xlist))
(xlist xs (cdr xlist))
(x (and (pair? xlist) (car xlist)) <> )
z ...) stuff ...) ]
[ (do*-aux ((hd tl :in xs) z ...) stuff ...)
(do*-aux ((:to-till (null? xlist))
(xlist xs (cdr xlist))
(hd (and (pair? xlist) (car xlist)) <> )
(tl (and (pair? xlist) (cdr xlist)) <> )
z ...) stuff ...) ]
[ (do*-aux ((var init <>) z ...) stuff ...)
(do*-aux ((var init init) z ...) stuff ...) ]
[ (do*-aux ((var init update) z ...) (lets ...) (sets ...) stuff ...)
(do*-aux (z ...) (lets ... (var init))
(sets ... (set! var update)) stuff ...) ]
[ (do*-aux ((var init) z ...) (lets ...) stuff ...)
(do*-aux (z ...) (lets ... (var init)) stuff ...) ]
;; If no return value specified, pick the first.
[ (do*-aux () lets ((set v x) sets ...) (bool) body ...)
(do*-aux () lets ((set v x) sets ...) (bool v) body ...) ]
;;
[ (do*-aux () (lets ...) (sets ...) (bool more ...) body ...)
(let* (lets ...)
(if bool
(begin more ...)
(begin
body ...
(let go ()
sets ...
(if bool
(begin more ...)
(begin body ... (go))))))) ] ))

(define-syntax do*
(syntax-rules ( )
[ (do* specs)
(do* specs ()) ]
[ (do* specs () z ...)
(do* specs (#f) z ...) ]
[ (do* specs till body ...)
(do*-aux specs () () till body ...) ] ))
--
[T]he problem is that lispniks are as cultish as any other
devout group and basically fall down frothing at the mouth if
they see [heterodoxy]. --- Kenny Tilton (05 Dec 2004)
--- Synchronet 3.21a-Linux NewsLink 1.2