KickJava   Java API By Example, From Geeks To Geeks.

Java > Open Source Codes > org > armedbear > lisp > make_array


1 /*
2  * make_array.java
3  *
4  * Copyright (C) 2003-2004 Peter Graves
5  * $Id: make_array.java,v 1.24 2004/03/09 11:10:26 piso Exp $
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
22 package org.armedbear.lisp;
23
24 // ### %make-array dimensions element-type initial-element initial-element-p
25
// initial-contents adjustable fill-pointer displaced-to displaced-index-offset
26
// => new-array
27
public final class make_array extends Primitive
28 {
29     public make_array()
30     {
31         super("%make-array", PACKAGE_SYS, false);
32     }
33
34     public LispObject execute(LispObject[] args) throws ConditionThrowable
35     {
36         if (args.length != 9)
37             return signal(new WrongNumberOfArgumentsException(this));
38         LispObject dimensions = args[0];
39         LispObject elementType = args[1];
40         LispObject initialElement = args[2];
41         LispObject initialElementProvided = args[3];
42         LispObject initialContents = args[4];
43         LispObject adjustable = args[5];
44         LispObject fillPointer = args[6];
45         LispObject displacedTo = args[7];
46         LispObject displacedIndexOffset = args[8];
47         if (initialElementProvided != NIL && initialContents != NIL) {
48             return signal(new LispError("MAKE-ARRAY: cannot specify both " +
49                                         "initial element and initial contents."));
50         }
51         final int rank = dimensions.listp() ? dimensions.length() : 1;
52         int[] dimv = new int[rank];
53         if (dimensions.listp()) {
54             for (int i = 0; i < rank; i++) {
55                 LispObject dim = dimensions.car();
56                 dimv[i] = Fixnum.getValue(dim);
57                 dimensions = dimensions.cdr();
58             }
59         } else
60             dimv[0] = Fixnum.getValue(dimensions);
61         if (displacedTo != NIL) {
62             // FIXME Make sure element type (if specified) is compatible with
63
// displaced-to array.
64
final AbstractArray array = checkArray(displacedTo);
65             if (initialElementProvided != NIL)
66                 return signal(new LispError("Initial element must not be specified for a displaced array."));
67             if (initialContents != NIL)
68                 return signal(new LispError("Initial contents must not be specified for a displaced array."));
69             final int displacement;
70             if (displacedIndexOffset != NIL)
71                 displacement = Fixnum.getValue(displacedIndexOffset);
72             else
73                 displacement = 0;
74             if (rank == 1) {
75                 AbstractVector v;
76                 if (array.getElementType() == Symbol.CHARACTER) {
77                     v = new ComplexString(dimv[0], array, displacement);
78                 } else if (array.getElementType() == Symbol.BIT) {
79                     v = new ComplexBitVector(dimv[0], array, displacement);
80                 } else {
81                     v = new ComplexVector(dimv[0], array, displacement);
82                 }
83                 if (fillPointer != NIL)
84                     v.setFillPointer(fillPointer);
85                 return v;
86             }
87             return new ComplexArray(dimv, array, displacement);
88         }
89         LispObject upgradedType =
90             getUpgradedArrayElementType(elementType);
91         if (rank == 0) {
92             LispObject data;
93             if (initialElementProvided != NIL)
94                 data = initialElement;
95             else
96                 data = initialContents;
97             return new ZeroRankArray(upgradedType, data, adjustable != NIL);
98         }
99         if (rank == 1) {
100             final int size = dimv[0];
101             if (size < 0 || size >= ARRAY_DIMENSION_MAX) {
102                 StringBuffer JavaDoc sb = new StringBuffer JavaDoc();
103                 sb.append("The size specified for this array (");
104                 sb.append(size);
105                 sb.append(')');
106                 if (size >= ARRAY_DIMENSION_MAX) {
107                     sb.append(" is >= ARRAY-DIMENSION-LIMIT (");
108                     sb.append(ARRAY_DIMENSION_MAX);
109                     sb.append(").");
110                 } else
111                     sb.append(" is negative.");
112                 return signal(new LispError(sb.toString()));
113             }
114             AbstractVector v;
115             if (upgradedType == Symbol.CHARACTER) {
116                 if (fillPointer != NIL || adjustable != NIL)
117                     v = new ComplexString(size);
118                 else
119                     v = new SimpleString(size);
120             } else if (upgradedType == Symbol.BIT) {
121                 if (fillPointer != NIL || adjustable != NIL)
122                     v = new ComplexBitVector(size);
123                 else
124                     v = new SimpleBitVector(size);
125             } else if (upgradedType == NIL)
126                 v = new NilVector(size);
127             else {
128                 if (fillPointer != NIL || adjustable != NIL)
129                     v = new ComplexVector(size);
130                 else
131                     v = new SimpleVector(size);
132             }
133             if (initialElementProvided != NIL) {
134                 // Initial element was specified.
135
v.fill(initialElement);
136             } else if (initialContents != NIL) {
137                 if (initialContents.listp()) {
138                     LispObject list = initialContents;
139                     for (int i = 0; i < size; i++) {
140                         v.setRowMajor(i, list.car());
141                         list = list.cdr();
142                     }
143                 } else if (initialContents.vectorp()) {
144                     for (int i = 0; i < size; i++)
145                         v.setRowMajor(i, initialContents.elt(i));
146                 } else
147                     return signal(new TypeError(initialContents, Symbol.SEQUENCE));
148             }
149             if (fillPointer != NIL)
150                 v.setFillPointer(fillPointer);
151             return v;
152         }
153         // rank > 1
154
AbstractArray array;
155         if (adjustable == NIL) {
156             if (initialContents != NIL) {
157                 array = new SimpleArray(dimv, upgradedType, initialContents);
158             } else {
159                 array = new SimpleArray(dimv, upgradedType);
160                 if (initialElementProvided != NIL)
161                     array.fill(initialElement);
162             }
163         } else {
164             if (initialContents != NIL) {
165                 array = new ComplexArray(dimv, upgradedType, initialContents);
166             } else {
167                 array = new ComplexArray(dimv, upgradedType);
168                 if (initialElementProvided != NIL)
169                     array.fill(initialElement);
170             }
171         }
172         return array;
173     }
174
175     private static final Primitive _MAKE_ARRAY = new make_array();
176 }
177
Popular Tags