source: branches/0.22.x/abcl/src/org/armedbear/lisp/Layout.java

Last change on this file was 12576, checked in by ehuelsmann, 15 years ago

Re #38: Merge the METACLASS branch to trunk.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 8.0 KB
Line 
1/*
2 * Layout.java
3 *
4 * Copyright (C) 2003-2006 Peter Graves
5 * $Id: Layout.java 12576 2010-03-28 20:13:14Z ehuelsmann $
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
20 *
21 * As a special exception, the copyright holders of this library give you
22 * permission to link this library with independent modules to produce an
23 * executable, regardless of the license terms of these independent
24 * modules, and to copy and distribute the resulting executable under
25 * terms of your choice, provided that you also meet, for each linked
26 * independent module, the terms and conditions of the license of that
27 * module.  An independent module is a module which is not derived from
28 * or based on this library.  If you modify this library, you may extend
29 * this exception to your version of the library, but you are not
30 * obligated to do so.  If you do not wish to do so, delete this
31 * exception statement from your version.
32 */
33
34package org.armedbear.lisp;
35
36import static org.armedbear.lisp.Lisp.*;
37
38public class Layout extends LispObject
39{
40  private final LispObject lispClass;
41  public final EqHashTable slotTable;
42
43  final LispObject[] slotNames;
44  final LispObject sharedSlots;
45
46  private boolean invalid;
47
48  public Layout(LispObject lispClass, LispObject instanceSlots, LispObject sharedSlots)
49  {
50    this.lispClass = lispClass;
51    Debug.assertTrue(instanceSlots.listp());
52    int length = instanceSlots.length();
53    slotNames = new LispObject[length];
54    int i = 0;
55
56    while (instanceSlots != NIL)
57      {
58        slotNames[i++] = instanceSlots.car();
59        instanceSlots = instanceSlots.cdr();
60      }
61
62    Debug.assertTrue(i == length);
63    this.sharedSlots = sharedSlots;
64    slotTable = initializeSlotTable(slotNames);
65  }
66
67  public Layout(LispObject lispClass, LispObject[] instanceSlotNames,
68                LispObject sharedSlots)
69  {
70    this.lispClass = lispClass;
71    this.slotNames = instanceSlotNames;
72    this.sharedSlots = sharedSlots;
73    slotTable = initializeSlotTable(slotNames);
74  }
75
76  // Copy constructor.
77  Layout(Layout oldLayout)
78  {
79    lispClass = oldLayout.getLispClass();
80    slotNames = oldLayout.slotNames;
81    sharedSlots = oldLayout.sharedSlots;
82    slotTable = initializeSlotTable(slotNames);
83  }
84
85  private EqHashTable initializeSlotTable(LispObject[] slotNames)
86  {
87    EqHashTable ht = new EqHashTable(slotNames.length, NIL, NIL);
88    for (int i = slotNames.length; i-- > 0;)
89      ht.put(slotNames[i], Fixnum.getInstance(i));
90    return ht;
91  }
92
93  @Override
94  public LispObject getParts()
95  {
96    LispObject result = NIL;
97    result = result.push(new Cons("class", getLispClass()));
98    for (int i = 0; i < slotNames.length; i++)
99      {
100        result = result.push(new Cons("slot " + i, slotNames[i]));
101      }
102    result = result.push(new Cons("shared slots", sharedSlots));
103    return result.nreverse();
104  }
105
106  public LispObject getLispClass()
107  {
108    return lispClass;
109  }
110
111  public boolean isInvalid()
112  {
113    return invalid;
114  }
115
116  public void invalidate()
117  {
118    invalid = true;
119  }
120
121  public LispObject[] getSlotNames()
122  {
123    return slotNames;
124  }
125
126  public int getLength()
127  {
128    return slotNames.length;
129  }
130
131  public LispObject getSharedSlots()
132  {
133    return sharedSlots;
134  }
135
136  @Override
137  public String writeToString()
138  {
139    return unreadableString(Symbol.LAYOUT);
140  }
141
142  // Generates a list of slot definitions for the slot names in this layout.
143  protected LispObject generateSlotDefinitions()
144  {
145    LispObject list = NIL;
146    for (int i = slotNames.length; i-- > 0;)
147      list = list.push(new SlotDefinition(slotNames[i], NIL));
148
149    return list;
150  }
151
152  // ### make-layout
153  private static final Primitive MAKE_LAYOUT =
154    new Primitive("make-layout", PACKAGE_SYS, true,
155                  "class instance-slots class-slots")
156    {
157      @Override
158      public LispObject execute(LispObject first, LispObject second,
159                                LispObject third)
160
161      {
162          return new Layout(first, checkList(second), checkList(third));
163      }
164
165    };
166
167  // ### layout-class
168  private static final Primitive LAYOUT_CLASS =
169    new Primitive("layout-class", PACKAGE_SYS, true, "layout")
170    {
171      @Override
172      public LispObject execute(LispObject arg)
173      {
174          return checkLayout(arg).getLispClass();
175      }
176    };
177
178  // ### layout-length
179  private static final Primitive LAYOUT_LENGTH =
180    new Primitive("layout-length", PACKAGE_SYS, true, "layout")
181    {
182      @Override
183      public LispObject execute(LispObject arg)
184      {
185          return Fixnum.getInstance(checkLayout(arg).slotNames.length);
186      }
187    };
188
189  public int getSlotIndex(LispObject slotName)
190  {
191    LispObject index = slotTable.get(slotName);
192    if (index != null)
193      return ((Fixnum)index).value;
194    return -1;
195  }
196
197  public LispObject getSharedSlotLocation(LispObject slotName)
198
199  {
200    LispObject rest = sharedSlots;
201    while (rest != NIL)
202      {
203        LispObject location = rest.car();
204        if (location.car() == slotName)
205          return location;
206        rest = rest.cdr();
207      }
208    return null;
209  }
210
211  // ### layout-slot-index layout slot-name => index
212  private static final Primitive LAYOUT_SLOT_INDEX =
213    new Primitive("layout-slot-index", PACKAGE_SYS, true)
214    {
215      @Override
216      public LispObject execute(LispObject first, LispObject second)
217
218      {
219          final LispObject slotNames[] = checkLayout(first).slotNames;
220          for (int i = slotNames.length; i-- > 0;)
221            {
222              if (slotNames[i] == second)
223                return Fixnum.getInstance(i);
224            }
225          return NIL;
226      }
227    };
228
229  // ### layout-slot-location layout slot-name => location
230  private static final Primitive LAYOUT_SLOT_LOCATION =
231    new Primitive("layout-slot-location", PACKAGE_SYS, true, "layout slot-name")
232    {
233      @Override
234      public LispObject execute(LispObject first, LispObject second)
235
236      {
237            final Layout layOutFirst = checkLayout(first);
238            final LispObject slotNames[] = layOutFirst.slotNames;
239            final int limit = slotNames.length;
240            for (int i = 0; i < limit; i++)
241              {
242                if (slotNames[i] == second)
243                  return Fixnum.getInstance(i);
244              }
245            // Reaching here, it's not an instance slot.
246            LispObject rest = layOutFirst.sharedSlots;
247            while (rest != NIL)
248              {
249                LispObject location = rest.car();
250                if (location.car() == second)
251                  return location;
252                rest = rest.cdr();
253              }
254            return NIL;
255          }
256    };
257
258  // ### %make-instances-obsolete class => class
259  private static final Primitive _MAKE_INSTANCES_OBSOLETE =
260    new Primitive("%make-instances-obsolete", PACKAGE_SYS, true, "class")
261    {
262      @Override
263      public LispObject execute(LispObject arg)
264      {
265        final LispObject lispClass = arg;
266        LispObject oldLayout;
267        if (lispClass instanceof LispClass)
268            oldLayout = ((LispClass)lispClass).getClassLayout();
269        else
270            oldLayout = Symbol.CLASS_LAYOUT.execute(lispClass);
271
272        Layout newLayout = new Layout((Layout)oldLayout);
273        if (lispClass instanceof LispClass)
274          ((LispClass)lispClass).setClassLayout(newLayout);
275        else
276          Symbol.CLASS_LAYOUT.getSymbolSetfFunction()
277              .execute(newLayout, lispClass);
278        ((Layout)oldLayout).invalidate();
279        return arg;
280      }
281    };
282}
Note: See TracBrowser for help on using the repository browser.