From Newsgroup: comp.lang.lisp

B. Pym wrote:

Re: Most impressive examples of the LOOP macro

Peter Seibel wrote:

; Prints the first 16 rows of Pascal's triangle
; not tested, I'm writing it from memory right here!
(loop repeat 16
for list = '(1) then (mapcar #'+ (cons 0 list) (append list
'(0)))
do (format t "~{~6D~^,~}~%" list))

That's definitely one of the most beautiful pieces of code I've ever written. I wrote it for a programming language comparison contest,
and blew every other language out of the water, except Mathematica,
of course. ;-)

Hmmm. I'm not sure any code that repeatedly APPENDs to the end of a
growing list can be all that elegant. If you're into this sort of
thin, both the versions below, while slightly longer in terms of
number of characters than yours, are, I'd argue, algorithmically more elegant:

(loop repeat 16 for list = '(1)
then (maplist #'(lambda (cons) (+ (car cons) (or (cadr cons) 0))) (cons 0 l
ist))
do (format t "~{~6D~^,~}~%" list))

He uses
#'(lambda
instead of
(lambda

(loop repeat 16 for list = '(1)
then (maplist #'(lambda (cons) (apply #'+ (ldiff cons (cddr cons)))) (cons
0 list))
do (format t "~{~6D~^,~}~%" list))

Gauche Scheme

