001: /*
002: * Layout.java
003: *
004: * Copyright (C) 2003 Peter Graves
005: * $Id: Layout.java,v 1.4 2003/12/20 03:05:51 piso Exp $
006: *
007: * This program is free software; you can redistribute it and/or
008: * modify it under the terms of the GNU General Public License
009: * as published by the Free Software Foundation; either version 2
010: * of the License, or (at your option) any later version.
011: *
012: * This program is distributed in the hope that it will be useful,
013: * but WITHOUT ANY WARRANTY; without even the implied warranty of
014: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
015: * GNU General Public License for more details.
016: *
017: * You should have received a copy of the GNU General Public License
018: * along with this program; if not, write to the Free Software
019: * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
020: */
021:
022: package org.armedbear.lisp;
023:
024: public final class Layout extends LispObject {
025: private final LispClass cls;
026: private final LispObject length;
027: private final LispObject instanceSlots; // A list of slot names.
028:
029: public Layout(LispClass cls, LispObject length,
030: LispObject instanceSlots) {
031: this .cls = cls;
032: this .length = length;
033: this .instanceSlots = instanceSlots;
034: }
035:
036: public LispClass getLispClass() {
037: return cls;
038: }
039:
040: // ### make-layout
041: private static final Primitive3 MAKE_LAYOUT = new Primitive3(
042: "make-layout", PACKAGE_SYS, false) {
043: public LispObject execute(LispObject first, LispObject second,
044: LispObject third) throws ConditionThrowable {
045: try {
046: return new Layout((LispClass) first, second, third);
047: } catch (ClassCastException e) {
048: return signal(new TypeError(first, "class"));
049: }
050: }
051:
052: };
053:
054: // ### layout-class
055: private static final Primitive1 LAYOUT_CLASS = new Primitive1(
056: "layout-class", PACKAGE_SYS, false) {
057: public LispObject execute(LispObject arg)
058: throws ConditionThrowable {
059: try {
060: return ((Layout) arg).cls;
061: } catch (ClassCastException e) {
062: return signal(new TypeError(arg, "layout"));
063: }
064: }
065: };
066:
067: // ### layout-length
068: private static final Primitive1 LAYOUT_LENGTH = new Primitive1(
069: "layout-length", PACKAGE_SYS, false) {
070: public LispObject execute(LispObject arg)
071: throws ConditionThrowable {
072: try {
073: return ((Layout) arg).length;
074: } catch (ClassCastException e) {
075: return signal(new TypeError(arg, "layout"));
076: }
077: }
078: };
079:
080: // ### instance-slot-index
081: // instance-slot-index layout slot-name => index
082: private static final Primitive2 INSTANCE_SLOT_INDEX = new Primitive2(
083: "instance-slot-index", PACKAGE_SYS, false) {
084: public LispObject execute(LispObject first, LispObject second)
085: throws ConditionThrowable {
086: try {
087: LispObject list = ((Layout) first).instanceSlots;
088: int index = 0;
089: while (list != NIL) {
090: if (list.car() == second)
091: return new Fixnum(index);
092: list = list.cdr();
093: ++index;
094: }
095: return NIL;
096: } catch (ClassCastException e) {
097: return signal(new TypeError(first, "layout"));
098: }
099: }
100: };
101: }
|