Erik.
Robust and Flexible. No vendor lock-in.
Index: Environment.java
===================================================================
--- Environment.java (revision 14552)
+++ Environment.java (working copy)
@@ -42,6 +42,7 @@
private Binding blocks;
private Binding tags;
public boolean inactive; //default value: false == active
+ private static final ConcurrentHashMap<Symbol, LispObject> classMap;
public Environment() {}
@@ -53,7 +54,11 @@
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,6 +222,36 @@
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)
Index: LispClass.java
===================================================================
--- LispClass.java (revision 14552)
+++ LispClass.java (working copy)
@@ -328,8 +328,7 @@
LispObject third)
{
- // FIXME Use environment!
- return findClass(first, second != NIL);
+ return checkEnvironment(third).findClass(first, second != NIL);
}
};
@@ -339,7 +338,6 @@
{
@Override
public LispObject execute(LispObject first, LispObject second)
-
{
final Symbol name = checkSymbol(first);
if (second == NIL)
@@ -350,6 +348,18 @@
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