Changeset 4023

Timestamp:

09/23/03 15:27:50 (19 years ago)

Author:

piso

Message:

DOLIST

File:

• trunk/j/src/org/armedbear/lisp/Primitives.java (modified) (3 diffs)

trunk/j/src/org/armedbear/lisp/Primitives.java

@@ -3 +3 @@
  *
  * Copyright (C) 2002-2003 Peter Graves
- * $Id: Primitives.java,v 1.430 2003-09-23 15:17:01 piso Exp $
+ * $Id: Primitives.java,v 1.431 2003-09-23 15:27:50 piso Exp $
  *
  * This program is free software; you can redistribute it and/or
@@ -1528 +1528 @@
 
     // ### dolist
-    private static final SpecialOperator DOLIST = new SpecialOperator("dolist") {
+    private static final SpecialOperator DOLIST = new SpecialOperator("dolist")
+    {
         public LispObject execute(LispObject args, Environment env)
             throws ConditionThrowable
@@ -1537 +1538 @@
             LispObject listForm = args.cadr();
             final LispThread thread = LispThread.currentThread();
-            LispObject list = checkList(eval(listForm, env, thread));
             LispObject resultForm = args.cdr().cdr().car();
             Environment oldDynEnv = thread.getDynamicEnvironment();
-            while (list != NIL) {
-                Environment ext = new Environment(env);
-                bind(var, list.car(), ext);
-                LispObject body = bodyForm;
-                int depth = thread.getStackDepth();
-                try {
+            int depth = thread.getStackDepth();
+            try {
+                LispObject list = checkList(eval(listForm, env, thread));
+                // Look for tags.
+                Binding tags = null;
+                LispObject remaining = bodyForm;
+                while (remaining != NIL) {
+                    LispObject current = remaining.car();
+                    remaining = remaining.cdr();
+                    if (current instanceof Cons)
+                        continue;
+                    // It's a tag.
+                    tags = new Binding(current, remaining, tags);
+                }
+                while (list != NIL) {
+                    Environment ext = new Environment(env);
+                    bind(var, list.car(), ext);
+                    LispObject body = bodyForm;
                     while (body != NIL) {
-                        LispObject result = eval(body.car(), ext, thread);
+                        LispObject current = body.car();
+                        if (current instanceof Cons) {
+                            try {
+                                // Handle GO inline if possible.
+                                if (current.car() == Symbol.GO) {
+                                    LispObject code = null;
+                                    LispObject tag = current.cadr();
+                                    for (Binding binding = tags; binding != null; binding = binding.next) {
+                                        if (binding.symbol.eql(tag)) {
+                                            code = binding.value;
+                                            break;
+                                        }
+                                    }
+                                    if (code != null) {
+                                        body = code;
+                                        continue;
+                                    }
+                                    throw new Go(tag);
+                                }
+                                eval(current, ext, thread);
+                            }
+                            catch (Go go) {
+                                LispObject code = null;
+                                LispObject tag = go.getTag();
+                                for (Binding binding = tags; binding != null; binding = binding.next) {
+                                    if (binding.symbol.eql(tag)) {
+                                        code = binding.value;
+                                        break;
+                                    }
+                                }
+                                if (code != null) {
+                                    body = code;
+                                    thread.setStackDepth(depth);
+                                    continue;
+                                }
+                                throw go;
+                            }
+                        }
                         body = body.cdr();
                     }
-                }
-                catch (Return ret) {
-                    if (ret.getTag() == NIL) {
-                        thread.setStackDepth(depth);
-                        return ret.getResult();
-                    }
-                    throw ret;
-                }
-                list = list.cdr();
-            }
-            Environment ext = new Environment(env);
-            bind(var, NIL, ext);
-            LispObject result = eval(resultForm, ext, thread);
-            thread.setDynamicEnvironment(oldDynEnv);
-            return result;
+                    list = list.cdr();
+                }
+                Environment ext = new Environment(env);
+                bind(var, NIL, ext);
+                LispObject result = eval(resultForm, ext, thread);
+                return result;
+            }
+            catch (Return ret) {
+                if (ret.getTag() == NIL) {
+                    thread.setStackDepth(depth);
+                    return ret.getResult();
+                }
+                throw ret;
+            }
+            finally {
+                thread.setDynamicEnvironment(oldDynEnv);
+            }
         }
     };