Ticket #240: ticket-240.patch

Environment.java

@@ -42 +42 @@
   private Binding blocks;
   private Binding tags;
   public boolean inactive; //default value: false == active
+  private static final ConcurrentHashMap<Symbol, LispObject> classMap;
 
   public Environment() {}
 
@@ -53 +54 @@
         lastFunctionBinding = parent.lastFunctionBinding;
         blocks = parent.blocks;
         tags = parent.tags;
+        classMap = parent.classMap;
       }
+    else
+      classMap = new ConcurrentHashMap<Symbol, LispObject>();
+
   }
 
   // Construct a new Environment extending parent with the specified symbol-
@@ -217 +222 @@
     return null;
   }
 
+  final public LispObject addClass(LispObject name, LispObject c)
+  {
+    classMap.put(checkSymbol(name), c);
+    return c;
+  }
+
+  final public LispObject findClass(LispObject name, boolean errorp)
+  {
+    final Symbol symbol = checkSymbol(name);
+    final LispObject c = classMap.get(symbol);
+
+    if (c != null)
+      return c;
+
+    if (errorp)
+    {
+      StringBuilder sb =
+        new StringBuilder("There is no class named ");
+      sb.append(name.princToString());
+      sb.append('.');
+      return error(new LispError(sb.toString()));
+    }
+    return NIL;
+  }
+
+  final public void removeClass(LispObject name)
+  {
+    classMap.remove(checkSymbol(name));
+  }
+
   // Returns body with declarations removed.
   public LispObject processDeclarations(LispObject body)
 

LispClass.java

@@ -328 +328 @@
                                 LispObject third)
 
       {
-        // FIXME Use environment!
-        return findClass(first, second != NIL);
+        return checkEnvironment(third).findClass(first, second != NIL);
       }
     };
 
@@ -339 +338 @@
     {
       @Override
       public LispObject execute(LispObject first, LispObject second)
-
       {
         final Symbol name = checkSymbol(first);
         if (second == NIL)
@@ -350 +348 @@
         addClass(name, second);
         return second;
       }
+
+      @Override
+      public LispObject execute(LispObject first, LispObject second,
+                                  LispObject third, LispObject fourth)
+      {
+        if (second == NIL)
+        {
+          checkEnvironment.removeClass(first);
+          return second;
+        }
+
+        return checkEnvironment(fourth).addCleass(first, second);
     };
 
   // ### subclassp