branch: externals/dash
commit ab99be66369d4c9a0138f3226fc13f580dd6ff0c
Author: Matus Goljer <[email protected]>
Commit: Matus Goljer <[email protected]>
Add -fix
---
README.md | 12 ++++++++++++
dash.el | 16 ++++++++++++++++
dev/examples.el | 8 +++++++-
3 files changed, 35 insertions(+), 1 deletions(-)
diff --git a/README.md b/README.md
index d30cd76..2b44acf 100644
--- a/README.md
+++ b/README.md
@@ -186,6 +186,7 @@ Other list functions not fit to be classified elsewhere.
* [-butlast](#-butlast-list) `(list)`
* [-sort](#-sort-comparator-list) `(comparator list)`
* [-list](#-list-rest-args) `(&rest args)`
+* [-fix](#-fix-fn-list) `(fn list)`
### Tree operations
@@ -1467,6 +1468,17 @@ not, return a list with `args` as elements.
(-list 1 2 3) ;; => '(1 2 3)
```
+#### -fix `(fn list)`
+
+Compute the (least) fixpoint of `fn` with initial input `list`.
+
+`fn` is called at least once, results are compared with `equal`.
+
+```cl
+(-fix (lambda (l) (-non-nil (--mapcat (-split-at (/ (length it) 2) it) l)))
'((1 2 3 4 5 6))) ;; => '((1) (2) (3) (4) (5) (6))
+(let ((data '(("starwars" "scifi") ("jedi" "starwars" "warrior")))) (--fix
(-uniq (--mapcat (cons it (cdr (assoc it data))) it)) '("jedi" "book"))) ;; =>
'("jedi" "starwars" "warrior" "scifi" "book")
+```
+
## Tree operations
diff --git a/dash.el b/dash.el
index 76a8e75..c90d3bf 100644
--- a/dash.el
+++ b/dash.el
@@ -1371,6 +1371,20 @@ N is the length of the returned list."
(declare (debug (form form form)))
`(-iterate (lambda (it) ,form) ,init ,n))
+(defun -fix (fn list)
+ "Compute the (least) fixpoint of FN with initial input LIST.
+
+FN is called at least once, results are compared with `equal'."
+ (let ((re (funcall fn list)))
+ (while (not (equal list re))
+ (setq list re)
+ (setq re (funcall fn re)))
+ re))
+
+(defmacro --fix (form list)
+ "Anaphoric form of `-fix'."
+ `(-fix (lambda (it) ,form) ,list))
+
(defun -unfold (fun seed)
"Build a list from SEED using FUN.
@@ -1734,6 +1748,8 @@ structure such as plist or alist."
"--min-by"
"-iterate"
"--iterate"
+ "-fix"
+ "--fix"
"-unfold"
"--unfold"
"-cons-pair?"
diff --git a/dev/examples.el b/dev/examples.el
index 5e1197d..04fb8c3 100644
--- a/dev/examples.el
+++ b/dev/examples.el
@@ -572,7 +572,13 @@ new list."
(-list 1) => '(1)
(-list 1 2 3) => '(1 2 3)
(-list '(1 2 3) => '(1 2 3))
- (-list '((1) (2)) => '((1) (2)))))
+ (-list '((1) (2)) => '((1) (2))))
+
+ (defexamples -fix
+ (-fix (lambda (l) (-non-nil (--mapcat (-split-at (/ (length it) 2) it)
l))) '((1 2 3 4 5 6))) => '((1) (2) (3) (4) (5) (6))
+ (let ((data '(("starwars" "scifi")
+ ("jedi" "starwars" "warrior"))))
+ (--fix (-uniq (--mapcat (cons it (cdr (assoc it data))) it)) '("jedi"
"book"))) => '("jedi" "starwars" "warrior" "scifi" "book")))
(def-example-group "Tree operations"
"Functions pretending lists are trees."
