e143b109 |
(in-package #:fwoar.lisputils)
(defmacro vector-destructuring-bind ((&rest symbols) vector &body body)
(let ((mappings (loop for symbol in symbols
|
288c16ae |
for num from 0
collect (list num symbol))))
|
e143b109 |
(once-only (vector)
`(symbol-macrolet ,(mapcar (destructuring-lambda ((num symbol))
|
288c16ae |
`(,symbol (aref ,vector ,num)))
|
5c00eb6b |
mappings)
,@body))))
|
288c16ae |
|
96513b6d |
|
288c16ae |
(defun v-assoc (item vector &key test test-not key)
(loop for cur across vector
for assoc-key = (car cur)
for keyed = (if key (funcall key assoc-key) assoc-key)
|
96513b6d |
if (and test (funcall test item keyed)) do (return cur)
|
5c00eb6b |
else if (and test-not (not (funcall test item keyed))) do (return cur)
else when (eql item keyed) do (return cur)))
|
e143b109 |
(defun v-first (vector)
(elt vector 0))
(defun index-table (table &key (test 'eql) (key 'v-first))
(declare (optimize (speed 0) (debug 3)))
(check-type table (array * (* *)))
(let ((table-index (cl-containers:make-container 'cl-containers:simple-associative-container :test test)))
(loop for row-num from 0 to (1- (array-dimension table 0))
|
5c00eb6b |
for current-row = (make-array (array-dimension table 1)
:displaced-to table
:displaced-index-offset (apply #'array-row-major-index
table (list row-num 0)))
do (setf (cl-containers:item-at table-index (funcall key current-row)) row-num))
|
e143b109 |
table-index))
(defun join-tables (table1 table2 &key (test 'eql) (key1 'v-first) (key2 'v-first))
(declare (optimize (speed 0) (debug 3)))
(check-type table1 (array * (* *)))
(check-type table2 (array * (* *)))
(let ((table2-index (index-table table2 :test test :key key2)))
(loop for row-num from 0 to (1- (array-dimension table1 0))
|
5c00eb6b |
for current-row = (make-array (array-dimension table1 1)
:displaced-to table1
:displaced-index-offset (apply #'array-row-major-index
table1 (list row-num 0)))
for dest-index = (cl-containers:item-at table2-index (funcall key1 current-row))
when dest-index
collect (let* ((to-row (make-array (array-dimension table2 1)
:displaced-to table2
:displaced-index-offset (apply #'array-row-major-index
table2 (list dest-index 0)))))
(concatenate 'vector current-row to-row)))))
|
e143b109 |
|