001: /*
002: * adjust_array.java
003: *
004: * Copyright (C) 2004 Peter Graves
005: * $Id: adjust_array.java,v 1.12 2004/02/26 19:51:04 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: // ### %adjust-array array new-dimensions element-type initial-element
025: // initial-element-p initial-contents initial-contents-p fill-pointer
026: // displaced-to displaced-index-offset => new-array
027: public final class adjust_array extends Primitive {
028: public adjust_array() {
029: super ("%adjust-array", PACKAGE_SYS, false);
030: }
031:
032: public LispObject execute(LispObject[] args)
033: throws ConditionThrowable {
034: if (args.length != 10)
035: return signal(new WrongNumberOfArgumentsException(this ));
036: AbstractArray array = checkArray(args[0]);
037: LispObject dimensions = args[1];
038: LispObject elementType = args[2];
039: LispObject initialElement = args[3];
040: LispObject initialElementProvided = args[4];
041: LispObject initialContents = args[5];
042: LispObject initialContentsProvided = args[6];
043: LispObject fillPointer = args[7];
044: LispObject displacedTo = args[8];
045: LispObject displacedIndexOffset = args[9];
046: if (initialElementProvided != NIL && initialContents != NIL) {
047: return signal(new LispError(
048: "ADJUST-ARRAY: cannot specify both initial element and initial contents."));
049: }
050: if (elementType != array.getElementType()
051: && getUpgradedArrayElementType(elementType) != array
052: .getElementType()) {
053: return signal(new LispError(
054: "ADJUST-ARRAY: incompatible element type."));
055: }
056: if (array.getRank() == 0) {
057: if (initialContentsProvided != NIL)
058: array.setRowMajor(0, initialContents);
059: return array;
060: }
061: if (array.getRank() == 1) {
062: final int newSize;
063: if (dimensions instanceof Cons && dimensions.length() == 1)
064: newSize = Fixnum.getValue(dimensions.car());
065: else
066: newSize = Fixnum.getValue(dimensions);
067: if (array instanceof AbstractVector) {
068: AbstractVector v = (AbstractVector) array;
069: AbstractVector v2;
070: if (displacedTo != NIL) {
071: final int displacement;
072: if (displacedIndexOffset == NIL)
073: displacement = 0;
074: else
075: displacement = Fixnum
076: .getValue(displacedIndexOffset);
077: v2 = v.adjustVector(newSize,
078: checkArray(displacedTo), displacement);
079: } else {
080: v2 = v.adjustVector(newSize, initialElement,
081: initialContents);
082: }
083: if (fillPointer != NIL)
084: v2.setFillPointer(fillPointer);
085: return v2;
086: }
087: }
088: // rank > 1
089: final int rank = dimensions.listp() ? dimensions.length() : 1;
090: int[] dimv = new int[rank];
091: if (dimensions.listp()) {
092: for (int i = 0; i < rank; i++) {
093: LispObject dim = dimensions.car();
094: dimv[i] = Fixnum.getValue(dim);
095: dimensions = dimensions.cdr();
096: }
097: } else
098: dimv[0] = Fixnum.getValue(dimensions);
099: if (array instanceof SimpleArray) {
100: SimpleArray a = (SimpleArray) array;
101: if (displacedTo != NIL) {
102: final int displacement;
103: if (displacedIndexOffset == NIL)
104: displacement = 0;
105: else
106: displacement = Fixnum
107: .getValue(displacedIndexOffset);
108: return a.adjustArray(dimv, checkArray(displacedTo),
109: displacement);
110: } else {
111: return a.adjustArray(dimv, initialElement,
112: initialContents);
113: }
114: }
115: return signal(new LispError("ADJUST-ARRAY: unsupported case."));
116: }
117:
118: private static final Primitive _ADJUST_ARRAY = new adjust_array();
119: }
|