TFC/tfcconnection
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

add portable quicklisp

Browse source
This commit is contained in:
Chris Cochrun 2023-06-14 05:45:10 -05:00
parent 3620ead09b
commit 207f1d0234
4737 changed files with 526283 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

43
quicklisp/dists/quicklisp/software/alexandria-20220707-git/alexandria-2/arrays.lisp Normal file
View file

@ -0,0 +1,43 @@
(in-package :alexandria-2)
(defun dim-in-bounds-p (dimensions &rest subscripts)
"Mirrors cl:array-in-bounds-p, but takes dimensions (list of integers) as its
first argument instead of an array.
(array-in-bounds-p arr ...) == (dim-in-bounds-p (array-dimensions arr) ...)"
(and (= (length dimensions) (length subscripts))
(every (lambda (i d) (and (integerp i) (< -1 i d)))
subscripts dimensions)))
(defun row-major-index (dimensions &rest subscripts)
"Mirrors cl:array-row-major-index, but takes dimensions (list of integers)
as its first argument instead of an array.
Signals an error if lengths of dimensions and subscripts are not equal
(array-row-major-index arr ...) == (row-major-index (array-dimensions arr) ...)"
(unless (apply #'dim-in-bounds-p dimensions subscripts)
(error (format nil "Indices ~a invalid for dimensions ~a" subscripts dimensions)))
(loop with word-idx = 0
with dimprod = 1
for dim-size in (reverse dimensions)
for dim-idx in (reverse subscripts)
do
(incf word-idx (* dim-idx dimprod))
(setf dimprod (* dimprod dim-size))
finally (return word-idx)))
(defun rmajor-to-indices (dimensions index)
"The inverse function to row-major-index. Given a set of dimensions and a
row-major index, produce the list of indices <subscripts> such that
(row-major-index dimensions sucscripts) = index"
(when (null dimensions) (error "Dimensions must be non-null"))
(let ((size (reduce #'* dimensions)))
(unless (< -1 index size)
(error (format nil "Row-major index ~a invalid for array of total size ~a" index size))))
(labels ((rec (dimensions index word-sizes acc)
(if (null (cdr dimensions))
(reverse (cons index acc))
(multiple-value-bind (idx remainder) (floor index (car word-sizes))
(rec (cdr dimensions) remainder (cdr word-sizes) (cons idx acc))))))
(rec dimensions index
(cdr (reduce (lambda (x y) (cons (* x (car y)) y)) dimensions
:initial-value '(1) :from-end t))
nil)))

52
quicklisp/dists/quicklisp/software/alexandria-20220707-git/alexandria-2/control-flow.lisp Normal file
View file

@ -0,0 +1,52 @@
(in-package :alexandria-2)
(defun line-up-iter (thread-first-p acc forms)
"Iterative implementation for `thread-iter'.
The THREAD-FIRST-P decides where to thread the FORMS, accumulating in ACC."
(if forms
(line-up-iter thread-first-p
(let ((form (car forms)))
(if (listp form)
(if thread-first-p
(apply #'list (car form) acc (cdr form))
(append form (cons acc nil)))
(list form acc)))
(cdr forms))
acc))
(defmacro line-up-first (&rest forms)
"Lines up FORMS elements as the first argument of their successor.
Example:
(line-up-first
5
(+ 20)
/
(+ 40))
is equivalent to:
(+ (/ (+ 5 20)) 40)
Note how the single '/ got converted into a list before
threading."
(line-up-iter t (car forms) (cdr forms)))
(defmacro line-up-last (&rest forms)
"Lines up FORMS elements as the last argument of their successor.
Example:
(line-up-last
5
(+ 20)
/
(+ 40))
is equivalent to:
(+ 40 (/ (+ 20 5)))
Note how the single '/ got converted into a list before
threading."
(line-up-iter nil (car forms) (cdr forms)))

24
quicklisp/dists/quicklisp/software/alexandria-20220707-git/alexandria-2/lists.lisp Normal file
View file

@ -0,0 +1,24 @@
(in-package :alexandria-2)
(defun delete-from-plist* (plist &rest keys)
"Just like REMOVE-FROM-PLIST, but this version may destructively modify the
provided PLIST.
The second return value is an alist of the removed items, in unspecified order."
;; TODO: a plist?
(declare (optimize speed))
(loop with head = plist
with tail = nil ; a nil tail means an empty result so far
with kept = ()
for (key . rest) on plist by #'cddr
do (assert rest () "Expected a proper plist, got ~S" plist)
(if (member key keys :test #'eq)
;; skip over this pair
(let ((next (cdr rest)))
(push (cons key (car rest))
kept)
(if tail
(setf (cdr tail) next)
(setf head next)))
;; keep this pair
(setf tail rest))
finally (return (values head kept))))

19
quicklisp/dists/quicklisp/software/alexandria-20220707-git/alexandria-2/package.lisp Normal file
View file

@ -0,0 +1,19 @@
(in-package :cl-user)
(defpackage :alexandria-2
(:nicknames :alexandria.2)
(:use :cl :alexandria.1.0.0)
#+sb-package-locks
(:lock t)
(:export
;; arrays
#:dim-in-bounds-p
#:row-major-index
#:rmajor-to-indices
;; lists
#:delete-from-plist*
;; control-flow
#:line-up-first
#:line-up-last
#:subseq*
. #. (let (res) (do-external-symbols (sym :alexandria.1.0.0) (push sym res)) res)
))

9
quicklisp/dists/quicklisp/software/alexandria-20220707-git/alexandria-2/sequences.lisp Normal file
View file

@ -0,0 +1,9 @@
(in-package :alexandria-2)
(defun subseq* (sequence start &optional end)
"Like SUBSEQ, but limits END to the length."
(subseq sequence start
(if end
(min end (length sequence)))))

189
quicklisp/dists/quicklisp/software/alexandria-20220707-git/alexandria-2/tests.lisp Normal file
View file

@ -0,0 +1,189 @@
(in-package :cl-user)
(defpackage :alexandria-2/tests
(:use :cl :alexandria-2 #+sbcl :sb-rt #-sbcl :rtest)
(:import-from #+sbcl :sb-rt #-sbcl :rtest
#:*compile-tests* #:*expected-failures*))
(in-package :alexandria-2/tests)
;; Arrays Tests
(deftest dim-in-bounds-p.0
(dim-in-bounds-p '(2 2) 0 1 1)
nil)
(deftest dim-in-bounds-p.1
(dim-in-bounds-p '(2 2) 0 1)
t)
(deftest dim-in-bounds-p.2
(dim-in-bounds-p '(2 2) 0 2)
nil)
(deftest row-major-index.0
(let* ((dims '(4 3 2 1))
(test-arr (make-array dims))
(idcs '(0 0 0 0)))
(= 0 (apply #'row-major-index dims idcs) (apply #'array-row-major-index test-arr idcs)))
t)
(deftest row-major-index.1
(let* ((dims '(4 3 2 1))
(test-arr (make-array dims))
(idcs '(3 2 1 0)))
(= 23 (apply #'row-major-index dims idcs) (apply #'array-row-major-index test-arr idcs)))
t)
(deftest row-major-index.2
(let* ((dims '(4 3 2 1))
(test-arr (make-array dims))
(idcs '(2 1 0 0)))
(= 14 (apply #'row-major-index dims idcs) (apply #'array-row-major-index test-arr idcs)))
t)
(deftest row-major-index.3
(let* ((dims '(4 3 2 1))
(test-arr (make-array dims))
(idcs '(0 2 1 0)))
(= 5 (apply #'row-major-index dims idcs) (apply #'array-row-major-index test-arr idcs)))
t)
(deftest rmajor-to-indices.0
(loop for dims in '((70 30 4 2) (50 200 5 7) (5 4 300 2) (5 2 30 19))
with index = 173
with indices = '(4 0 3 1)
always (and (= index (apply #'row-major-index dims (rmajor-to-indices dims index)))
(equalp indices (rmajor-to-indices dims
(apply #'row-major-index dims indices)))))
t)
;; List Tests
(deftest delete-from-plist*.middle
(let ((input (list 'a 1 'b 2 'c 3 'd 4 'd 5)))
(multiple-value-list (delete-from-plist* input 'b 'c)))
((a 1 d 4 d 5)
((c . 3) (b . 2))))
(deftest delete-from-plist*.start
(let ((input (list 'a 1 'b 2 'c 3 'd 4 'd 5)))
(multiple-value-list (delete-from-plist* input 'a 'c)))
((b 2 d 4 d 5)
((c . 3) (a . 1))))
;; Control Flow tests
(deftest line-up-first.no-form
(values
(equal (macroexpand '(line-up-first 5))
5)
(equal (macroexpand '(line-up-first (+ 1 2)))
'(+ 1 2)))
t
t)
(deftest line-up-first.function-names-are-threaded
(values
(equal (macroexpand '(line-up-first 5 -))
'(- 5))
(equal (macroexpand '(line-up-first (+ 1 2) -))
'(- (+ 1 2))))
t
t)
(deftest line-up-first.list-promotion
(macroexpand '(line-up-first
5
(+ 20)
(/ 25)
-
(+ 40)))
(+ (- (/ (+ 5 20) 25)) 40)
t)
(deftest line-up-first.multiple-args
(macroexpand '(line-up-first
"this-is-a-string"
(subseq 0 4)))
(subseq "this-is-a-string" 0 4)
t)
(deftest line-up-first.several-examples
(values
(equal (line-up-first (+ 40 2)) 42)
(equal (line-up-first
5
(+ 20)
(/ 25)
-
(+ 40)) 39)
(equal (line-up-first
"this-is-a-string"
(subseq 4 5)
(string-trim "--------good"))
"good"))
t
t
t)
;; Thread last tests
(deftest line-up-last.no-forms
(values
(equal (macroexpand '(line-up-last 5)) 5)
(equal (macroexpand '(line-up-last (+ 1 2))) '(+ 1 2)))
t
t)
(deftest line-up-last.function-names-are-threaded
(values (equal (macroexpand
'(line-up-last 5
-))
'(- 5))
(equal (macroexpand
'(line-up-last (+ 1 2)
-))
'(- (+ 1 2))))
t
t)
(deftest line-up-last.lisp-promotion
(macroexpand '(line-up-last
5
(+ 20)
(/ 25)
-
(+ 40)))
(+ 40 (- (/ 25 (+ 20 5))))
t)
(deftest line-up-last.several-examples
(values (equal (line-up-last (+ 40 2)) 42)
(equal (line-up-last
5
(+ 20)
(/ 25)
-
(+ 40))
39)
(equal (line-up-last
(list 1 -2 3 -4 5)
(mapcar #'abs)
(reduce #'+)
(format nil "abs sum is: ~D"))
"abs sum is: 15"))
t
t
t)
(deftest subseq*.1
(values (subseq* "abcdef" 0 3)
(subseq* "abcdef" 1 3)
(subseq* "abcdef" 1)
(subseq* "abcdef" 1 9))
"abc"
"bc"
"bcdef"
"bcdef")