Changeset 3966


Ignore:
Timestamp:
09/21/03 15:09:05 (19 years ago)
Author:
piso
Message:

Work in progress.

Location:
trunk/j/src/org/armedbear/lisp
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/LispClass.java

    r3933 r3966  
    33 *
    44 * Copyright (C) 2003 Peter Graves
    5  * $Id: LispClass.java,v 1.20 2003-09-20 18:20:47 piso Exp $
     5 * $Id: LispClass.java,v 1.21 2003-09-21 15:04:48 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    2828    protected static final HashMap map = new HashMap();
    2929
     30    public static void addClass(Symbol symbol, LispClass c)
     31    {
     32        synchronized (map) {
     33            map.put(symbol, c);
     34        }
     35    }
     36
     37    public static LispClass findClass(Symbol symbol)
     38    {
     39        synchronized (map) {
     40            return (LispClass) map.get(symbol);
     41        }
     42    }
     43
    3044    protected final Symbol symbol;
     45    private LispObject directSuperclasses; // A list.
    3146
    3247    protected LispClass(Symbol symbol)
    3348    {
    3449        this.symbol = symbol;
     50        this.directSuperclasses = NIL;
    3551    }
    3652
    37     public Symbol getSymbol()
     53    protected LispClass(Symbol symbol, LispObject directSuperclasses)
     54    {
     55        this.symbol = symbol;
     56        this.directSuperclasses = directSuperclasses;
     57    }
     58
     59    public final Symbol getSymbol()
    3860    {
    3961        return symbol;
     62    }
     63
     64    public final LispObject getDirectSuperclasses()
     65    {
     66        return directSuperclasses;
     67    }
     68
     69    public final void setDirectSuperclasses(Cons directSuperclasses)
     70    {
     71        this.directSuperclasses = directSuperclasses;
     72    }
     73
     74    // When there's only one direct superclass...
     75    public final void setDirectSuperclass(LispObject superclass)
     76    {
     77        directSuperclasses = new Cons(superclass);
    4078    }
    4179
     
    64102    }
    65103
    66     public static LispClass findClass(Symbol symbol)
    67     {
    68         return (LispClass) map.get(symbol);
    69     }
    70 
    71104    // ### find-class
    72105    private static final Primitive FIND_CLASS = new Primitive("find-class") {
     
    92125        }
    93126    };
     127
     128    private static final Primitive1 CLASS_DIRECT_SUPERCLASSES =
     129        new Primitive1("class-direct-superclasses", PACKAGE_SYS, false)
     130    {
     131        public LispObject execute(LispObject arg) throws ConditionThrowable
     132        {
     133            if (arg instanceof LispClass)
     134                return ((LispClass)arg).getDirectSuperclasses();
     135            throw new ConditionThrowable(new TypeError(arg, "class"));
     136        }
     137    };
    94138}
  • trunk/j/src/org/armedbear/lisp/StandardClass.java

    r3933 r3966  
    33 *
    44 * Copyright (C) 2003 Peter Graves
    5  * $Id: StandardClass.java,v 1.2 2003-09-20 18:16:55 piso Exp $
     5 * $Id: StandardClass.java,v 1.3 2003-09-21 15:07:13 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    2424public class StandardClass extends LispClass
    2525{
    26     protected LispObject directSuperclasses; // A list.
     26    public StandardClass(Symbol symbol, LispObject directSuperclasses)
     27    {
     28        super(symbol, directSuperclasses);
     29    }
    2730
    28     public StandardClass(Symbol symbol)
     31    public String toString()
    2932    {
    30         super(symbol);
     33        StringBuffer sb = new StringBuffer("#<STANDARD-CLASS ");
     34        sb.append(symbol.getName());
     35        sb.append('>');
     36        return sb.toString();
    3137    }
    3238}
  • trunk/j/src/org/armedbear/lisp/StructureClass.java

    r3930 r3966  
    33 *
    44 * Copyright (C) 2003 Peter Graves
    5  * $Id: StructureClass.java,v 1.1 2003-09-20 18:15:48 piso Exp $
     5 * $Id: StructureClass.java,v 1.2 2003-09-21 15:06:39 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    2626    private StructureClass(Symbol symbol)
    2727    {
    28         super(symbol);
     28        super(symbol, new Cons(BuiltInClass.STRUCTURE_OBJECT));
    2929    }
    3030
     
    6464            Symbol symbol = checkSymbol(arg);
    6565            StructureClass c = new StructureClass(symbol);
    66             map.put(symbol, c);
     66            addClass(symbol, c);
    6767            return c;
    6868        }
  • trunk/j/src/org/armedbear/lisp/StructureObject.java

    r3933 r3966  
    33 *
    44 * Copyright (C) 2003 Peter Graves
    5  * $Id: StructureObject.java,v 1.14 2003-09-20 18:18:28 piso Exp $
     5 * $Id: StructureObject.java,v 1.15 2003-09-21 15:07:43 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    2424public final class StructureObject extends LispObject
    2525{
    26     private final Symbol symbol;
     26    private final LispClass structureClass;
    2727    private final LispObject[] slots;
    2828
    2929    public StructureObject(Symbol symbol, LispObject list) throws ConditionThrowable
    3030    {
    31         this.symbol = symbol;
     31        structureClass = LispClass.findClass(symbol); // Might return null.
     32        Debug.assertTrue(structureClass instanceof StructureClass);
    3233        slots = list.copyToArray();
    3334    }
     
    3536    public StructureObject(StructureObject obj)
    3637    {
    37         this.symbol = obj.symbol;
     38        this.structureClass = obj.structureClass;
    3839        slots = new LispObject[obj.slots.length];
    3940        for (int i = slots.length; i-- > 0;)
     
    4344    public LispObject typeOf()
    4445    {
    45         return symbol;
     46        return structureClass.getSymbol();
    4647    }
    4748
    4849    public LispClass classOf()
    4950    {
    50         return LispClass.findClass(symbol);
     51        return structureClass;
    5152    }
    5253
    5354    public LispObject typep(LispObject type) throws ConditionThrowable
    5455    {
    55         if (type == symbol)
     56        if (type instanceof StructureClass)
     57            return type == structureClass ? T : NIL; // FIXME Could be a superclass.
     58        if (type == structureClass.getSymbol())
    5659            return T;
    57         if (type instanceof StructureClass)
    58             return type == LispClass.findClass(symbol) ? T : NIL;
    5960        if (type == Symbol.STRUCTURE_OBJECT)
    6061            return T;
     
    6768    {
    6869        StringBuffer sb = new StringBuffer("#S(");
    69         sb.append(symbol);
     70        sb.append(structureClass.getSymbol());
    7071        // FIXME Use *PRINT-LENGTH*.
    7172        final int limit = Math.min(slots.length, 10);
  • trunk/j/src/org/armedbear/lisp/define-condition.lisp

    r3926 r3966  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: define-condition.lisp,v 1.1 2003-09-20 16:57:05 piso Exp $
     4;;; $Id: define-condition.lisp,v 1.2 2003-09-21 15:08:43 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    2222(defmacro define-condition (name (&rest parent-types) (&rest slot-specs)
    2323         &body options)
    24   `(%define-condition ',name))
     24  (let ((parent-types (or parent-types '(condition))))
     25    `(%define-condition ',name ',parent-types ',slot-specs ',options)))
  • trunk/j/src/org/armedbear/lisp/define_condition.java

    r3926 r3966  
    33 *
    44 * Copyright (C) 2003 Peter Graves
    5  * $Id: define_condition.java,v 1.1 2003-09-20 16:56:02 piso Exp $
     5 * $Id: define_condition.java,v 1.2 2003-09-21 15:09:05 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    2929    }
    3030
     31    // define-condition name (parent-type*) ({slot-spec}*) option* => name
    3132    public LispObject execute(LispObject[] args) throws ConditionThrowable
    3233    {
    33         if (args.length < 1)
     34        if (args.length != 4)
    3435            throw new ConditionThrowable(new WrongNumberOfArgumentsException(this));
    35         return NIL;
     36        Symbol symbol = checkSymbol(args[0]);
     37        Debug.trace("symbol = " + symbol);
     38        LispObject parentTypes = checkCons(args[1]);
     39        LispObject slotSpecs = args[2];
     40        LispObject options = args[3];
     41
     42        StandardClass c = new StandardClass(symbol, parentTypes);
     43        LispClass.addClass(symbol, c);
     44        return c;
    3645    }
    3746
Note: See TracChangeset for help on using the changeset viewer.