From Newsgroup: comp.lang.scheme
Nicolas Neuss wrote:
CL-USER> (defun fib (n)
(loop for x below n
for a = 0 then b
and b = 1 then (+ a b)
finally (return b)))
CL-USER> (mapcar #'fib (loop for x from 1 upto 20 collecting x))
(1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765)
CL-USER>
0-th Fibonacci is 0, IIRC. Furthermore, the use of loop's repeat clause is appropriate here. Thus,
(defun fib (n)
(loop repeat n
for a = 0 then b
and b = 1 then (+ a b)
finally (return a)))
"!" is similar to "do".
(define (fib n)
(! (b 1 (+ a b)
a 0 b
n n -)
(= 1 n)))
(! (n 1 +) (= n 7) ! print (fib n))
1
1
2
3
5
8
Given:
(define-syntax !-aux
(syntax-rules (<> @ + - cons cdr :in :across :if ! )
[(_ (:if bool z ...) (seen ... (v i u)) stuff ...)
(!-aux (z ...)
(seen ... (v i (if bool u v))) stuff ...) ]
;;
[(_ (x :in lst z ...) seen (lets ...) bool stuff ...)
(!-aux (x (and (pair? xs)(pop! xs)) <> z ...)
seen (lets ... (xs lst)) (or (not x) bool) stuff ...) ]
[(_ (x :across vec z ...) seen (lets ...) bool stuff ...)
(!-aux (x (and (< i (vector-length v))
(begin0 (vector-ref v i) (inc! i))) <>
z ...)
seen (lets ... (v vec) (i 0)) (or (not x) bool) stuff ...) ]
[(_ (a b <> z ...) (seen ...) stuff ...)
(!-aux (z ...) (seen ... (a b b)) stuff ...) ]
[(_ (a b + z ...) (seen ...) stuff ...)
(!-aux (z ...) (seen ... (a b (+ 1 a))) stuff ...) ]
[(_ (a + n z ...) (seen ...) stuff ...)
(!-aux (z ...) (seen ... (a 0 (+ n a))) stuff ...) ]
[(_ (a b - z ...) (seen ...) stuff ...)
(!-aux (z ...) (seen ... (a b (- a 1))) stuff ...) ]
[(_ (a cons b z ...) (seen ...) stuff ...)
(!-aux (z ...) (seen ... (a '() (cons b a))) stuff ...) ]
[(_ (a b cdr z ...) (seen ...) stuff ...)
(!-aux (z ...) (seen ... (a b (cdr a))) 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 ...) ]
;;
[(_ () seen lets bool ! action ...)
(!-aux () seen lets bool #t (action ...)) ]
;;
[(_ () ((a b c) z ...) lets bool)
(!-aux () ((a b c) z ...) lets bool 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 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