From 1a1f01aec5be4c9a765758ec4d277198379990c8 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Tue, 23 Aug 1994 18:07:29 +0000
Subject: [PATCH] Fix for LOOP RETURN option, from Miles bader, via Joerg
 Hoehle.

---
 code/old-loop.lisp | 18 +++++++++++-------
 1 file changed, 11 insertions(+), 7 deletions(-)

diff --git a/code/old-loop.lisp b/code/old-loop.lisp
index 620ed46f6..7141c5c23 100644
--- a/code/old-loop.lisp
+++ b/code/old-loop.lisp
@@ -7,12 +7,10 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/old-loop.lisp,v 1.8 1991/05/24 19:37:33 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/old-loop.lisp,v 1.9 1994/08/23 18:07:29 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/old-loop.lisp,v 1.8 1991/05/24 19:37:33 wlott Exp $
-;;;
 ;;; Loop facility, written by William Lott.
 ;;; 
 (in-package "LOOP")
@@ -675,10 +673,16 @@
 
 
 (defun maybe-parse-unconditional ()
-  (when (loop-keyword-p (car *remaining-stuff*) "DO" "DOING")
-    (pop *remaining-stuff*)
-    (setf *body-forms* (nconc *body-forms* (parse-expr-list)))
-    t))
+  (cond ((loop-keyword-p (car *remaining-stuff*) "DO" "DOING")
+	 (pop *remaining-stuff*)
+	 (setf *body-forms* (nconc *body-forms* (parse-expr-list)))
+	 t)
+	((loop-keyword-p (car *remaining-stuff*) "RETURN")
+	 (pop *remaining-stuff*)
+	 (setf *body-forms*
+	       (nconc *body-forms* `((return ,(pop *remaining-stuff*)))))
+	 t)))
+
 
 (defun maybe-parse-conditional ()
   (let ((clause (pop *remaining-stuff*)))
-- 
GitLab