001: /*
002: * make_array.java
003: *
004: * Copyright (C) 2003 Peter Graves
005: * $Id: make_array.java,v 1.6 2003/11/15 11:03:32 beedlem 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-contents
025: // adjustable fill-pointer displaced-to displaced-index-offset => new-array
026: public final class make_array extends Primitive {
027: public make_array(String name, Package pkg, boolean exported) {
028: super (name, pkg, exported);
029: }
030:
031: public LispObject execute(LispObject[] args)
032: throws ConditionThrowable {
033: if (args.length != 9)
034: throw new ConditionThrowable(
035: 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: throw new ConditionThrowable(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: final AbstractArray array = checkArray(displacedTo);
062: final int offset;
063: if (displacedIndexOffset != NIL)
064: offset = Fixnum.getValue(displacedIndexOffset);
065: else
066: offset = 0;
067: if (initialElementProvided != NIL)
068: throw new ConditionThrowable(
069: new LispError(
070: ":INITIAL-ELEMENT must not be specified with :DISPLACED-TO"));
071: if (initialContents != NIL)
072: throw new ConditionThrowable(
073: new LispError(
074: ":INITIAL-CONTENTS must not be specified with :DISPLACED-TO"));
075: return new DisplacedArray(dimv, array, offset);
076: }
077: if (rank == 1) {
078: final int size = dimv[0];
079: int limit = Fixnum.getValue(Symbol.ARRAY_DIMENSION_LIMIT
080: .getSymbolValue());
081: if (size < 0 || size >= limit) {
082: StringBuffer sb = new StringBuffer();
083: sb.append("the size specified for this array (");
084: sb.append(size);
085: sb.append(')');
086: if (size >= limit) {
087: sb.append(" is >= ARRAY-DIMENSION-LIMIT (");
088: sb.append(limit);
089: sb.append(')');
090: } else
091: sb.append(" is negative");
092: throw new ConditionThrowable(new LispError(sb
093: .toString()));
094: }
095: AbstractVector v;
096: LispObject upgradedType = getUpgradedArrayElementType(elementType);
097: if (upgradedType == Symbol.CHARACTER)
098: v = new LispString(size);
099: else if (elementType == Symbol.BIT)
100: v = new BitVector(size);
101: else
102: v = new Vector(size);
103: if (initialElementProvided != NIL) {
104: // Initial element was specified.
105: v.fill(initialElement);
106: } else if (initialContents != NIL) {
107: if (initialContents.listp()) {
108: LispObject list = initialContents;
109: for (int i = 0; i < size; i++) {
110: v.set(i, list.car());
111: list = list.cdr();
112: }
113: } else if (initialContents.vectorp()) {
114: for (int i = 0; i < size; i++)
115: v.set(i, initialContents.elt(i));
116: } else
117: throw new ConditionThrowable(new TypeError(
118: initialContents, "sequence"));
119: }
120: if (fillPointer != NIL)
121: v.setFillPointer(fillPointer);
122: return v;
123: }
124: // rank != 1
125: Array array;
126: if (initialContents != NIL) {
127: array = new Array(dimv, initialContents);
128: } else {
129: array = new Array(dimv);
130: if (initialElementProvided != NIL)
131: array.fill(initialElement);
132: }
133: return array;
134: }
135:
136: private static final make_array _MAKE_ARRAY = new make_array(
137: "%MAKE-ARRAY", PACKAGE_SYS, false);
138: }
|