diff --git a/alexandria-2/control-flow.lisp b/alexandria-2/control-flow.lisp new file mode 100644 index 0000000000000000000000000000000000000000..a78bd552c538c4a2924c10ff41d62b85da4ddd15 --- /dev/null +++ b/alexandria-2/control-flow.lisp @@ -0,0 +1,46 @@ +(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 + (thread-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: + (thread-first + 5 + (+ 20) + (/ 25) + - + (+ 40)) +Is equivalent to: + (+ (- (/ (+ 5 20) 25)) 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: + (thread-last + 5 + (+ 20) + (/ 25) + - + (+ 40)) +Is equivalent to: + (+ 40 (- (/ 25 (+ 20 5)))) +Note how the single `-' got converted into a list before +threading." + (line-up-iter nil (car forms) (cdr forms))) diff --git a/alexandria-2/package.lisp b/alexandria-2/package.lisp index 21ceaf688faed249c6e4ef7bcf597d2ea10f06ae..5da434e26b4f6fa2d3561171391154fc7bbb08d2 100644 --- a/alexandria-2/package.lisp +++ b/alexandria-2/package.lisp @@ -3,7 +3,9 @@ (:use :cl :alexandria.1.0.0) #+sb-package-locks (:lock t) - (:export - #:delete-from-plist* + (:export + #:delete-from-plist* + #:line-up-first + #:line-up-last . #. (let (res) (do-external-symbols (sym :alexandria.1.0.0) (push sym res)) res) )) diff --git a/alexandria-2/tests.lisp b/alexandria-2/tests.lisp index 55a3b86a1fc43bcfbfdbe48bc2837a14ef0c0697..4848382a95b89572f379ce79b7ce3a21e12d8c55 100644 --- a/alexandria-2/tests.lisp +++ b/alexandria-2/tests.lisp @@ -19,3 +19,108 @@ ((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)