Changeset 3624

Timestamp:

09/08/03 17:16:28 (19 years ago)

Author:

piso

Message:

%MAKE-ARRAY
UPGRADED-ARRAY-ELEMENT-TYPE

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.376 2003-09-08 13:34:38 piso Exp $
+ * $Id: Primitives.java,v 1.377 2003-09-08 17:16:28 piso Exp $
  *
  * This program is free software; you can redistribute it and/or
@@ -1900 +1900 @@
                 }
                 AbstractVector v;
-                if (elementType == Symbol.CHARACTER ||
-                    elementType == Symbol.BASE_CHAR ||
-                    elementType == Symbol.STANDARD_CHAR ||
-                    elementType == Symbol.NIL) {
+                LispObject upgradedType =
+                    getUpgradedArrayElementType(elementType);
+                if (upgradedType == Symbol.CHARACTER)
                     v = new LispString(size);
-                } else if (elementType == Symbol.BIT) {
+                else if (elementType == Symbol.BIT)
                     v = new BitVector(size);
-                } else {
-                    // FIXME If elementType != null it should be a known type.
+                else
                     v = new Vector(size);
-                }
                 if (initialElementProvided != NIL) {
                     // Initial element was specified.
@@ -1950 +1947 @@
         }
     };
+
+    // ### upgraded-array-element-type
+    // upgraded-array-element-type typespec &optional environment
+    // => upgraded-typespec
+    private static final Primitive UPGRADED_ARRAY_ELEMENT_TYPE =
+        new Primitive("upgraded-array-element-type") {
+        public LispObject execute(LispObject arg) throws LispError
+        {
+            return getUpgradedArrayElementType(arg);
+        }
+        public LispObject execute(LispObject first, LispObject second)
+            throws LispError
+        {
+            // Ignore environment.
+            return getUpgradedArrayElementType(first);
+        }
+    };
+
+    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