Changeset 4589

Timestamp:

10/31/03 18:30:33 (19 years ago)

Author:

piso

Message:

PROGV

File:

• trunk/j/src/org/armedbear/lisp/SpecialOperators.java (modified) (2 diffs)

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

@@ -3 +3 @@
  *
  * Copyright (C) 2003 Peter Graves
- * $Id: SpecialOperators.java,v 1.12 2003-10-30 18:38:00 piso Exp $
+ * $Id: SpecialOperators.java,v 1.13 2003-10-31 18:30:33 piso Exp $
  *
  * This program is free software; you can redistribute it and/or
@@ -289 +289 @@
 
     // ### progv
-    private static final SpecialOperator PROGV = new SpecialOperator("progv") {
-        public LispObject execute(LispObject args, Environment env)
-            throws ConditionThrowable
-        {
-            throw new ConditionThrowable(new LispError("PROGV is not implemented"));
+    private static final SpecialOperator PROGV = new SpecialOperator("progv")
+    {
+        public LispObject execute(LispObject args, Environment env)
+            throws ConditionThrowable
+        {
+            if (args.length() < 2)
+                throw new ConditionThrowable(new WrongNumberOfArgumentsException(this));
+            final LispThread thread = LispThread.currentThread();
+            final LispObject symbols = checkList(eval(args.car(), env, thread));
+            LispObject values = checkList(eval(args.cadr(), env, thread));
+            // Save current values of symbols.
+            final LispObject[] oldValues = new LispObject[symbols.length()];
+            int i = 0;
+            for (LispObject list = symbols; list != NIL; list = list.cdr()) {
+                LispObject symbol = list.car();
+                oldValues[i++] = symbol.getSymbolValue();
+            }
+            Environment oldDynEnv = thread.getDynamicEnvironment();
+            try {
+                // Set up the new bindings.
+                for (LispObject list = symbols; list != NIL; list = list.cdr()) {
+                    Symbol symbol = checkSymbol(list.car());
+                    LispObject value;
+                    if (values != NIL) {
+                        value = values.car();
+                        values = values.cdr();
+                    } else
+                        value = null;
+                    if (symbol.isSpecialVariable())
+                        thread.bindSpecial(symbol, value);
+                    else
+                        symbol.setSymbolValue(value);
+                }
+                // Implicit PROGN.
+                LispObject result = NIL;
+                LispObject body = args.cdr().cdr();
+                while (body != NIL) {
+                    result = eval(body.car(), env, thread);
+                    body = body.cdr();
+                }
+                return result;
+            }
+            finally {
+                thread.setDynamicEnvironment(oldDynEnv);
+                // Undo bindings.
+                i = 0;
+                for (LispObject list = symbols; list != NIL; list = list.cdr()) {
+                    Symbol symbol = (Symbol) list.car();
+                    symbol.setSymbolValue(oldValues[i]);
+                }
+            }
         }
     };