rlabels : simple labels replacement, expanding to non-recursive code

rlabels.lisp

; Copyright Rainer Joswig, 2023, [email protected]

; simple LABELS replacement, expanding to non-recursive code

; the goal is to provide a simple LABELS like operator
;  which optimizes simple self-tail-recursive code to
;  to a stack-less jump.

; limitations: does not detect when a call is NOT in tail position,
;               which would require a code walker.
;              does not support multiple local operators
;              does not support other than required args

; The code for the 'self-recursive' operator call will be provided
;  by a local macro. The macro 'knows' the number of local arguments,
;  a list of shadow variables and its own GO tag. Having
;  its own shadow args and its own GO tag should make nested
;  RLABELS useful.

(defmacro rlabels (((fn args &body fnbody))
                   (fncall &rest fncall-args))
  
  ; are the arglists of the same lengths?
  ; TODO: are the args only required args?
  
  (assert (eq fn fncall))
  (assert (= (length args) (length fncall-args)))

  
  (let ((shadow-args (mapcar (lambda (sym)
                               (gensym (symbol-name sym)))
                             args))
        (loop-sym (gensym "rlabels-loop"))
        (args-len (length args)))

    ; now follows the code generation
       
    `(let
      
      ; first we save the args into shadow variables.
      ; we need shadow variables so that the values can later be
      ; updated, even though there might be rebindings by LET or similar.
      
      ,(loop for v in shadow-args and init in fncall-args
                 collect (list v init))
      
      ; PROG provides us local lexical variables and
      ;  GO tags.

       (prog
         
         ; here we create the local function variables from the parameter list
         
         ,args
         
         ; the loop GO tag as target for the iteration start is declared
         
         ,loop-sym
         
         ; we set the variable values from the shadow variables
         
         (setf ,@(loop for v in args and sv in shadow-args
                       collect v collect sv))
         
         ; we need to return the return value from PROG
         
         (return
         
          ; we create a local macro for the operator name.
          ; the macro expansion updates the shadow variables
          ; and jumps to the loop tag above
          
          (macrolet  ((,fn (&rest recursion-args
                            &aux (loop-sym ',loop-sym)
                                 (args-len ,args-len))
                        
                        ; checking the number of arguments
                        (assert (= (length recursion-args) args-len))
                        
                        ; the generated code for  (foo a b c ...) , where FOO is our
                        ; local macro operator.
                        ; we are updating the shadow-args and then jumping to the loop tag.
                        `(progn
                           (setf ,@(loop for v in ',shadow-args and a in recursion-args
                                         collect v collect a))
                           (go ,loop-sym))))

            ; the body of the rlabels defined operator code
                     
            ,@fnbody))))))


#||

(defun test (i)
  (rlabels ((foo (i acc)                        ; local operator FOO
              (if (zerop i)                     ; body start
                  acc
                  (let ((acc (1+ acc)))
                    (foo (1- i) (+ acc 1))))))  ; recursive 'call'
     (foo i 0)))                                ; initial call with init valuaes

; Example transformation:

(rlabels ((foo (i acc)
            (if (zerop i)
                acc
              (let ((acc (1+ acc)))
                (foo (1- i) (+ acc 1))))))
  (foo 10 0))

; gets translated to ->

(let ((#:i10   10)
      (#:acc11  0))
  (prog (i acc)
    #:rlabels-loop12
    (setf i #:i10 acc #:acc11)
    (return (if (zerop i)
               acc
               (let ((acc (1+ acc)))
                 (progn
                   (setf #:i10 (1- i) #:acc11 (+ acc 1))
                   (go #:rlabels-loop12))))))

||#

But wait, isn't it roughly the same as Serapeum's nlet?

And then, Scheme's named let establishes only one function binding, which covers most of the cases for recursive algorithms, so I'm not convinced is the increased usefulness rlabels bring. Any use-case you see fit for it?

@aartaka This was initially suggested as a replacement for my usage of recursive labels in transducers, for instance here: https://codeberg.org/fosskers/cl-transducers/src/branch/master/transducers/entry.lisp#L117-L125

Such usage is fine in most Lisps but failed under ABCL, which doesn't do TCO within labels.