- ;; given a set of indices. We wrap each index with a call
- ;; to %CHECK-BOUND to ensure that everything works out
- ;; correctly. We can wrap all the interior arithmetic with
- ;; TRULY-THE INDEX because we know the resultant
- ;; row-major index must be an index.
- (with-row-major-index ((array indices index &optional new-value)
- &rest body)
- `(let (n-indices dims)
- (dotimes (i (length ,indices))
- (push (make-symbol (format nil "INDEX-~D" i)) n-indices)
- (push (make-symbol (format nil "DIM-~D" i)) dims))
- (setf n-indices (nreverse n-indices))
- (setf dims (nreverse dims))
- `(lambda (,',array ,@n-indices
- ,@',(when new-value (list new-value)))
- (let* (,@(let ((,index -1))
- (mapcar (lambda (name)
- `(,name (array-dimension
- ,',array
- ,(incf ,index))))
- dims))
- (,',index
- ,(if (null dims)
- 0
- (do* ((dims dims (cdr dims))
- (indices n-indices (cdr indices))
- (last-dim nil (car dims))
- (form `(%check-bound ,',array
- ,(car dims)
- ,(car indices))
- `(truly-the
- index
- (+ (truly-the index
- (* ,form
- ,last-dim))
- (%check-bound
- ,',array
- ,(car dims)
- ,(car indices))))))
- ((null (cdr dims)) form)))))
- ,',@body)))))
+ ;; given a set of indices. We wrap each index with a call
+ ;; to %CHECK-BOUND to ensure that everything works out
+ ;; correctly. We can wrap all the interior arithmetic with
+ ;; TRULY-THE INDEX because we know the resultant
+ ;; row-major index must be an index.
+ (with-row-major-index ((array indices index &optional new-value)
+ &rest body)
+ `(let (n-indices dims)
+ (dotimes (i (length ,indices))
+ (push (make-symbol (format nil "INDEX-~D" i)) n-indices)
+ (push (make-symbol (format nil "DIM-~D" i)) dims))
+ (setf n-indices (nreverse n-indices))
+ (setf dims (nreverse dims))
+ `(lambda (,',array ,@n-indices
+ ,@',(when new-value (list new-value)))
+ (let* (,@(let ((,index -1))
+ (mapcar (lambda (name)
+ `(,name (array-dimension
+ ,',array
+ ,(incf ,index))))
+ dims))
+ (,',index
+ ,(if (null dims)
+ 0
+ (do* ((dims dims (cdr dims))
+ (indices n-indices (cdr indices))
+ (last-dim nil (car dims))
+ (form `(%check-bound ,',array
+ ,(car dims)
+ ,(car indices))
+ `(truly-the
+ index
+ (+ (truly-the index
+ (* ,form
+ ,last-dim))
+ (%check-bound
+ ,',array
+ ,(car dims)
+ ,(car indices))))))
+ ((null (cdr dims)) form)))))
+ ,',@body)))))