Changeset 3745

Timestamp:

09/14/03 11:37:15 (19 years ago)

Author:

piso

Message:

Moved SYS::%MAKE-ARRAY to make_array.java.
Moved getUpgradedArrayElementType() to Lisp.java.

File:

• trunk/j/src/org/armedbear/lisp/Primitives.java (modified) (3 diffs)

trunk/j/src/org/armedbear/lisp/Primitives.java

@@ -3 +3 @@
  *
  * Copyright (C) 2002-2003 Peter Graves
- * $Id: Primitives.java,v 1.387 2003-09-14 01:37:09 piso Exp $
+ * $Id: Primitives.java,v 1.388 2003-09-14 11:37:15 piso Exp $
  *
  * This program is free software; you can redistribute it and/or
@@ -1837 +1837 @@
     }
 
-    // ### %make-array dimensions element-type initial-element initial-contents
-    // adjustable fill-pointer displaced-to displaced-index-offset
-    private static final Primitive _MAKE_ARRAY =
-        new Primitive("%make-array", PACKAGE_SYS, false) {
-        public LispObject execute(LispObject[] args) throws LispError
-        {
-            if (args.length != 9)
-                throw new WrongNumberOfArgumentsException(this);
-            LispObject dimensions = args[0];
-            LispObject elementType = args[1];
-            LispObject initialElement = args[2];
-            LispObject initialElementProvided = args[3];
-            LispObject initialContents = args[4];
-            LispObject adjustable = args[5];
-            LispObject fillPointer = args[6];
-            LispObject displacedTo = args[7];
-            LispObject displacedIndexOffset = args[8];
-            if (initialElementProvided != NIL && initialContents != NIL) {
-                throw new LispError("MAKE-ARRAY: cannot specify both " +
-                                    ":INITIAL-ELEMENT AND :INITIAL-CONTENTS");
-            }
-            final int rank = dimensions.listp() ? dimensions.length() : 1;
-            if (displacedTo != NIL) {
-                final AbstractArray array = checkArray(displacedTo);
-                final int offset;
-                if (displacedIndexOffset != NIL)
-                    offset = Fixnum.getValue(displacedIndexOffset);
-                else
-                    offset = 0;
-                if (initialElementProvided != NIL)
-                    throw new LispError(":INITIAL-ELEMENT must not be specified with :DISPLACED-TO");
-                if (initialContents != NIL)
-                    throw new LispError(":INITIAL-CONTENTS must not be specified with :DISPLACED-TO");
-                int[] dimv = new int[rank];
-                for (int i = 0; i < rank; i++) {
-                    LispObject dim = dimensions.car();
-                    dimv[i] = Fixnum.getValue(dim);
-                    dimensions = dimensions.cdr();
-                }
-                return new DisplacedArray(dimv, array, offset);
-            }
-            if (rank == 1) {
-                final int size;
-                if (dimensions instanceof Cons)
-                    size = Fixnum.getValue(dimensions.car());
-                else
-                    size = Fixnum.getValue(dimensions);
-                int limit =
-                    Fixnum.getValue(Symbol.ARRAY_DIMENSION_LIMIT.getSymbolValue());
-                if (size < 0 || size >= limit) {
-                    StringBuffer sb = new StringBuffer();
-                    sb.append("the size specified for this array (");
-                    sb.append(size);
-                    sb.append(')');
-                    if (size >= limit) {
-                        sb.append(" is >= ARRAY-DIMENSION-LIMIT (");
-                        sb.append(limit);
-                        sb.append(')');
-                    } else
-                        sb.append(" is negative");
-                    throw new LispError(sb.toString());
-                }
-                AbstractVector v;
-                LispObject upgradedType =
-                    getUpgradedArrayElementType(elementType);
-                if (upgradedType == Symbol.CHARACTER)
-                    v = new LispString(size);
-                else if (elementType == Symbol.BIT)
-                    v = new BitVector(size);
-                else
-                    v = new Vector(size);
-                if (initialElementProvided != NIL) {
-                    // Initial element was specified.
-                    v.fill(initialElement);
-                } else if (initialContents != NIL) {
-                    final int type = initialContents.getType();
-                    if ((type & TYPE_LIST) != 0) {
-                        LispObject list = initialContents;
-                        for (int i = 0; i < size; i++) {
-                            v.set(i, list.car());
-                            list = list.cdr();
-                        }
-                    } else if ((type & TYPE_VECTOR) != 0) {
-                        for (int i = 0; i < size; i++)
-                            v.set(i, initialContents.elt(i));
-                    } else
-                        throw new TypeError(initialContents, "sequence");
-                }
-                if (fillPointer != NIL)
-                    v.setFillPointer(fillPointer);
-                return v;
-            }
-            // rank != 1
-            int[] dimv = new int[rank];
-            for (int i = 0; i < rank; i++) {
-                LispObject dim = dimensions.car();
-                dimv[i] = Fixnum.getValue(dim);
-                dimensions = dimensions.cdr();
-            }
-            Array array;
-            if (initialContents != NIL) {
-                array = new Array(dimv, initialContents);
-            } else {
-                array = new Array(dimv);
-                if (initialElementProvided != NIL)
-                    array.fill(initialElement);
-            }
-            return array;
-        }
-    };
-
     // ### upgraded-array-element-type
     // upgraded-array-element-type typespec &optional environment
@@ -1964 +1853 @@
         }
     };
-
-    private static final LispObject getUpgradedArrayElementType(LispObject type)
-    {
-        if (type == Symbol.CHARACTER || type == Symbol.BASE_CHAR || type == Symbol.STANDARD_CHAR)
-            return Symbol.CHARACTER;
-        if (type == Symbol.BIT)
-            return Symbol.BIT;
-        if (type == NIL)
-            return Symbol.CHARACTER;
-        return T;
-    }
 
     // ### array-rank