Ticket #240: ticket-240.patch

File ticket-240.patch, 2.6 KB (added by https://www.google.com/accounts/o8/id?id=AItOawkepo5zP0hcDAdImA8S1SswjH-AfweQ5x0, 6 years ago)

initial implementation

  • Environment.java

     
    4242  private Binding blocks;
    4343  private Binding tags;
    4444  public boolean inactive; //default value: false == active
     45  private static final ConcurrentHashMap<Symbol, LispObject> classMap;
    4546
    4647  public Environment() {}
    4748
     
    5354        lastFunctionBinding = parent.lastFunctionBinding;
    5455        blocks = parent.blocks;
    5556        tags = parent.tags;
     57        classMap = parent.classMap;
    5658      }
     59    else
     60      classMap = new ConcurrentHashMap<Symbol, LispObject>();
     61
    5762  }
    5863
    5964  // Construct a new Environment extending parent with the specified symbol-
     
    217222    return null;
    218223  }
    219224
     225  final public LispObject addClass(LispObject name, LispObject c)
     226  {
     227    classMap.put(checkSymbol(name), c);
     228    return c;
     229  }
     230
     231  final public LispObject findClass(LispObject name, boolean errorp)
     232  {
     233    final Symbol symbol = checkSymbol(name);
     234    final LispObject c = classMap.get(symbol);
     235
     236    if (c != null)
     237      return c;
     238
     239    if (errorp)
     240    {
     241      StringBuilder sb =
     242        new StringBuilder("There is no class named ");
     243      sb.append(name.princToString());
     244      sb.append('.');
     245      return error(new LispError(sb.toString()));
     246    }
     247    return NIL;
     248  }
     249
     250  final public void removeClass(LispObject name)
     251  {
     252    classMap.remove(checkSymbol(name));
     253  }
     254
    220255  // Returns body with declarations removed.
    221256  public LispObject processDeclarations(LispObject body)
    222257
  • LispClass.java

     
    328328                                LispObject third)
    329329
    330330      {
    331         // FIXME Use environment!
    332         return findClass(first, second != NIL);
     331        return checkEnvironment(third).findClass(first, second != NIL);
    333332      }
    334333    };
    335334
     
    339338    {
    340339      @Override
    341340      public LispObject execute(LispObject first, LispObject second)
    342 
    343341      {
    344342        final Symbol name = checkSymbol(first);
    345343        if (second == NIL)
     
    350348        addClass(name, second);
    351349        return second;
    352350      }
     351
     352      @Override
     353      public LispObject execute(LispObject first, LispObject second,
     354                                  LispObject third, LispObject fourth)
     355      {
     356        if (second == NIL)
     357        {
     358          checkEnvironment.removeClass(first);
     359          return second;
     360        }
     361
     362        return checkEnvironment(fourth).addCleass(first, second);
    353363    };
    354364
    355365  // ### subclassp