Tail recursion special-form for sibilant

0-notes.md

Some caveats about this method:

• The "call" in the name of _tco_ is a lie. It's tail recursion, not tail call optimization. I'll update the name if I include this in sibilant.
• It drops some boilerplate (the _tco_ function) at the top, which is something I don't feel too good about.
• It only works from a tail position — if you don't return (recur ...), it does nothing.

It can be enabled either globally:

(enable-tco)
(defun infinite-loop () (recur)) ;=> infinite loop, no stack
(disable-tco)
(defun no-tco () (recur)) ;=> throws, doesn't know what recur means

Or just for a block:

(with-tco
  (defun infinite-loop () (recur)))
(defun normal-function-here () (infinite-loop)) ;=> functions defined within tco still work

1-tco-example.sib.lisp

(include 'tco.sib)
(enable-tco)
 
(defun recursive-reverse (string)
  (defun recursive-reverse-1 (built-string input-string)
    (if input-string.length
      (recur (concat (first input-string) built-string)
             (rest input-string))
      built-string))

  (recursive-reverse-1 "" string))

(recursive-reverse "hello world") ;=> "dlrow olleh"

(defun fib (n)
  (defun fib-recurse (n prev-1 prev-2)
    (if (= 1 n) prev-1
        (recur (- n 1)
               prev-2
               (+ prev-1 prev-2))))

  (if (= 0 n) 0
      (fib-recurse n 0 1)))


(fib 100) ;=> 218922995834555200000

2-tco-example.js

var _tco_ = (function(fn) {
  // fn:required
  return (function() {
    var recurring = false,
        args = undefined,
        returnVal = undefined;;
    var recur = (function(recurArgs) {
      // recurArgs:rest
      var recurArgs = Array.prototype.slice.call(arguments, 0);
      
      recurring = true;
      args = recurArgs;;
      return recur;
    });
    ;
    recur.apply(undefined, arguments);
    (function() {
      var __returnValue__ = undefined;;
      while (recurring) {
        __returnValue__ = (function() {
          returnVal = fn.apply(recur, args);
          return recurring = (returnVal === recur);;
        })();;
      };
      return __returnValue__;
    })();
    return returnVal;
  });
});


var recursiveReverse = _tco_((function(string) {
  // string:required
  var recur = this;;
  var recursiveReverse1 = _tco_((function(builtString, inputString) {
    // builtString:required inputString:required
    var recur = this;;
    return (function() {
      if (inputString.length) {
        return recur(((inputString)[0] + builtString), inputString.slice(1));
      } else {
        return builtString;
      };
    })();
  }));;
  return recursiveReverse1("", string);
}));
(recursiveReverse("hello world");

var fib = _tco_((function(n) {
  // n:required
  var recur = this;;
  var fibRecurse = _tco_((function(n, prev1, prev2) {
    // n:required prev1:required prev2:required
    var recur = this;;
    return (function() {
      if ((1 === n)) {
        return prev1;
      } else {
        return recur((n - 1), prev2, (prev1 + prev2));
      };
    })();
  }));;
  return (function() {
    if ((0 === n)) {
      return 0;
    } else {
      return fibRecurse(n, 0, 1);
    };
  })();
}));
fib(100);

3-simplified-and-cleaned-up-js.js

var tco = function(fn) {
    return function() {
        var recurring, args, retVal
        ,   recur = function() {
            args = Array.prototype.slice.apply( arguments )
            recurring = true
            return recur
        };

        recur.apply( null, arguments )

        while ( recurring ) {
            retVal = fn.apply( recur, args )
            recurring = retVal === recur;
        }

        return retVal;
    }
}


// Example usage:

var reverse = function( string ) {
    var reverseRecursive = tco( function( built_string, input_string ) {
        if ( input_string.length )
            return this( input_string[ 0 ] + built_string,
                         input_string.slice( 1 ));
        else return built_string;
    });

    return reverseRecursive( "", string );
}


var ret = reverse( "hello world" );
console.log( ret );

4-tco.sib.lisp

(defun *tco* (fn)
  (lambda ()
    (defvar recurring false
            args undefined
            return-val undefined)

    (defun recur (&rest recur-args)
      (setf recurring true
            args recur-args)
      recur)

    (apply recur arguments)

    (while recurring
      (setf return-val (fn.apply recur args)
            recurring (= return-val recur)))

    return-val))

(defmacro def-tco (name args &rest body)
  (macros.defvar (translate name)
                 (macros.call '*tco*
                              (apply macros.lambda
                                     (cons args (cons
                                                 '(defvar recur this)
                                                 body))))))

(defmacro enable-tco ()
  (when (not (macros.tco-enabled?))
    (macros.alias-macro 'defun 'defun-before-tco)
    (macros.alias-macro 'def-tco 'defun)))


(defmacro disable-tco ()
  (when (macros.tco-enabled?)
    (macros.rename-macro 'defun-before-tco 'defun)))

(defmacro tco-enabled? ()
  (= macros.def-tco macros.defun))

(defmacro with-tco (&rest body)
  (defvar tco-enabled-before (macros.tco-enabled?))
  (macros.enable-tco)
  (defvar contents (join "\n" (map body translate)))
  (when (not tco-enabled-before) (macros.disable-tco))
  contents)


(defmacro without-tco (&rest body)
  (defvar tco-enabled-before (macros.tco-enabled?))
  (macros.disable-tco)
  (defvar contents (join "\n" (map body translate)))
  (when tco-enabled-before (macros.enable-tco))
  contents)