source: trunk/abcl/src/org/armedbear/lisp/ZeroRankArray.java

Last change on this file was 14466, checked in by rschlatte, 11 years ago

call type_error when possible

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 5.8 KB
Line 
1/*
2 * ZeroRankArray.java
3 *
4 * Copyright (C) 2004-2005 Peter Graves
5 * $Id: ZeroRankArray.java 14466 2013-04-24 12:50:40Z rschlatte $
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 final class ZeroRankArray extends AbstractArray
39{
40    private final LispObject elementType;
41    private final boolean adjustable;
42
43    private LispObject data;
44
45    public ZeroRankArray(LispObject elementType, LispObject data,
46                         boolean adjustable)
47    {
48        this.elementType = elementType;
49        this.data = data;
50        this.adjustable = adjustable;
51    }
52
53    @Override
54    public LispObject typeOf()
55    {
56        if (adjustable)
57            return list(Symbol.ARRAY, elementType, NIL);
58        else
59            return list(Symbol.SIMPLE_ARRAY, elementType, NIL);
60    }
61
62    @Override
63    public LispObject classOf()
64    {
65        return BuiltInClass.ARRAY;
66    }
67
68    @Override
69    public LispObject typep(LispObject type)
70    {
71        if (type == Symbol.SIMPLE_ARRAY)
72            return adjustable ? NIL : T;
73        return super.typep(type);
74    }
75
76    @Override
77    public int getRank()
78    {
79        return 0;
80    }
81
82    @Override
83    public LispObject getDimensions()
84    {
85        return NIL;
86    }
87
88    @Override
89    public int getDimension(int n)
90    {
91        error(new TypeError("Bad array dimension (" + n + ") for array of rank 0."));
92        // Not reached.
93        return -1;
94    }
95
96    @Override
97    public LispObject getElementType()
98    {
99        return elementType;
100    }
101
102    @Override
103    public int getTotalSize()
104    {
105        return 1;
106    }
107
108    @Override
109    public LispObject AREF(int index)
110    {
111        if (index == 0)
112            return data;
113        else
114            return error(new TypeError("Bad row major index " + index + "."));
115    }
116
117    @Override
118    public void aset(int index, LispObject obj)
119    {
120        if (obj.typep(elementType) == NIL)
121            type_error(obj, elementType);
122        if (index == 0)
123            data = obj;
124        else
125            error(new TypeError("Bad row major index " + index + "."));
126    }
127
128    @Override
129    public void fill(LispObject obj)
130    {
131        if (obj.typep(elementType) == NIL)
132            type_error(obj, elementType);
133        data = obj;
134    }
135
136    @Override
137    public String printObject()
138    {
139        final LispThread thread = LispThread.currentThread();
140        boolean printReadably = (Symbol.PRINT_READABLY.symbolValue(thread) != NIL);
141        if (printReadably) {
142            if (elementType != T) {
143                error(new PrintNotReadable(list(Keyword.OBJECT, this)));
144                // Not reached.
145                return null;
146            }
147        }
148        if (printReadably || Symbol.PRINT_ARRAY.symbolValue(thread) != NIL) {
149            StringBuffer sb = new StringBuffer("#0A");
150            if (data == this && Symbol.PRINT_CIRCLE.symbolValue(thread) != NIL) {
151                StringOutputStream stream = new StringOutputStream();
152                thread.execute(Symbol.OUTPUT_OBJECT.getSymbolFunction(),
153                               data, stream);
154                sb.append(stream.getString().getStringValue());
155            } else
156                sb.append(data.printObject());
157            return sb.toString();
158        }
159        StringBuffer sb = new StringBuffer();
160        if (!adjustable)
161            sb.append("SIMPLE-");
162        sb.append("ARRAY ");
163        sb.append(elementType.printObject());
164        sb.append(" NIL");
165        return unreadableString(sb.toString());
166    }
167
168  @Override
169  public AbstractArray adjustArray(int[] dims,
170                                              LispObject initialElement,
171                                              LispObject initialContents)
172    {
173      if (isAdjustable()) {
174          // initial element doesn't matter:
175          // we're not creating new elements
176          if (initialContents != null)
177              data = initialContents;
178          return this;
179      } else {
180          return new ZeroRankArray(elementType,
181                  initialContents != null ? initialContents :
182                      initialElement != null ? initialElement : data, false);
183      }
184  }
185
186  @Override
187  public AbstractArray adjustArray(int[] dims,
188                                              AbstractArray displacedTo,
189                                              int displacement)
190    {
191      error(new TypeError("Displacement not supported for array of rank 0."));
192      return null;
193  }
194}
Note: See TracBrowser for help on using the repository browser.