diff options
| -rw-r--r-- | MLKArray.h | 2 | ||||
| -rw-r--r-- | MLKArray.m | 5 | ||||
| -rw-r--r-- | Sacla/array.lisp | 9 | ||||
| -rw-r--r-- | Sacla/data-and-control.lisp | 3 | ||||
| -rw-r--r-- | array.lisp | 33 | ||||
| -rw-r--r-- | control-flow.lisp | 21 | ||||
| -rw-r--r-- | init.lisp | 5 | ||||
| -rw-r--r-- | numbers.lisp | 54 |
8 files changed, 131 insertions, 1 deletions
@@ -32,6 +32,8 @@ -(id) initWithDimensions:(NSArray *)dimensions; +-(NSArray *) dimensions; + // The following methods are like the similarly named // NSArray/NSMutableArray methods but treat nil as just another object. // Where nil would be returned otherwise, these methods throw an @@ -50,6 +50,11 @@ return self; } +-(NSArray *) dimensions +{ + return _dimensions; +} + -(id) idAtIndex:(NSUInteger)index { if (index > _size || (_fillPointer != -1 && index > _fillPointer)) diff --git a/Sacla/array.lisp b/Sacla/array.lisp index 4fd0147..23b6c39 100644 --- a/Sacla/array.lisp +++ b/Sacla/array.lisp @@ -27,6 +27,15 @@ ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +(in-package #:common-lisp) + +(export '(aref array-dimenion array-in-bounds-p array-rank + array-row-major-index array-total-size bit-andc1 bit-andc2 + bit-eqv bit-nand bit-nor bit-orc1 bit-orc2 bit-vector-p + simple-bit-vector-p vector vector-pop vector-push + vector-push-extend vectorp )) + + (defun aref (array &rest subscripts) "Access an element of ARRAY specified by SUBSCRIPTS." (row-major-aref array (apply #'array-row-major-index array subscripts))) diff --git a/Sacla/data-and-control.lisp b/Sacla/data-and-control.lisp index cea7493..236440b 100644 --- a/Sacla/data-and-control.lisp +++ b/Sacla/data-and-control.lisp @@ -26,6 +26,9 @@ ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +(in-package #:common-lisp) + + (defun expand-case (keyform clauses &key (test #'eql)) (let ((key (gensym)) (last (car (last clauses)))) diff --git a/array.lisp b/array.lisp new file mode 100644 index 0000000..2676c06 --- /dev/null +++ b/array.lisp @@ -0,0 +1,33 @@ +;;; -*- mode: lisp; coding: utf-8 -*- +;;; Toilet Lisp, a Common Lisp subset for the Étoilé runtime. +;;; Copyright (C) 2008 Matthias Andreas Benkard. +;;; +;;; This program is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation, either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see <http://www.gnu.org/licenses/>. + + +(in-package #:common-lisp) + +(export '(aref row-major-aref)) + + +(defun row-major-aref (array row-major-index) + (send-by-name array "idAtIndex:" row-major-index)) + +(defun (setf row-major-aref) (new-value array row-major-index) + (send-by-name array "replaceIdAtIndex:withId:" row-major-index new-value)) + +(defun array-dimensions (array) + (send-by-name (find-objc-class "MLKCons") + "listWithArray:" + (send-by-name array "dimensions"))) diff --git a/control-flow.lisp b/control-flow.lisp index a75fe6a..bcd8e23 100644 --- a/control-flow.lisp +++ b/control-flow.lisp @@ -236,3 +236,24 @@ (defun values-list (list) (apply #'values list)) + + +;; FIXME +(defmacro assert (form &optional places datum &rest args) + ) + +;; FIXME +(defmacro check-type (thing type &rest strings) + ) + +;; FIXME +(defmacro defsetf (&rest args) + ) + +;; FIXME +(defun get-setf-expansion (&rest args) + (values nil nil nil `(error "SETF not implemented") `(error "SETF not implemented"))) + +;; FIXME +(defmacro define-setf-expander (&rest args) + ) @@ -38,6 +38,11 @@ (load "Sacla/share-2.lisp") +(load "Sacla/data-and-control.lisp") + +(load "array.lisp") +(load "Sacla/array.lisp") + (setq *system-initialised-p* t) (in-package #:common-lisp-user) diff --git a/numbers.lisp b/numbers.lisp index 607ccab..af58878 100644 --- a/numbers.lisp +++ b/numbers.lisp @@ -18,7 +18,7 @@ (in-package #:common-lisp) -(export '(1+ 1- =)) +(export '(1+ 1- = mod evenp oddp zerop + - *)) (defun 1+ (n) @@ -39,3 +39,55 @@ (integer (etypecase y (fixnum nil) (integer (%= x y)))))) + +(defun + (x y) + (etypecase x + (fixnum (etypecase y + (fixnum (add-fixnums x y)) + (integer (send-by-name x "add:" y)))) + (integer (etypecase y + (integer (send-by-name x "add:" y)))))) + +(defun - (x y) + (etypecase x + (fixnum (etypecase y + (fixnum (subtract-fixnums x y)) + (integer (send-by-name x "subtract:" y)))) + (integer (etypecase y + (integer (send-by-name x "subtract:" y)))))) + +(defun * (x y) + (etypecase x + (fixnum (etypecase y + (fixnum (multiply-fixnums x y)) + (integer (send-by-name x "multiplyWith:" y)))) + (integer (etypecase y + (integer (send-by-name x "multiplyWith:" y)))))) + +(defun idiv (x y) + (etypecase x + (fixnum (etypecase y + (fixnum (idivide-fixnums x y)) + (integer (send-by-name x "divideBy:" y)))) + (integer (etypecase y + (integer (send-by-name x "divideBy:" y)))))) + +(defun mod (n m) +;; (if (and (typep n 'fixnum) +;; (typep m 'fixnum)) +;; (fixnum-mod n m) +;; (send-by-name n "mod:" m)) + (send-by-name n "mod:" m)) + + +(defun evenp (n) + (etypecase n + (fixnum (zerop (mod n 2))) + (integer (send-by-name n "evenp")))) + +(defun oddp (n) + (not (evenp n))) + +(defun zerop (n) + (etypecase n + (integer (%zerop n)))) |