9

i've seen several examples of implementing append an element to a list, but all are not using tail recursion. how to implement such a function in a functional style?

 (define (append-list lst elem)
    expr)
Will Ness
  • 70,110
  • 9
  • 98
  • 181
象嘉道
  • 3,657
  • 5
  • 33
  • 49

5 Answers5

7

The following is an implementation of tail recursion modulo cons optimization, resulting in a fully tail recursive code. It copies the input structure and then appends one more, new element -- by mutation, in the top-down manner. Since this mutation is done to its internal freshly-created data, it is still purely functional on the outside, as it does not alter any data passed into it and has no observable effects except for producing its result:

(define (add-elt lst elt)
  (let ((result (list 1)))
    (let loop ((p result) (lst lst))
      (cond 
        ((null? lst) 
           (set-cdr! p (list elt)) 
           (cdr result))
        (else 
           (set-cdr! p (list (car lst)))
           (loop (cdr p) (cdr lst)))))))

I like using the "head-sentinel" trick, it greatly simplifies the code at a cost of allocating just one extra cons cell.

This code uses low-level mutation primitives to accomplish what in some languages (e.g. Prolog) is done automatically by a compiler. In TRMC-optimizing hypothetical Scheme, we would be able to write the following tail-recursive modulo cons code, and have a compiler automatically translate it into some equivalent of the code above:

(define (append-elt lst elt)              ;; %% in Prolog:
  (if (null lst)                          ;; app1( [],   E,R) :- Z=[X].
    (list elt)                            ;; app1( [A|D],E,R) :-
    (cons (car lst)                       ;;  R = [A|T], % cons _before_
          (append-elt (cdr lst) elt))))   ;;  app1( D,E,T). % tail call

If not for the cons operation, append-elt would be tail-recursive. This is where the TRMC optimization comes into play.

2021 update: of course the whole point of having a tail-recursive function is to express a loop (in the functional style, yes), and so as an example, in e.g. Common Lisp, in the CLISP implementation, the loop expression

