Changeset 5066


Ignore:
Timestamp:
12/11/03 19:10:29 (17 years ago)
Author:
piso
Message:

CLASS-LAYOUT, %SET-CLASS-LAYOUT

File:
1 edited

Legend:

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

    r5037 r5066  
    33 *
    44 * Copyright (C) 2003 Peter Graves
    5  * $Id: LispClass.java,v 1.34 2003-12-09 20:26:22 asimon Exp $
     5 * $Id: LispClass.java,v 1.35 2003-12-11 19:10:29 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    4343
    4444    protected Symbol symbol;
     45    private Layout layout;
    4546    private LispObject directSuperclasses;
    4647    private LispObject directSubclasses;
     
    6768    {
    6869        return symbol;
     70    }
     71
     72    public final Layout getLayout()
     73    {
     74        return layout;
     75    }
     76
     77    public final void setLayout(Layout layout)
     78    {
     79        this.layout = layout;
    6980    }
    7081
     
    258269    };
    259270
     271    // ### class-layout
     272    private static final Primitive1 CLASS_LAYOUT =
     273        new Primitive1("class-layout", PACKAGE_SYS, false)
     274    {
     275        public LispObject execute(LispObject arg) throws ConditionThrowable
     276        {
     277            try {
     278                Layout layout = ((LispClass)arg).getLayout();
     279                return layout != null ? layout : NIL;
     280            }
     281            catch (ClassCastException e) {
     282                throw new ConditionThrowable(new TypeError(arg, "class"));
     283            }
     284        }
     285    };
     286
     287    // ### %set-class-layout
     288    private static final Primitive2 _SET_CLASS_LAYOUT =
     289        new Primitive2("%set-class-layout", PACKAGE_SYS, false)
     290    {
     291        public LispObject execute(LispObject first, LispObject second)
     292            throws ConditionThrowable
     293        {
     294            try {
     295                ((LispClass)first).setLayout((Layout)second);
     296                return second;
     297            }
     298            catch (ClassCastException e) {
     299                if (!(first instanceof LispClass))
     300                    throw new ConditionThrowable(new TypeError(first, "class"));
     301                if (!(second instanceof Layout))
     302                    throw new ConditionThrowable(new TypeError(second, "layout"));
     303                // Not reached.
     304                return NIL;
     305            }
     306        }
     307    };
     308
    260309    // ### class-direct-superclasses
    261310    private static final Primitive1 CLASS_DIRECT_SUPERCLASSES =
Note: See TracChangeset for help on using the changeset viewer.