Convert JS AST to strings in ls-compile-toplevel
[jscl.git] / src / array.lisp
1 ;;; arrays.lisp
2
3 ;; JSCL is free software: you can redistribute it and/or
4 ;; modify it under the terms of the GNU General Public License as
5 ;; published by the Free Software Foundation, either version 3 of the
6 ;; License, or (at your option) any later version.
7 ;;
8 ;; JSCL is distributed in the hope that it will be useful, but
9 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
10 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
11 ;; General Public License for more details.
12 ;;
13 ;; You should have received a copy of the GNU General Public License
14 ;; along with JSCL.  If not, see <http://www.gnu.org/licenses/>.
15
16 (defun upgraded-array-element-type (typespec &optional environment)
17   (declare (ignore environment))
18   (if (eq typespec 'character)
19       'character
20       t))
21
22 (defun make-array (dimensions &key element-type initial-element adjustable fill-pointer)
23   (let* ((dimensions (ensure-list dimensions))
24          (size (!reduce #'* dimensions 1))
25          (array (make-storage-vector size)))
26     ;; Upgrade type
27     (if (eq element-type 'character)
28         (progn
29           (oset 1 array "stringp")
30           (setf element-type 'character
31                 initial-element (or initial-element #\space)))
32         (setf element-type t))
33     ;; Initialize array
34     (dotimes (i size)
35       (storage-vector-set array i initial-element))
36     ;; Record and return the object
37     (oset element-type array "type")
38     (oset dimensions array "dimensions")
39     array))
40
41
42 (defun arrayp (x)
43   (storage-vector-p x))
44
45 (defun adjustable-array-p (array)
46   (unless (arrayp array)
47     (error "~S is not an array." array))
48   t)
49
50 (defun array-element-type (array)
51   (unless (arrayp array)
52     (error "~S is not an array." array))
53   (if (eq (oget array "stringp") 1)
54       'character
55       (oget array "type")))
56
57 (defun array-dimensions (array)
58   (unless (arrayp array)
59     (error "~S is not an array." array))
60   (oget array "dimensions"))
61
62 ;; TODO: Error checking
63 (defun array-dimension (array axis)
64   (nth axis (array-dimensions array)))
65
66 (defun aref (array index)
67   (unless (arrayp array)
68     (error "~S is not an array." array))  
69   (storage-vector-ref array index))
70
71 (defun aset (array index value)
72   (unless (arrayp array)
73     (error "~S is not an array." array))  
74   (storage-vector-set array index value))
75
76 (define-setf-expander aref (array index)
77   (let ((g!array (gensym))
78         (g!index (gensym))
79         (g!value (gensym)))
80     (values (list g!array g!index)
81             (list array index)
82             (list g!value)
83             `(aset ,g!array ,g!index ,g!value)
84             `(aref ,g!array ,g!index))))
85
86
87 ;;; Vectors
88
89 (defun vectorp (x)
90   (and (arrayp x) (null (cdr (array-dimensions x)))))
91
92 (defun vector (&rest objects)
93   (list-to-vector objects))
94
95 ;;; FIXME: should take optional min-extension.
96 ;;; FIXME: should use fill-pointer instead of the absolute end of array
97 (defun vector-push-extend (new vector)
98   (unless (vectorp vector)
99     (error "~S is not a vector." vector))  
100   (let ((size (storage-vector-size vector)))
101     (resize-storage-vector vector (1+ size))
102     (aset vector size new)
103     size))