(loop for x in '(1 2) appending (list x))

(which is kind of high-level specification-y if not even functional in its own very specific way) is translated into the same tail-cons-cell tracking and altering style:

[20]> (macroexpand '(loop for x in '(1 2) appending (list x)))
(MACROLET ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-ERROR)))
 (BLOCK NIL
  (LET ((#:G3047 '(1 2)))
   (PROGN
    (LET ((X NIL))
     (LET ((#:ACCULIST-VAR-30483049 NIL) (#:ACCULIST-VAR-3048 NIL))
      (MACROLET ((LOOP-FINISH NIL '(GO SYSTEM::END-LOOP)))
       (TAGBODY SYSTEM::BEGIN-LOOP (WHEN (ENDP #:G3047) (LOOP-FINISH))
        (SETQ X (CAR #:G3047))
        (PROGN
         (LET ((#:G3050 (COPY-LIST (LIST X))))
          (IF #:ACCULIST-VAR-3048
           (SETF #:ACCULIST-VAR-30483049
            (LAST (RPLACD #:ACCULIST-VAR-30483049 #:G3050)))
           (SETF #:ACCULIST-VAR-30483049
            (LAST (SETF #:ACCULIST-VAR-3048 #:G3050))))))
        (PSETQ #:G3047 (CDR #:G3047)) (GO SYSTEM::BEGIN-LOOP) SYSTEM::END-LOOP
        (MACROLET
         ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-WARN) '(GO SYSTEM::END-LOOP)))
         (RETURN-FROM NIL #:ACCULIST-VAR-3048)))))))))) ;
T
[21]>

(with the mother of all structure-mutating primitives spelled R.P.L.A.C.D.) so that's one example of a Lisp system (not just Prolog) which actually does something similar.

2023 update: turns out OCaml too now has TRMC, as an opt-in. And Elm.

Will Ness
  • 70,110
  • 9
  • 98
  • 181
5

Well it is possible to write a tail-recursive append-element procedure...

(define (append-element lst ele)
  (let loop ((lst (reverse lst))
             (acc (list ele)))
    (if (null? lst)
        acc
        (loop (cdr lst) (cons (car lst) acc)))))

... but it's more inefficient with that reverse thrown in (for good measure). I can't think of another functional (e.g., without modifying the input list) way to write this procedure as a tail-recursion without reversing the list first.

For a non-functional answer to the question, @WillNess provided a nice Scheme solution mutating an internal list.

Will Ness
  • 70,110
  • 9
  • 98
  • 181
Óscar López
  • 232,561
  • 37
  • 312
  • 386
  • @WillNess AFAIK, whenever you use `set!`, `set-car!`, `set-cdr!` that's no longer considered a functional solution, you're changing state - cons cells in this case. Even if it appears functional on the outside. – Óscar López Nov 07 '12 at 13:37
  • my code does not mutate any state observable by any outside program. And it does not mutate an input list in-place. – Will Ness Nov 07 '12 at 15:07
  • I've re-read the Q, yes my implementation is not a "functional style **implementation**" that the Q asks about. That can't be done without having a built-in `snoc` operation, or using an additional `reverse`, as you point out. – Will Ness Nov 11 '12 at 09:22
3

This is a functional, tail recursive append-elt using continuations:

(define (cont-append-elt lst elt)
  (let cont-loop ((lst lst)
                  (cont values))
    (if (null? lst)
        (cont (cons elt '()))
        (cont-loop (cdr lst)
                   (lambda (x) (cont (cons (car lst) x)))))))

Performance-wise it's close to Will's mutating one in Racket and Gambit but in Ikarus and Chicken Óscar's reverse did better. Mutation was always the best performer though. I wouldn't have used this however, but a slight version of Óscar's entry, purely because it is easier to read.

(define (reverse-append-elt lst elt)
  (reverse (cons elt (reverse lst))))

And if you want mutating performance I would have done:

(define (reverse!-append-elt lst elt)
  (let ((lst (cons elt (reverse lst))))
     (reverse! lst)
     lst))
Sylwester
  • 47,942
  • 4
  • 47
  • 79
  • for hard-to-read functions written for efficiency, you can always add explanation comments, like `foldr (:) [a] xs`, or `(set-cdr! (last-pair (copy-list xs)) (list a))`, or `== (reverse (cons elt (reverse lst)))`, or in English. -- The point to the top-down O(1) extra space TRMC code is, we can do better than exchanging extra O(n) growing stack structure for an extra O(n) growing continuation structure, `((((id.(1:)).(2:)).(3:)).(4:)) [5]`. In effect to build the result this performs two O(n) passes, whereas its Haskell equivalent does three, and top-down TRMC code - one pass. – Will Ness Jul 21 '13 at 10:36
  • The compilers actually does mutations under the hood so it's sad it doesn't do TRMC optimization automatically like Prolog does. If you look the the SRFI-1 reference implementation you'll see that all in order procedures will blow up the stack given a list big enough. – Sylwester Jul 21 '13 at 12:37
  • yes, I always found this very strange. Maybe they give this reference implementation just as a *description* of what the results must be; a *specification*. --- btw TRMC is easy to see/present as tail recursion with accumulator; just that accumulation is done by set-cdr!ing the last pair. – Will Ness Jul 21 '13 at 13:06
2

You can't naively, but see also implementations that provide TCMC - Tail Call Modulo Cons. That allows

(cons head TAIL-EXPR)

to tail-call TAIL-EXPR if the cons itself is a tail-call.

LeoNerd
  • 8,344
  • 1
  • 29
  • 36
  • Yes; but then you have to reverse the list again afterwards. The point of TCMC is that you don't need to reverse the list again at the end, and it gives the same kind of performance that you can get out of imperative languages – LeoNerd Nov 07 '12 at 12:32
  • Yes, TCMC is a rather neat improvement. – Vatine Nov 07 '12 at 15:19
  • @Vatine TRMC can also be seen as accumulating - it just accumulates by nconcing. C can do it, and Scheme can do it too. Prolog does the optimization automatically. – Will Ness Nov 07 '12 at 15:26
1

This is Lisp, not Scheme, but I am sure you can translate:

(defun append-tail-recursive (list tail)
  (labels ((atr (rest ret last)
             (if rest
                 (atr (cdr rest) ret
                      (setf (cdr last) (list (car rest))))
                 (progn
                   (setf (cdr last) tail)
                   ret))))
    (if list
        (let ((new (list (car list))))
          (atr (cdr list) new new))
        tail)))

I keep the head and the tail of the return list and modify the tail as I traverse the list argument.

sds
  • 58,617
  • 29
  • 161
  • 278