From Newsgroup: comp.lang.lisp
B. Pym wrote:
B. Pym wrote:
Nathan Baum wrote:
Suppose you have
(loop for x in (get-list)
do (format t "~A~%" x))
and then it turns out you need to print a numeric index. You can do
(loop for x in (get-list)
for i from 0
do (format t "~A - ~A~%" i x))
If you start with
(mapc (lambda (x) (format t "~A~%" x)) (get-list))
it seems (to me) that it'd be harder to modify it as needed,
(let ((list (get-list)))
(mapc (lambda (i x) (format t "~A - ~A" i x))
(range 0 (length list))
list))
(I'm assuming the toolkit includes a RANGE utility, or something similar.)
Gauche Scheme
Shorter than the loop:
(for-each
(cut print <> " - " <>)
(lrange 0)
'(a b c))
0 - a
1 - b
2 - c
(for-each
(cut print <> " - " <> " - " <>)
(lrange 0)
'(a b c)
'(! ? @))
0 - a - !
1 - b - ?
2 - c - @
(use srfi-42) ; do-ec
(do-ec (:list x (index i) '(a b c)) (print i " - " x))
0 - a
1 - b
2 - c
Gauche Scheme
"!" is similar to "do".
(! (x :in '(a b c d)
i +)
#f ! print i " - " x)
0 - a
1 - b
2 - c
3 - d
Nathan Baum wrote:
Then suppose you later need the loop/map to collect some of the values under certain conditions. You might have
(loop for x in (get-list)
for i from 0
do (format t "~A - ~A~%" i x)
if (test x)
collect (foo x))
Gauche Scheme
(use srfi-42)
(list-ec (:list x (index i) '(0 -2 3 4 -7 9))
(begin (print i " : " x))
(if (negative? x))
(abs x))
0 : 0
1 : -2
2 : 3
3 : 4
4 : -7
5 : 9
(2 7)
(! (r cons (square x) :if (odd? x)
x :in '(2 3 4 5)
i +)
#f @ r
(print i " - " x))
0 - 2
1 - 3
2 - 4
3 - 5
(9 25)
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 :gen :minimize :maximize
->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 ...) ]
[(_ (:if bool z ...) stuff ...)
(!-aux
" * * * :if used at bad location in '!'; it's postfix.") ]
[(_ (:if-else bool z ...) stuff ...)
(!-aux
" * * * :if-else used without 2 preceding assignments in '!'") ]
;;
[(_ (w :gen func z ...) stuff ...)
(!-aux (:let fun func
w (fun) (fun)
:till (eof-object? w) z ...) stuff ...) ]
;;
[(_ ((a b ...) :on lst :by kdr z ...) stuff ...)
(!-aux (:let xs lst
:let ys #f
dummy (set! ys xs) <>
(:pop-or-nothing a ys #f)
(:pop-or-nothing b ys #f) ...
:till (or (null? xs) (begin (set! xs (kdr xs)) #f))
z ...) stuff ...) ]
[(_ ((a b ...) :on lst z ...) stuff ...)
(!-aux ((a b ...) :on lst :by cdr z ...) stuff ...) ]
;;
[(_ ((y . ys) :on lst :by kdr z ...) stuff ...)
(!-aux (:let xs lst
y (if (null? xs) #f (car xs)) <>
ys (if (null? xs) #f (cdr xs)) <>
:till (or (null? xs) (begin (pop! xs) #f))
z ...) stuff ...) ]
[(_ ((y . ys) :on lst z ...) stuff ...)
(!-aux ((y . ys) :on lst :by cdr z ...) stuff ...) ]
;;
[(_ (s :on lst :by kdr z ...) stuff ...)
(!-aux (s lst (kdr s)
:till (null? s) z ...) stuff ...) ]
[(_ (s :on lst z ...) stuff ...)
(!-aux (s :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 :by kdr z ...) stuff ...)
(!-aux (:let xs lst
x (if (pair? xs)
(begin0 (car xs) (set! xs (kdr xs)))
!-aux) <>
:till (eq? x !-aux)
z ...) stuff ...) ]
[(_ (x :in lst z ...) stuff ...)
(!-aux (x :in lst :by cdr 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 ...) ]
;;
[(_ (mi :minimize u z ...) stuff ...)
(!-aux (mi #f (if mi (min mi u) u) z ...) stuff ...) ]
[(_ (ma :maximize u z ...) stuff ...)
(!-aux (ma #f (if ma (max ma u) u) 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 +) (seen ...) stuff ...)
(!-aux (a 0 +) (seen ...) 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) ]
[(_ () 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) ]
))
--
[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
The good news is, it's not Lisp that sucks, but Common Lisp. --- Paul Graham --- Synchronet 3.21a-Linux NewsLink 1.2