(do ((row '(1) (map + `(0 ,@row) `(,@row 0))))
((> (length row) 16))
(print (string-join (map (pa$ format #f "~5@a") row) ",")))

1
1, 1
1, 2, 1
1, 3, 3, 1
1, 4, 6, 4, 1
1, 5, 10, 10, 5, 1
1, 6, 15, 20, 15, 6, 1
1, 7, 21, 35, 35, 21, 7, 1
1, 8, 28, 56, 70, 56, 28, 8, 1
1, 9, 36, 84, 126, 126, 84, 36, 9, 1
1, 10, 45, 120, 210, 252, 210, 120, 45, 10, 1
1, 11, 55, 165, 330, 462, 462, 330, 165, 55, 11, 1

Etc.

"!" is similar to "do".

(! (row '(1) (map + `(0 ,@row) `(,@row 0))
:repeat 13)
#f ! print (string-join (map (pa$ format "~5@a") row) ","))

Given:

(define (!-flatten it)
(if (null? it) '()
(if (pair? it)
(append (flatten (car it)) (flatten (cdr it)))
(list it))))

(define-syntax !-aux
(syntax-rules (<> @ @@ + - : cons append :meld
cdr :in :across :along
:on :by :pop-or-nothing
:if :if-else ! :also? :also :to :repeat
:till :always
->lets :let := )
[(_ specs seen lets @)
(!-aux specs seen lets #f @) ]
[(_ (->lets ((id val) ...) z ...) seen (lets ...) stuff ...)
(!-aux (z ...) seen (lets ... (id val) ...) stuff ...) ]
[(_ (:let id val z ...) stuff ...)
(!-aux (->lets ((id val)) z ...) stuff ...) ]
[(_ (:= id val z ...) stuff ...)
(!-aux (:let id #f dummy #f (set! id val) z ...) stuff ...) ]
;;
[(_ (:also? bool op x z ...) (seen ... (v i update)) stuff ...)
(!-aux (z ...)
(seen ... (v i (if bool (op x update) update)))
stuff ...) ]
[(_ (:also op x z ...) stuff ...)
(!-aux (:also? #t op x z ...) stuff ...) ]
;;
[(_ ((:pop-or-nothing x xs nil) z ...) stuff ...)
(!-aux (x (if (pair? xs)(pop! xs) nil) <> z ...) stuff ...) ]
;;
;;
[(_ (:always expr z ...) seen lets bool)
(!-aux (ok #t expr
:till (not ok)
z ...)
seen lets bool ok
) ]
[(_ (:always expr z ...) stuff ...)
(!-aux " * * * Bad usage of :always in !") ]
[(_ (:till expr z ...) seen lets #f stuff ...)
(!-aux (z ...) seen lets expr stuff ...) ]
[(_ (:till expr z ...) seen lets bool stuff ...)
(!-aux (z ...) seen lets (or expr bool) stuff ...) ]
;;
[(_ (:if bool z ...) (seen ... (v i u)) stuff ...)
(!-aux (z ...)
(seen ... (v i (if bool u v))) stuff ...) ]
;;
[(_ (:if-else bool z ...) (seen ... (a b c)(d e f)) stuff ...)
(!-aux (:let yes #f z ...)
(seen ... (a b (begin (set! yes bool) (if yes c a)))
(d e (if (not yes) f d))) stuff ...) ]
;;
[(_ ((a b ...) :on lst :by kdr z ...) stuff ...)
(!-aux (:let xs lst
:let ys #f
exhausted (null? xs) <>
dummy (begin (set! ys xs)
(when (pair? xs) (set! xs (kdr xs)))) <>
(:pop-or-nothing a ys #f)
(:pop-or-nothing b ys #f) ...
:till exhausted
z ...) stuff ...) ]
[(_ ((a b ...) :on lst z ...) stuff ...)
(!-aux ((a b ...) :on lst :by cdr z ...) stuff ...) ]
;;
[(_ ((c d ...) :in lst z ...) stuff ...)
(!-aux (->lets ((xs lst) (c #f) (d #f) ...)
dummy (if (pair? xs)
(set!-values (c d ...)(apply values (!-flatten(pop! xs))))
(set! c !-aux)) <>
:till (eq? c !-aux)
z ...) stuff ...) ]
[(_ (x :in lst z ...) stuff ...)
(!-aux (:let xs lst
x (if (pair? xs)(pop! xs) !-aux) <>
:till (eq? x !-aux)
z ...) stuff ...) ]
;;
[(_ (x :across vec z ...) stuff ...)
(!-aux (:let v vec :let i 0
x (if (< i (vector-length v))
(begin0 (vector-ref v i) (inc! i))
!-aux) <>
:till (eq? x !-aux)
z ...) stuff ...) ]
[(_ (ch :along str z ...) stuff ...)
(!-aux (:let s str :let i 0
ch (and (< i (string-length s))
(begin0 (string-ref s i) (inc! i))) <>
:till (not ch)
z ...)
stuff ...) ]
[(_ (a b <> z ...) stuff ...)
(!-aux (a b b z ...) stuff ...) ]
;;
[(_ (a b + z ...) stuff ...)
(!-aux (a b (+ 1 a) z ...) stuff ...) ]
[(_ (a + n z ...) stuff ...)
(!-aux (a 0 (+ n a) z ...) stuff ...) ]
[(_ (a b - z ...) stuff ...)
(!-aux (a b (- a 1) z ...) stuff ...) ]
[(_ (n lo inc :to hi z ...) stuff ...)
(!-aux (:let step inc :let high hi
n lo (+ n step)
:till (> n high)
z ...) stuff ...) ]
[(_ (n lo :to hi z ...) stuff ...)
(!-aux (n lo 1 :to hi z ...) stuff ...) ]
[(_ (:repeat n z ...) stuff ...)
(!-aux (m 1 :to n z ...) stuff ...) ]
;;
[(_ (v init : kons u z ...) stuff ...)
(!-aux (v init (kons u v) z ...) stuff ...) ]
;;
[(_ (a cons b z ...) stuff ...)
(!-aux (a '() : cons b z ...) stuff ...) ]
[(_ (a append b z ...) stuff ...)
(!-aux (a '() : append (reverse b) z ...) stuff ...) ]
[(_ (a :meld b z ...) stuff ...)
(!-aux (a '()
(if (pair? b) (append (reverse b) a)
(cons b a))
z ...) stuff ...) ]
;;
[(_ (a b cdr z ...) stuff ...)
(!-aux (a b (cdr a) z ...) stuff ...) ]
[(_ (a b c z ...) (seen ...) stuff ...)
(!-aux (z ...) (seen ... (a b c)) stuff ...) ]
[(_ (a b) (seen ...) stuff ...)
(!-aux () (seen ... (a b)) stuff ...) ]
[(_ (a) (seen ...) stuff ...)
(!-aux () (seen ... (a '())) stuff ...) ]
;; Default action is print first variable.
[(_ () ((a b c) z ...) lets bool !)
(!-aux () ((a b c) z ...) lets bool ! print a) ]
;; (!-aux () ((a b c) z ...) lets bool ! begin (print a)(sys-sleep 1)) ]
[(_ () seen lets bool ! action ...)
(!-aux () seen lets bool #t (action ...)) ]
;; If result not specified, pick one.
[(_ () ((a b c) z ...) lets bool)
(!-aux () ((a b c) z ...) lets bool
(if (pair? a) (reverse a) a)) ]
[(_ () ((a b c) z ...) lets bool @)
(!-aux () ((a b c) z ...) lets bool (reverse a)) ]
[(_ () seen lets bool @ result stuff ...)
(!-aux () seen lets bool (reverse result) stuff ...) ]
;;
[(_ () seen lets bool @@ (what x ...) stuff ...)
(!-aux () seen lets bool (what (reverse x) ...) stuff ...) ]
[(_ () seen lets bool (what @ x z ...) stuff ...)
(!-aux () seen lets bool (what (reverse x) z ...) stuff ...) ]
[(_ () seen lets bool (what x @ y z ...) stuff ...)
(!-aux () seen lets bool (what x (reverse y) z ...) stuff ...) ]
;;
[(_ () ((a b c) z ...) lets 0 stuff ...)
(!-aux () ((a b c) z ...) lets (= 0 a) stuff ...) ]
[(_ () seen lets bool result stuff ...)
(let lets (do seen (bool result) stuff ...)) ]
))
(define-syntax !
(syntax-rules ()
[(_ specs bool stuff ...)
(!-aux specs () () bool stuff ...) ]
[(_ specs) (! specs #f) ]
))
--- Synchronet 3.21a-Linux NewsLink 1.2