001: /*
002: * make_array.java
003: *
004: * Copyright (C) 2003-2004 Peter Graves
005: * $Id: make_array.java,v 1.24 2004/03/09 11:10:26 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: // ### %make-array dimensions element-type initial-element initial-element-p
025: // initial-contents adjustable fill-pointer displaced-to displaced-index-offset
026: // => new-array
027: public final class make_array extends Primitive {
028: public make_array() {
029: super ("%make-array", PACKAGE_SYS, false);
030: }
031:
032: public LispObject execute(LispObject[] args)
033: throws ConditionThrowable {
034: if (args.length != 9)
035: return signal(new WrongNumberOfArgumentsException(this ));
036: LispObject dimensions = args[0];
037: LispObject elementType = args[1];
038: LispObject initialElement = args[2];
039: LispObject initialElementProvided = args[3];
040: LispObject initialContents = args[4];
041: LispObject adjustable = args[5];
042: LispObject fillPointer = args[6];
043: LispObject displacedTo = args[7];
044: LispObject displacedIndexOffset = args[8];
045: if (initialElementProvided != NIL && initialContents != NIL) {
046: return signal(new LispError(
047: "MAKE-ARRAY: cannot specify both "
048: + "initial element and initial contents."));
049: }
050: final int rank = dimensions.listp() ? dimensions.length() : 1;
051: int[] dimv = new int[rank];
052: if (dimensions.listp()) {
053: for (int i = 0; i < rank; i++) {
054: LispObject dim = dimensions.car();
055: dimv[i] = Fixnum.getValue(dim);
056: dimensions = dimensions.cdr();
057: }
058: } else
059: dimv[0] = Fixnum.getValue(dimensions);
060: if (displacedTo != NIL) {
061: // FIXME Make sure element type (if specified) is compatible with
062: // displaced-to array.
063: final AbstractArray array = checkArray(displacedTo);
064: if (initialElementProvided != NIL)
065: return signal(new LispError(
066: "Initial element must not be specified for a displaced array."));
067: if (initialContents != NIL)
068: return signal(new LispError(
069: "Initial contents must not be specified for a displaced array."));
070: final int displacement;
071: if (displacedIndexOffset != NIL)
072: displacement = Fixnum.getValue(displacedIndexOffset);
073: else
074: displacement = 0;
075: if (rank == 1) {
076: AbstractVector v;
077: if (array.getElementType() == Symbol.CHARACTER) {
078: v = new ComplexString(dimv[0], array, displacement);
079: } else if (array.getElementType() == Symbol.BIT) {
080: v = new ComplexBitVector(dimv[0], array,
081: displacement);
082: } else {
083: v = new ComplexVector(dimv[0], array, displacement);
084: }
085: if (fillPointer != NIL)
086: v.setFillPointer(fillPointer);
087: return v;
088: }
089: return new ComplexArray(dimv, array, displacement);
090: }
091: LispObject upgradedType = getUpgradedArrayElementType(elementType);
092: if (rank == 0) {
093: LispObject data;
094: if (initialElementProvided != NIL)
095: data = initialElement;
096: else
097: data = initialContents;
098: return new ZeroRankArray(upgradedType, data,
099: adjustable != NIL);
100: }
101: if (rank == 1) {
102: final int size = dimv[0];
103: if (size < 0 || size >= ARRAY_DIMENSION_MAX) {
104: StringBuffer sb = new StringBuffer();
105: sb.append("The size specified for this array (");
106: sb.append(size);
107: sb.append(')');
108: if (size >= ARRAY_DIMENSION_MAX) {
109: sb.append(" is >= ARRAY-DIMENSION-LIMIT (");
110: sb.append(ARRAY_DIMENSION_MAX);
111: sb.append(").");
112: } else
113: sb.append(" is negative.");
114: return signal(new LispError(sb.toString()));
115: }
116: AbstractVector v;
117: if (upgradedType == Symbol.CHARACTER) {
118: if (fillPointer != NIL || adjustable != NIL)
119: v = new ComplexString(size);
120: else
121: v = new SimpleString(size);
122: } else if (upgradedType == Symbol.BIT) {
123: if (fillPointer != NIL || adjustable != NIL)
124: v = new ComplexBitVector(size);
125: else
126: v = new SimpleBitVector(size);
127: } else if (upgradedType == NIL)
128: v = new NilVector(size);
129: else {
130: if (fillPointer != NIL || adjustable != NIL)
131: v = new ComplexVector(size);
132: else
133: v = new SimpleVector(size);
134: }
135: if (initialElementProvided != NIL) {
136: // Initial element was specified.
137: v.fill(initialElement);
138: } else if (initialContents != NIL) {
139: if (initialContents.listp()) {
140: LispObject list = initialContents;
141: for (int i = 0; i < size; i++) {
142: v.setRowMajor(i, list.car());
143: list = list.cdr();
144: }
145: } else if (initialContents.vectorp()) {
146: for (int i = 0; i < size; i++)
147: v.setRowMajor(i, initialContents.elt(i));
148: } else
149: return signal(new TypeError(initialContents,
150: Symbol.SEQUENCE));
151: }
152: if (fillPointer != NIL)
153: v.setFillPointer(fillPointer);
154: return v;
155: }
156: // rank > 1
157: AbstractArray array;
158: if (adjustable == NIL) {
159: if (initialContents != NIL) {
160: array = new SimpleArray(dimv, upgradedType,
161: initialContents);
162: } else {
163: array = new SimpleArray(dimv, upgradedType);
164: if (initialElementProvided != NIL)
165: array.fill(initialElement);
166: }
167: } else {
168: if (initialContents != NIL) {
169: array = new ComplexArray(dimv, upgradedType,
170: initialContents);
171: } else {
172: array = new ComplexArray(dimv, upgradedType);
173: if (initialElementProvided != NIL)
174: array.fill(initialElement);
175: }
176: }
177: return array;
178: }
179:
180: private static final Primitive _MAKE_ARRAY = new make_array();
181: }
|