Changeset 4040

Timestamp:

09/24/03 14:22:45 (20 years ago)

Author:

piso

Message:

ANSI-LOOP, LOOP

File:

• trunk/j/src/org/armedbear/lisp/macros.lisp (modified) (5 diffs)

trunk/j/src/org/armedbear/lisp/macros.lisp

@@ -2 +2 @@
 ;;;
 ;;; Copyright (C) 2003 Peter Graves
-;;; $Id: macros.lisp,v 1.21 2003-08-28 00:23:05 piso Exp $
+;;; $Id: macros.lisp,v 1.22 2003-09-24 14:22:45 piso Exp $
 ;;;
 ;;; This program is free software; you can redistribute it and/or
@@ -87 +87 @@
   (let* ((inits ())
    (steps ())
-   (l1 (gensym))
-   (l2 (gensym)))
+   (L1 (gensym))
+   (L2 (gensym)))
     ;; Check for illegal old-style do.
     (when (or (not (listp varlist)) (atom endlist))
@@ -106 +106 @@
       (t (error "~S is an illegal form for a ~S varlist." v name))))
     ;; And finally construct the new form.
-    `(block ,BLOCK
+    `(block ,block
             (,bind ,(nreverse inits)
                    (tagbody
@@ -115 +115 @@
                     ,L2
                     (unless ,(car endlist) (go ,L1))
-                    (return-from ,BLOCK (progn ,@(cdr endlist))))))))
+                    (return-from ,block (progn ,@(cdr endlist))))))))
 
 
@@ -125 +125 @@
   (do-do-body varlist endlist body 'let* 'setq 'do* nil))
 
+(defun ansi-loop (exps)
+  (require 'loop)
+  (fmakunbound 'ansi-loop)
+  `(loop ,@exps))
+
 (defmacro loop (&rest exps)
-  (if (and exps (symbolp (car exps)))
-      (error "LOOP keywords are not supported")
-      (let ((tag (gensym)))
-  `(block nil (tagbody ,tag ,@exps (go ,tag))))))
+  (dolist (exp exps)
+    (when (atom exp)
+      (return-from loop (ansi-loop exps))))
+  (let ((tag (gensym)))
+    `(block nil (tagbody ,tag ,@exps (go ,tag)))))