• Re: Multivalue tail recursion?

    From B. Pym@Nobody447095@here-nor-there.org to comp.lang.lisp,comp.lang.scheme on Sun Aug 24 22:39:16 2025
    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