X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Farray.lisp;h=a15b4eb69b14369824285fbc449f03a6c2c62d37;hb=6a7709a3d264c897b1fc4df1dd6b0713b710aba7;hp=a90a4bc4bdcfeeb5d98f89770211c1c64187190e;hpb=ef179f90931e56d0dbe88d625e1068e4154ffe85;p=jscl.git

diff --git a/src/array.lisp b/src/array.lisp
index a90a4bc..a15b4eb 100644
--- a/src/array.lisp
+++ b/src/array.lisp
@@ -13,6 +13,8 @@
 ;; You should have received a copy of the GNU General Public License
 ;; along with JSCL.  If not, see <http://www.gnu.org/licenses/>.
 
+(/debug "loading array.lisp!")
+
 (defun upgraded-array-element-type (typespec &optional environment)
   (declare (ignore environment))
   (if (eq typespec 'character)
@@ -25,15 +27,17 @@
          (array (make-storage-vector size)))
     ;; Upgrade type
     (if (eq element-type 'character)
-        (setf element-type 'character
-              initial-element (or initial-element #\space))
+        (progn
+          (oset 1 array "stringp")
+          (setf element-type 'character
+                initial-element (or initial-element #\space)))
         (setf element-type t))
     ;; Initialize array
     (dotimes (i size)
       (storage-vector-set array i initial-element))
     ;; Record and return the object
-    (oset array "type" element-type)
-    (oset array "dimensions" dimensions)
+    (oset element-type array "type")
+    (oset dimensions array "dimensions")
     array))
 
 
@@ -48,7 +52,9 @@
 (defun array-element-type (array)
   (unless (arrayp array)
     (error "~S is not an array." array))
-  (oget array "type"))
+  (if (eq (oget array "stringp") 1)
+      'character
+      (oget array "type")))
 
 (defun array-dimensions (array)
   (unless (arrayp array)
@@ -69,15 +75,30 @@
     (error "~S is not an array." array))  
   (storage-vector-set array index value))
 
+(define-setf-expander aref (array index)
+  (let ((g!array (gensym))
+        (g!index (gensym))
+        (g!value (gensym)))
+    (values (list g!array g!index)
+            (list array index)
+            (list g!value)
+            `(aset ,g!array ,g!index ,g!value)
+            `(aref ,g!array ,g!index))))
+
 
 ;;; Vectors
 
 (defun vectorp (x)
   (and (arrayp x) (null (cdr (array-dimensions x)))))
 
+(defun vector (&rest objects)
+  (list-to-vector objects))
+
 ;;; FIXME: should take optional min-extension.
 ;;; FIXME: should use fill-pointer instead of the absolute end of array
 (defun vector-push-extend (new vector)
+  (unless (vectorp vector)
+    (error "~S is not a vector." vector))  
   (let ((size (storage-vector-size vector)))
     (resize-storage-vector vector (1+ size))
     (aset vector size new)