Coverage report: /home/ellis/.stash/quicklisp/dists/quicklisp/software/alexandria-20241012-git/alexandria-2/arrays.lisp

KindCoveredAll%
expression094 0.0
branch014 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 (in-package :alexandria-2)
2
 
3
 (defun dim-in-bounds-p (dimensions &rest subscripts)
4
   "Mirrors cl:array-in-bounds-p, but takes dimensions (list of integers) as its
5
    first argument instead of an array.
6
    (array-in-bounds-p arr ...) == (dim-in-bounds-p (array-dimensions arr) ...)"
7
   (and (= (length dimensions) (length subscripts))
8
        (every (lambda (i d) (and (integerp i) (< -1 i d)))
9
               subscripts dimensions)))
10
 
11
 (defun row-major-index (dimensions &rest subscripts)
12
   "Mirrors cl:array-row-major-index, but takes dimensions (list of integers)
13
    as its first argument instead of an array.
14
    Signals an error if lengths of dimensions and subscripts are not equal
15
    (array-row-major-index arr ...) == (row-major-index (array-dimensions arr) ...)"
16
   (unless (apply #'dim-in-bounds-p dimensions subscripts)
17
     (error (format nil "Indices ~a invalid for dimensions ~a" subscripts dimensions)))
18
   (loop with word-idx = 0
19
         with dimprod = 1
20
         for dim-size in (reverse dimensions)
21
         for dim-idx in (reverse subscripts)
22
         do
23
            (incf word-idx (* dim-idx dimprod))
24
            (setf dimprod (* dimprod dim-size))
25
         finally (return word-idx)))
26
 
27
 (defun rmajor-to-indices (dimensions index)
28
   "The inverse function to row-major-index. Given a set of dimensions and a
29
    row-major index, produce the list of indices <subscripts> such that
30
    (row-major-index dimensions sucscripts) = index"
31
   (when (null dimensions) (error "Dimensions must be non-null"))
32
   (let ((size (reduce #'* dimensions)))
33
     (unless (< -1 index size)
34
       (error (format nil "Row-major index ~a invalid for array of total size ~a" index size))))
35
   (labels ((rec (dimensions index word-sizes acc)
36
              (if (null (cdr dimensions))
37
                  (reverse (cons index acc))
38
                  (multiple-value-bind (idx remainder) (floor index (car word-sizes))
39
                    (rec (cdr dimensions) remainder (cdr word-sizes) (cons idx acc))))))
40
     (rec dimensions index
41
          (cdr (reduce (lambda (x y) (cons (* x (car y)) y)) dimensions
42
                       :initial-value '(1) :from-end t))
43
          nil)))