Introduce line-up-first and line-up-last macros

This patch introduces the line-up-first and line-up-last macros in
control-flow.  The macros have been popularized by Clojure and afterwards
adopted in Emacs Lisp (see thread-first and thread-last in subr-x.el).

This implementation is a port of the latter, where we use a common
line-up-iter(ative) tail recursive function for computing the results.  The
choice of the full name was made in the spirit of the library, conservatively
avoiding new syntax like -> or ->>.
parent c33f7ac8
(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)))
......@@ -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)
))
......@@ -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)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment