tail-recursive function appending element to list

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 the new element to it, by mutation, in the top-down manner. Since this mutation is done to its internal freshly-created data, it is still functional on the outside (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 a “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 a 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.

More Related Contents:

Leave a Comment Cancel reply