From Newsgroup: comp.lang.scheme
B. Pym wrote:
Ken Tilton wrote:
Anyway, I whipped one up in a few lines that not only pulls n items
off the list, but it returns the remaining items as well. Let me know what you think. I was kind of surprised that I was able to do it without the use of an accumulator parameter.
(defun first-n (n list)
"Splits the list after the first n elements"
(if (= 0 n)
(values '() list)
(multiple-value-bind (from-front rest) (first-n (1- n) (rest
list))
(values (cons (first list) from-front) rest))))
I would probably do something like this instead:
(defun first-n (n list)
(loop for i below n for (a . d) on list
collect a into x
finally (return (values x d))))
Niiiiiiice.
Gauche Scheme:
We can make a solution shorter than the "loop" one
by using "!" (which is similar to "do" but is
optimized for brevity).
(define (first-n n List)
(! (i n -
r cons (car xs)
xs List cdr)
0 (values @ r xs)))
(first-n 2 '(a b c d e))
(a b)
(c d e)
Given:
(define-syntax !-aux
(syntax-rules (<> @ + - cons cdr :in :across :if ! )
[(_ (:if bool z ...) ((v i u) seen ...) stuff ...)
(!-aux (z ...)
((v i (if bool u v)) seen ...) stuff ...) ]
[(_ (x :in lst z ...) seen (lets ...) stuff ...)
(!-aux (x (and (pair? xs)(pop! xs)) <> z ...)
seen
(lets ... (xs lst)) stuff ...) ]
[(_ (x :across vec z ...) seen (lets ...) stuff ...)
(!-aux (x (and (< i (vector-length v))
(begin0 (vector-ref v i) (inc! i))) <>
z ...)
seen (lets ... (v vec) (i 0)) 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 a b c ! action ...)
(!-aux () seen lets (a b c) #t (action ...)) ]
[(_ () seen lets a b ! action ...)
(!-aux () seen lets (a b) #t (action ...)) ]
[(_ () seen lets a ! action ...)
(!-aux () seen lets a #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 ...) ]
))
--
[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