From 83a54247b2322ec28cc27d233f23b40203408325 Mon Sep 17 00:00:00 2001 From: "Tarn W. Burton" Date: Wed, 11 Jun 2025 13:59:07 -0400 Subject: [PATCH] Allow LOOP DO/WHILE to be relocated to variable clauses --- src/lisp/kernel/lsp/loop2.lisp | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/src/lisp/kernel/lsp/loop2.lisp b/src/lisp/kernel/lsp/loop2.lisp index bef2af38a8..f6fb5def50 100644 --- a/src/lisp/kernel/lsp/loop2.lisp +++ b/src/lisp/kernel/lsp/loop2.lisp @@ -884,9 +884,16 @@ collected result will be returned as the value of the LOOP." (defun loop-construct-return (form) `(return-from ,(car *loop-names*) ,form)) +(defun loop-pseudo-body (form) + (cond ((or *loop-emitted-body* *loop-inside-conditional*) + (push form *loop-body*)) + (t + (push form *loop-before-loop*) + (push form *loop-after-body*)))) + (defun loop-emit-body (form) (setq *loop-emitted-body* t) - (push form *loop-body*)) + (loop-pseudo-body form)) (defun loop-emit-final-value (&optional (form nil form-supplied-p)) (when form-supplied-p @@ -1122,7 +1129,7 @@ collected result will be returned as the value of the LOOP." (when (loop-tequal (car *loop-source-code*) :end) (loop-pop-source)) (when it-p (setq form `(setq ,it-p ,form))) - (loop-emit-body + (loop-pseudo-body `(if ,(if negatep `(not ,form) form) ,then ,@else)))))) @@ -1296,7 +1303,9 @@ collected result will be returned as the value of the LOOP." (defun loop-do-while (negate kwd &aux (form (loop-get-form))) (loop-disallow-conditional kwd) - (loop-emit-body `(,(if negate 'when 'unless) ,form (go end-loop)))) + (loop-pseudo-body `(,(if negate 'when 'unless) + ,form + (go end-loop)))) (defun loop-do-with ()