├── .gitignore
├── LICENSE.html
├── README.md
├── arrows.asd
├── arrows.lisp
└── test.lisp
/.gitignore:
--------------------------------------------------------------------------------
1 | *~
2 | *.fasl
3 |
--------------------------------------------------------------------------------
/LICENSE.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
6 |
8 | 
11 |
12 | To the extent possible under law, Svante von Erichsen has waived all
13 | copyright and related or neighboring rights to
14 | arrows.
15 | This work is published from:
16 |
20 | Deutschland.
21 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # Arrows
2 |
3 | Implements threading macros, inspired by Clojure (both core and
4 | the [swiss-arrows](https://github.com/rplevy/swiss-arrows) library).
5 |
6 | This is an ASDF system providing the package `arrows`. Its home is at
7 | https://gitlab.com/Harleqin/arrows, with a mirror at
8 | https://github.com/Harleqin/arrows.
9 |
10 | ## Overview
11 |
12 | You get:
13 |
14 | - the basic “thrushing” arrows `->` and `->>`,
15 | - “diamond” arrows `-<>` and `-<>>`,
16 | - binding arrow `as->`,
17 | - “maybe” arrows `some->` and `some->>`,
18 | - conditional arrows `cond->` and `cond->>`, and
19 | - “double arrow cancellers” `->*` and `as->*`.
20 |
21 | As far as I see, `->*` and `as->*` are new. Their purpose is to be nested in
22 | other threading forms to temporarily supplant their behaviour (see “Nesting”
23 | below).
24 |
25 | ## Other arrow libraries
26 |
27 | - [`arrow-macros`](https://github.com/hipeta/arrow-macros)
28 | - [`cl-arrows`](https://github.com/nightfly19/cl-arrows) is superseded by `arrows`.
29 |
30 | ## Notable differences to Clojure and swiss-arrows
31 |
32 | - `Cond->` and `cond->>` use one additional paren nesting for the clauses, so
33 | that each clause can contain multiple forms to thread/execute.
34 |
35 | - `-<>` and `-<>>` do not support literals to insert the `<>` placeholder. The
36 | placeholder really only works at the outermost level of the threaded forms.
37 | The reason for this is mostly that Common Lisp does not have so many literal
38 | syntax elements (by default) where it would make sense to do this kind of
39 | insertion. If you do need anything fancy, use `as->` or `as->*` for a real
40 | lexical binding.
41 |
42 | ## Notable differences to arrow-macros
43 |
44 | - `Cond->` and `cond->>` use one additional paren nesting for the clauses, so
45 | that each clause can contain multiple forms to thread/execute.
46 |
47 | - `-<>` and `-<>>` do not use a code walker to find out whether a placeholder is
48 | present in the next threaded form. The placeholder only works at the
49 | outermost level of the threaded forms. This reduces the dependencies of
50 | `arrows` (there are none at present). Instead, the recommendation is to use
51 | binding arrows `as->` or `as->*`, possibly nested (see below).
52 |
53 | - There is no `some-<>` nor `some-<>>` yet. Instead, you can use nested `as->`
54 | or `as->*` forms (see below).
55 |
56 | ## Nesting
57 |
58 | One useful idiom is to nest these arrows. The basic example is to use `->>`
59 | inside `->`:
60 |
61 | (-> deeply-nested-plist
62 | (getf :foo)
63 | (getf :bar)
64 | (->> (mapcar #'reverse)))
65 |
66 | This inspired the discovery of `->*`, which enables the inverse nesting:
67 |
68 | (->> deeply-nested-alist
69 | (assoc :foo)
70 | cdr
71 | (assoc :bar)
72 | cdr
73 | (->* (mod 3))
74 | (expt 2))
75 |
76 | Generally useful for overriding defaults are `as->` and `as->*`:
77 |
78 | (-> 3
79 | (as-> $
80 | (< x $ y))
81 | not)
82 |
83 | (some->> 15
84 | (as->* $
85 | (progn
86 | (format t debug-formatter $)
87 | $))
88 | (/ 75))
89 |
90 | However, don't overdo it! This quickly leads to an unreadable mess. You may
91 | well be better off with a few explicit `let` bindings.
92 |
93 | ## Documentation
94 |
95 | #### `->` initial-form _&rest_ forms => results
96 | _[macro]_ Inserts INITIAL-FORM as first argument into the first of FORMS, the
97 | result into the next, etc., before evaluation. FORMS are treated as list
98 | designators.
99 |
100 | #### `->>` initial-form _&rest_ forms => results
101 | _[macro]_ Like `->`, but the forms are inserted as last argument instead of
102 | first.
103 |
104 | #### `->*` _&rest_ forms => results
105 | _[macro]_ Like `->`, but the last form is used as initial form, then the
106 | remainung forms as in `->`. This is intended for inversing the default in a
107 | `->>` form.
108 |
109 | #### `-<>` initial-form _&rest_ forms => results
110 | _[macro]_ Like `->`, but if a form in FORMS has one or more symbols named `<>`
111 | as top-level element, each such symbol is substituted by the primary result of
112 | the form accumulated so far, instead of it being inserted as first argument.
113 | Also known as diamond wand.
114 |
115 | #### `-<>>` initial-form _&rest_ forms => results
116 | _[macro]_ Like `-<>`, but if a form in FORMS has no symbols named `<>` as
117 | top-level element, insertion is done like in `->>`. Also known as diamond
118 | spear.
119 |
120 | #### `as->` initial-form var _&rest_ forms => results
121 | _[macro]_ Binds INITIAL-FORM to VAR, then successively each of FORMS to VAR,
122 | finally returns the last value of VAR.
123 |
124 | #### `as->*` var _&rest_ forms => results
125 | _[macro]_ Shorthand for the combination of `->*` and `as->`: the last form is
126 | used for initial binding, then the remaining forms used as in `as->`. This is
127 | intended for overriding the default in a `->>` form.
128 |
129 | #### `some->` initial-form _&rest_ forms => results
130 | _[macro]_ Like `->`, but short-circuits to nil as soon as either INITIAL-FORM or
131 | any of FORMS return nil. This is like all these forms are lifted to the maybe
132 | monad.
133 |
134 | #### `some->>` initial-form _&rest_ forms => results
135 | _[macro]_ Like `some->`, but with insertion behaviour as in `->>`.
136 |
137 | #### `cond->` initial-form _&rest_ clauses => results
138 | _[macro]_ CLAUSES is a list of clauses similar to COND clauses, each clause
139 | comprising first a test form, then a body of further forms. `Cond->` evaluates
140 | INITIAL-FORM to a value, then for each clause whose test evaluates to true,
141 | pipes (as in `->`) the value through each form in the body of the clause. Note
142 | that unlike in COND, there is no short-circuiting: each clause gets tested
143 | regardless of the outcome of the clauses before.
144 |
145 | #### `cond->>` initial-form _&rest_ clauses => results
146 | _[macro]_ Like `cond->`, but with insertion behaviour as in `->>`.
147 |
148 | ## Examples
149 |
150 | (-> 3
151 | /) ; insert into designated list (/)
152 | => 1/3
153 |
154 | (-> 3
155 | (expt 2)) ; insert as first argument
156 | => 9
157 |
158 | (->> 3
159 | (expt 2)) ; insert as last argument
160 | => 8
161 |
162 | (-<>> (list 1 2 3)
163 | (remove-if #'oddp <> :count 1 :from-end t) ; substitute <>
164 | (reduce #'+) ; insert last
165 | /) ; list designator
166 | => 1/3
167 |
168 | (let ((x 3))
169 | (-<> (incf x) ; (let ((r (incf x)))
170 | (+ <> <>))) ; (+ r r))
171 | => 8
172 |
173 | (->> 3
174 | (/ 12) ; (/ 12 3) => 4
175 | (->* (/ 2))) ; (/ 4 2) => 2
176 | => 2
177 |
178 | (flet ((say (n)
179 | (cond->> nil
180 | ((zerop (mod n 3)) (cons "Fizz"))
181 | ((zerop (mod n 5)) (cons "Buzz"))
182 | (t (->* (or (list (princ-to-string n))))
183 | reverse
184 | (apply #'concatenate 'string)))))
185 | (mapcar #'say '(9 10 11 12 13 14 15)))
186 | => ("Fizz" "Buzz" "11" "Fizz" "13" "14" "FizzBuzz")
187 |
--------------------------------------------------------------------------------
/arrows.asd:
--------------------------------------------------------------------------------
1 | (defsystem #:arrows
2 | :name "arrows"
3 | :version "0.2.0"
4 | :author "Svante von Erichsen "
5 | :license "CC0"
6 | :description
7 | "Implements -> and ->> from Clojure, as well as several expansions on the
8 | idea."
9 | :components ((:file "arrows"))
10 | :in-order-to ((asdf:test-op (asdf:test-op #:arrows/test))))
11 |
12 | (defsystem #:arrows/test
13 | :depends-on (#:arrows #:hu.dwim.stefil)
14 | :components ((:file "test"))
15 | :perform (asdf:test-op (c v) (uiop:symbol-call '#:arrows/test
16 | '#:test-arrows)))
17 |
--------------------------------------------------------------------------------
/arrows.lisp:
--------------------------------------------------------------------------------
1 | (in-package #:cl-user)
2 |
3 | (defpackage #:arrows
4 | (:use #:common-lisp)
5 | (:export #:->
6 | #:->>
7 | #:-<>
8 | #:-<>>
9 | #:as->
10 | #:some->
11 | #:some->>
12 | #:cond->
13 | #:cond->>
14 | #:->*
15 | #:as->*))
16 |
17 | (in-package #:arrows)
18 |
19 | (defun simple-inserter (insert-fun)
20 | (lambda (acc next)
21 | (if (listp next)
22 | (funcall insert-fun acc next)
23 | (list next acc))))
24 |
25 | (defun expand-arrow (initial-form forms insert-fun)
26 | (reduce (simple-inserter insert-fun)
27 | forms
28 | :initial-value initial-form))
29 |
30 | (defmacro -> (initial-form &rest forms)
31 | "Inserts INITIAL-FORM as first argument into the first of FORMS, the result
32 | into the next, etc., before evaluation. FORMS are treated as list designators."
33 | (expand-arrow initial-form forms #'insert-first))
34 |
35 | (defmacro ->> (initial-form &rest forms)
36 | "Like ->, but the forms are inserted as last argument instead of first."
37 | (expand-arrow initial-form forms #'insert-last))
38 |
39 | (defun diamond-inserter (insert-fun)
40 | (simple-inserter (lambda (acc next)
41 | (case (count-if #'<>p next)
42 | (0 (funcall insert-fun acc next))
43 | (1 (substitute-if acc #'<>p next))
44 | (t (let ((r (gensym "R")))
45 | `(let ((,r ,acc))
46 | ,(substitute-if r #'<>p next))))))))
47 |
48 | (defmacro -<> (initial-form &rest forms)
49 | "Like ->, but if a form in FORMS has one or more symbols named <> as top-level
50 | element, each such symbol is substituted by the primary result of the form
51 | accumulated so far, instead of it being inserted as first argument. Also known
52 | as diamond wand."
53 | (reduce (diamond-inserter #'insert-first)
54 | forms
55 | :initial-value initial-form))
56 |
57 | (defmacro -<>> (initial-form &rest forms)
58 | "Like -<>, but if a form has no symbol named <>, the insertion is done at the
59 | end like in ->>. Also known as diamond spear."
60 | (reduce (diamond-inserter #'insert-last)
61 | forms
62 | :initial-value initial-form))
63 |
64 | (defun <>p (form)
65 | "Predicate identifying the placeholders for the -<> and -<>> macros."
66 | (and (symbolp form)
67 | (string= form "<>")))
68 |
69 | (defun insert-first (arg surround)
70 | "Inserts ARG into the list form SURROUND as its first argument, after the
71 | operator."
72 | (list* (car surround)
73 | arg
74 | (cdr surround)))
75 |
76 | (defun insert-last (arg surround)
77 | "Inserts ARG into the list form SURROUND as its last argument."
78 | (append surround (list arg)))
79 |
80 | (defmacro as-> (initial-form var &rest forms)
81 | "Binds INITIAL-FORM to VAR, then successively each of FORMS to VAR, finally
82 | returns the last value of VAR."
83 | `(let* ,(mapcar (lambda (form)
84 | (list var form))
85 | (cons initial-form forms))
86 | ,var))
87 |
88 | (defun some-inserter (insert-fun)
89 | (lambda (acc next)
90 | (destructuring-bind (let* bindings var) acc
91 | `(,let* (,@bindings
92 | (,var (when ,var
93 | ,(funcall insert-fun var next))))
94 | ,var))))
95 |
96 | (defun expand-some (initial-form forms insert-fun)
97 | (let ((var (gensym "some")))
98 | (reduce (some-inserter (simple-inserter insert-fun))
99 | forms
100 | :initial-value `(let* ((,var ,initial-form))
101 | ,var))))
102 |
103 | (defmacro some-> (initial-form &rest forms)
104 | "Like ->, but short-circuits to nil as soon as either INITIAL-FORM or any of
105 | FORMS return nil. This is like all these forms are lifted to the maybe monad."
106 | (expand-some initial-form forms #'insert-first))
107 |
108 | (defmacro some->> (initial-form &rest forms)
109 | "Like some->, but with insertion behaviour as in ->>."
110 | (expand-some initial-form forms #'insert-last))
111 |
112 | (defun cond-inserter (insert-fun)
113 | (lambda (acc next)
114 | (destructuring-bind (let* bindings var) acc
115 | (destructuring-bind (test . forms) next
116 | `(,let* (,@bindings
117 | (,var (if ,test
118 | ,(expand-arrow var forms insert-fun)
119 | ,var)))
120 | ,var)))))
121 |
122 | (defun expand-cond (initial-form clauses insert-fun)
123 | (let ((var (gensym "cond")))
124 | (reduce (cond-inserter (simple-inserter insert-fun))
125 | clauses
126 | :initial-value `(let* ((,var ,initial-form))
127 | ,var))))
128 |
129 | (defmacro cond-> (initial-form &rest clauses)
130 | "CLAUSES is a list of clauses similar to COND clauses, each clause comprising
131 | first a test form, then a body of further forms. Cond-> evaluates INITIAL-FORM
132 | to a value, then for each clause whose test evaluates to true, pipes (as in ->)
133 | the value through each form in the body of the clause. Note that unlike in
134 | COND, there is no short-circuiting: each clause gets tested regardless of the
135 | outcome of the clauses before."
136 | (expand-cond initial-form clauses #'insert-first))
137 |
138 | (defmacro cond->> (initial-form &rest clauses)
139 | "Like cond->, but with insertion behaviour as in ->>."
140 | (expand-cond initial-form clauses #'insert-last))
141 |
142 | (defmacro ->* (&rest forms)
143 | "Like ->, but the last form is used as initial form, then the remaining forms
144 | used as in ->. This is intended for inversing the default in a ->> form.
145 |
146 | Example:
147 |
148 | (->> 3
149 | (/ 12)
150 | (->* (/ 2)))
151 | => 2"
152 | `(-> ,@(append (last forms) (butlast forms))))
153 |
154 | (defmacro as->* (var &rest forms)
155 | "Shorthand for the combination of ->* and as->: the last form is used for
156 | initial binding, then the remaining forms used as in as->. This is intended for
157 | overriding the default in a ->> form."
158 | `(as-> ,@(last forms) ,var
159 | ,@(butlast forms)))
160 |
--------------------------------------------------------------------------------
/test.lisp:
--------------------------------------------------------------------------------
1 | (in-package #:cl-user)
2 |
3 | (defpackage #:arrows/test
4 | (:use #:cl #:arrows #:hu.dwim.stefil))
5 |
6 | (in-package #:arrows/test)
7 |
8 | (defsuite* test-arrows)
9 |
10 | (deftest test--> ()
11 | (is (= (-> 3 /) 1/3))
12 | (is (= (-> 3 (/)) 1/3))
13 | (is (= (-> 3 (/ 2)) 3/2))
14 | (is (= (-> 3 (/ 2) /) 2/3)))
15 |
16 | (deftest test-->> ()
17 | (is (= (->> 3 /) 1/3))
18 | (is (= (->> 3 (/)) 1/3))
19 | (is (= (->> 3 (/ 2)) 2/3))
20 | (is (= (->> 3 (/ 2) /) 3/2)))
21 |
22 | (deftest test--<> ()
23 | (is (= (-<> 3 /) 1/3))
24 | (is (= (-<> 3 (/)) 1/3))
25 | (is (= (-<> 3 (/ 2)) 3/2))
26 | (is (= (-<> 3 (/ 2) /) 2/3))
27 | (is (= (let ((x 3))
28 | (-<> (incf x)
29 | (+ <> <>)))
30 | 8)))
31 |
32 | (deftest test--<>> ()
33 | (is (= (-<>> 3 /) 1/3))
34 | (is (= (-<>> 3 (/)) 1/3))
35 | (is (= (-<>> 3 (/ 2)) 2/3))
36 | (is (= (-<>> 3 (/ 2) /) 3/2))
37 | (is (= (-<>> (list 1 2 3)
38 | (remove-if #'oddp <> :count 1 :from-end t)
39 | (reduce #'+)
40 | /)
41 | 1/3)))
42 |
43 | (deftest test-as-> ()
44 | (is (= (as-> 3 $
45 | (* 5 $)
46 | (/ $ 7))
47 | 15/7))
48 | (is (= (as-> 0 n
49 | (1+ n)
50 | (1+ n))
51 | 2)))
52 |
53 | (deftest test-some-> ()
54 | (is (null (some-> 3
55 | (+ 5)
56 | (member '(2 5 9))
57 | first
58 | (* 9))))
59 | (is (= (some-> 3
60 | (+ 5)
61 | (member '(2 5 8 9))
62 | first
63 | (* 9))
64 | 72))
65 | (is (= (some-> 3
66 | (+ 5)
67 | (member '(2 5 8 9))
68 | second
69 | (* 9))
70 | 81))
71 | (is (null (some-> 3
72 | (+ 5)
73 | (member '(2 5 8 9))
74 | third
75 | (* 9))))
76 | (is (null (some-> '(:a 1)
77 | (getf :b)
78 | 1+))))
79 |
80 | (deftest test-some->> ()
81 | (is (= (some->> '((:a . 3) (:b . 5))
82 | (assoc :a)
83 | cdr
84 | 1+)
85 | 4))
86 | (is (null (some->> '((:a . 3) (:b . 5))
87 | (assoc :c)
88 | cdr
89 | 1+))))
90 |
91 | (deftest test-cond-> ()
92 | (is (equal (labels ((strcat (&rest things)
93 | (with-output-to-string (s)
94 | (dolist (thing things)
95 | (when thing (princ thing s)))))
96 | (say (n)
97 | (cond-> nil
98 | ((zerop (mod n 3)) (strcat "Fizz"))
99 | ((zerop (mod n 5)) (strcat "Buzz"))
100 | (t (or (strcat n))))))
101 | (mapcar #'say '(9 10 11 12 13 14 15)))
102 | '("Fizz" "Buzz" "11" "Fizz" "13" "14" "FizzBuzz"))))
103 |
104 | (deftest test-cond->> ()
105 | (is (equal (flet ((say (n)
106 | (cond->> nil
107 | ((zerop (mod n 3)) (cons "Fizz"))
108 | ((zerop (mod n 5)) (cons "Buzz"))
109 | (t (->* (or (list (princ-to-string n))))
110 | reverse
111 | (apply #'concatenate 'string)))))
112 | (mapcar #'say '(9 10 11 12 13 14 15)))
113 | '("Fizz" "Buzz" "11" "Fizz" "13" "14" "FizzBuzz"))))
114 |
--------------------------------------------------------------------------------