Merge pull request #42 from Fuco1/functional

Add combinators
master
Magnar Sveen 13 years ago
commit 51c9f6b8dc
  1. 199
      README.md
  2. 2
      create-docs.sh
  3. 114
      dash-functional.el
  4. 5
      dash-pkg.el
  5. 10
      dash.el
  6. 78
      dev/examples.el
  7. 2
      run-tests.sh

@ -72,10 +72,6 @@ Or you can just dump `dash.el` in your load path somewhere.
* [-distinct](#-distinct-list) `(list)`
* [-contains?](#-contains-list-element) `(list element)`
* [-sort](#-sort-predicate-list) `(predicate list)`
* [-partial](#-partial-fn-rest-args) `(fn &rest args)`
* [-rpartial](#-rpartial-fn-rest-args) `(fn &rest args)`
* [-juxt](#-juxt-rest-fns) `(&rest fns)`
* [-applify](#-applify-fn) `(fn)`
* [->](#--x-optional-form-rest-more) `(x &optional form &rest more)`
* [->>](#--x-form-rest-more) `(x form &rest more)`
* [-->](#---x-form-rest-more) `(x form &rest more)`
@ -83,6 +79,17 @@ Or you can just dump `dash.el` in your load path somewhere.
* [-when-let*](#-when-let-vars-vals-rest-body) `(vars-vals &rest body)`
* [-if-let](#-if-let-var-val-then-optional-else) `(var-val then &optional else)`
* [-if-let*](#-if-let-vars-vals-then-optional-else) `(vars-vals then &optional else)`
* [-partial](#-partial-fn-rest-args) `(fn &rest args)`
* [-rpartial](#-rpartial-fn-rest-args) `(fn &rest args)`
* [-juxt](#-juxt-rest-fns) `(&rest fns)`
* [-applify](#-applify-fn) `(fn)`
* [-on](#-on-operator-transformer) `(operator transformer)`
* [-flip](#-flip-func) `(func)`
* [-const](#-const-c) `(c)`
* [-cut](#-cut-rest-params) `(&rest params)`
* [-not](#-not-pred) `(pred)`
* [-orfn](#-orfn-rest-preds) `(&rest preds)`
* [-andfn](#-andfn-rest-preds) `(&rest preds)`
* [!cons](#-cons-car-cdr) `(car cdr)`
* [!cdr](#-cdr-list) `(list)`
@ -787,6 +794,88 @@ if the first element should sort before the second.
(--sort (< it other) '(3 1 2)) ;; => '(1 2 3)
```
### -> `(x &optional form &rest more)`
Threads the expr through the forms. Inserts `x` as the second
item in the first form, making a list of it if it is not a list
already. If there are more forms, inserts the first form as the
second item in second form, etc.
```cl
(-> "Abc") ;; => "Abc"
(-> "Abc" (concat "def")) ;; => "Abcdef"
(-> "Abc" (concat "def") (concat "ghi")) ;; => "Abcdefghi"
```
### ->> `(x form &rest more)`
Threads the expr through the forms. Inserts `x` as the last item
in the first form, making a list of it if it is not a list
already. If there are more forms, inserts the first form as the
last item in second form, etc.
```cl
(->> "Abc" (concat "def")) ;; => "defAbc"
(->> "Abc" (concat "def") (concat "ghi")) ;; => "ghidefAbc"
(->> 5 (- 8)) ;; => 3
```
### --> `(x form &rest more)`
Threads the expr through the forms. Inserts `x` at the position
signified by the token `it` in the first form. If there are more
forms, inserts the first form at the position signified by `it`
in in second form, etc.
```cl
(--> "def" (concat "abc" it "ghi")) ;; => "abcdefghi"
(--> "def" (concat "abc" it "ghi") (upcase it)) ;; => "ABCDEFGHI"
(--> "def" (concat "abc" it "ghi") upcase) ;; => "ABCDEFGHI"
```
### -when-let `(var-val &rest body)`
If `val` evaluates to non-nil, bind it to `var` and execute body.
`var-val` should be a (`var` `val`) pair.
```cl
(-when-let (match-index (string-match "d" "abcd")) (+ match-index 2)) ;; => 5
(--when-let (member :b '(:a :b :c)) (cons :d it)) ;; => '(:d :b :c)
(--when-let (even? 3) (cat it :a)) ;; => nil
```
### -when-let* `(vars-vals &rest body)`
If all `vals` evaluate to true, bind them to their corresponding
`vars` and execute body. `vars-vals` should be a list of (`var` `val`)
pairs (corresponding to bindings of `let*`).
```cl
(-when-let* ((x 5) (y 3) (z (+ y 4))) (+ x y z)) ;; => 15
(-when-let* ((x 5) (y nil) (z 7)) (+ x y z)) ;; => nil
```
### -if-let `(var-val then &optional else)`
If `val` evaluates to non-nil, bind it to `var` and do `then`,
otherwise do `else`. `var-val` should be a (`var` `val`) pair.
```cl
(-if-let (match-index (string-match "d" "abc")) (+ match-index 3) 7) ;; => 7
(--if-let (even? 4) it nil) ;; => t
```
### -if-let* `(vars-vals then &optional else)`
If all `vals` evaluate to true, bind them to their corresponding
`vars` and do `then`, otherwise do `else`. `vars-vals` should be a list
of (`var` `val`) pairs (corresponding to the bindings of `let*`).
```cl
(-if-let* ((x 5) (y 3) (z 7)) (+ x y z) "foo") ;; => 15
(-if-let* ((x 5) (y nil) (z 7)) (+ x y z) "foo") ;; => "foo"
```
### -partial `(fn &rest args)`
Takes a function `fn` and fewer than the normal arguments to `fn`,
@ -835,88 +924,96 @@ expects a list with n items as arguments
```cl
(-map (-applify '+) '((1 1 1) (1 2 3) (5 5 5))) ;; => '(3 6 15)
(-map (-applify (lambda (a b c) (\` ((\, a) ((\, b) ((\, c))))))) '((1 1 1) (1 2 3) (5 5 5))) ;; => '((1 (1 (1))) (1 (2 (3))) (5 (5 (5))))
(funcall (-applify '<) '(3 6)) ;; => t
```
### -> `(x &optional form &rest more)`
### -on `(operator transformer)`
Threads the expr through the forms. Inserts `x` as the second
item in the first form, making a list of it if it is not a list
already. If there are more forms, inserts the first form as the
second item in second form, etc.
Return a function of two arguments that first applies
`transformer` to each of them and then applies `operator` on the
results (in the same order).
In types: (b -> b -> c) -> (a -> b) -> a -> a -> c
```cl
(-> "Abc") ;; => "Abc"
(-> "Abc" (concat "def")) ;; => "Abcdef"
(-> "Abc" (concat "def") (concat "ghi")) ;; => "Abcdefghi"
(-sort (-on '< 'length) '((1 2 3) (1) (1 2))) ;; => '((1) (1 2) (1 2 3))
(-sort (-on 'string-lessp 'int-to-string) '(10 12 1 2 22)) ;; => '(1 10 12 2 22)
(funcall (-on '+ '1+) 1 2) ;; => 5
```
### ->> `(x form &rest more)`
### -flip `(func)`
Threads the expr through the forms. Inserts `x` as the last item
in the first form, making a list of it if it is not a list
already. If there are more forms, inserts the first form as the
last item in second form, etc.
Swap the order of arguments for binary function `func`.
In types: (a -> b -> c) -> b -> a -> c
```cl
(->> "Abc" (concat "def")) ;; => "defAbc"
(->> "Abc" (concat "def") (concat "ghi")) ;; => "ghidefAbc"
(->> 5 (- 8)) ;; => 3
(funcall (-flip '<) 2 1) ;; => t
(funcall (-flip '-) 3 8) ;; => 5
(-sort (-flip '<) '(4 3 6 1)) ;; => '(6 4 3 1)
```
### --> `(x form &rest more)`
### -const `(c)`
Threads the expr through the forms. Inserts `x` at the position
signified by the token `it` in the first form. If there are more
forms, inserts the first form at the position signified by `it`
in in second form, etc.
Return a function that returns `c` ignoring any additional arguments.
In types: a -> b -> a
```cl
(--> "def" (concat "abc" it "ghi")) ;; => "abcdefghi"
(--> "def" (concat "abc" it "ghi") (upcase it)) ;; => "ABCDEFGHI"
(--> "def" (concat "abc" it "ghi") upcase) ;; => "ABCDEFGHI"
(funcall (-const 2) 1 3 "foo") ;; => 2
(-map (-const 1) '("a" "b" "c" "d")) ;; => '(1 1 1 1)
(-sum (-map (-const 1) '("a" "b" "c" "d"))) ;; => 4
```
### -when-let `(var-val &rest body)`
### -cut `(&rest params)`
If `val` evaluates to non-nil, bind it to `var` and execute body.
`var-val` should be a (`var` `val`) pair.
Take n-ary function and n arguments and specialize some of them.
Arguments denoted by <> will be left unspecialized.
See `srfi-26` for detailed description.
```cl
(-when-let (match-index (string-match "d" "abcd")) (+ match-index 2)) ;; => 5
(--when-let (member :b '(:a :b :c)) (cons :d it)) ;; => '(:d :b :c)
(--when-let (even? 3) (cat it :a)) ;; => nil
(funcall (-cut list 1 <> 3 <> 5) 2 4) ;; => '(1 2 3 4 5)
(-map (-cut funcall <> 5) '(1+ 1- (lambda (x) (/ 1.0 x)))) ;; => '(6 4 0.2)
(-filter (-cut < <> 5) '(1 3 5 7 9)) ;; => '(1 3)
```
### -when-let* `(vars-vals &rest body)`
### -not `(pred)`
If all `vals` evaluate to true, bind them to their corresponding
`vars` and execute body. `vars-vals` should be a list of (`var` `val`)
pairs (corresponding to bindings of `let*`).
Take an unary predicates `pred` and return an unary predicate
that returns t if `pred` returns nil and nil if `pred` returns
non-nil.
```cl
(-when-let* ((x 5) (y 3) (z (+ y 4))) (+ x y z)) ;; => 15
(-when-let* ((x 5) (y nil) (z 7)) (+ x y z)) ;; => nil
(funcall (-not 'even?) 5) ;; => t
(-filter (-not (-partial '< 4)) '(1 2 3 4 5 6 7 8)) ;; => '(1 2 3 4)
```
### -if-let `(var-val then &optional else)`
### -orfn `(&rest preds)`
If `val` evaluates to non-nil, bind it to `var` and do `then`,
otherwise do `else`. `var-val` should be a (`var` `val`) pair.
Take list of unary predicates `preds` and return an unary
predicate with argument x that returns non-nil if at least one of
the `preds` returns non-nil on x.
In types: [a -> Bool] -> a -> Bool
```cl
(-if-let (match-index (string-match "d" "abc")) (+ match-index 3) 7) ;; => 7
(--if-let (even? 4) it nil) ;; => t
(-filter (-orfn 'even? (-partial (-flip '<) 5)) '(1 2 3 4 5 6 7 8 9 10)) ;; => '(1 2 3 4 6 8 10)
(funcall (-orfn 'stringp 'even?) "foo") ;; => t
```
### -if-let* `(vars-vals then &optional else)`
### -andfn `(&rest preds)`
If all `vals` evaluate to true, bind them to their corresponding
`vars` and do `then`, otherwise do `else`. `vars-vals` should be a list
of (`var` `val`) pairs (corresponding to the bindings of `let*`).
Take list of unary predicates `preds` and return an unary
predicate with argument x that returns non-nil if all of the
`preds` returns non-nil on x.
In types: [a -> Bool] -> a -> Bool
```cl
(-if-let* ((x 5) (y 3) (z 7)) (+ x y z) "foo") ;; => 15
(-if-let* ((x 5) (y nil) (z 7)) (+ x y z) "foo") ;; => "foo"
(funcall (-andfn (-cut < <> 10) 'even?) 6) ;; => t
(funcall (-andfn (-cut < <> 10) 'even?) 12) ;; => nil
(-filter (-andfn (-not 'even?) (-cut >= 5 <>)) '(1 2 3 4 5 6 7 8 9 10)) ;; => '(1 3 5)
```
### !cons `(car cdr)`

@ -4,4 +4,4 @@ if [ -z "$EMACS" ] ; then
EMACS="emacs"
fi
$EMACS -batch -l dash.el -l dev/examples-to-docs.el -l dev/examples.el -f create-docs-file
$EMACS -batch -l dash-functional.el -l dash.el -l dev/examples-to-docs.el -l dev/examples.el -f create-docs-file

@ -0,0 +1,114 @@
;;; dash-functional.el --- Collection of useful combinators for Emacs Lisp -*- lexical-binding: t -*-
;; Copyright (C) 2013 Magnar Sveen
;; Author: Magnar Sveen <magnars@gmail.com>
;; Keywords: lisp functions combinators
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Collection of useful combinators for Emacs Lisp
;;
;; See documentation on https://github.com/magnars/dash.el#functions
;;; Code:
(defun -partial (fn &rest args)
"Takes a function FN and fewer than the normal arguments to FN,
and returns a fn that takes a variable number of additional ARGS.
When called, the returned function calls FN with ARGS first and
then additional args."
(apply 'apply-partially fn args))
(defun -rpartial (fn &rest args)
"Takes a function FN and fewer than the normal arguments to FN,
and returns a fn that takes a variable number of additional ARGS.
When called, the returned function calls FN with the additional
args first and then ARGS.
Requires Emacs 24 or higher."
(lambda (&rest args-before) (apply fn (append args-before args))))
(defun -juxt (&rest fns)
"Takes a list of functions and returns a fn that is the
juxtaposition of those fns. The returned fn takes a variable
number of args, and returns a list containing the result of
applying each fn to the args (left-to-right).
Requires Emacs 24 or higher."
(lambda (&rest args) (mapcar (lambda (x) (apply x args)) fns)))
(defun -applify (fn)
"Changes an n-arity function FN to a 1-arity function that
expects a list with n items as arguments"
(apply-partially 'apply fn))
(defun -on (operator transformer)
"Return a function of two arguments that first applies
TRANSFORMER to each of them and then applies OPERATOR on the
results (in the same order).
In types: (b -> b -> c) -> (a -> b) -> a -> a -> c"
(lambda (x y) (funcall operator (funcall transformer x) (funcall transformer y))))
(defun -flip (func)
"Swap the order of arguments for binary function FUNC.
In types: (a -> b -> c) -> b -> a -> c"
(lambda (x y) (funcall func y x)))
(defun -const (c)
"Return a function that returns C ignoring any additional arguments.
In types: a -> b -> a"
(lambda (&rest args) c))
(defmacro -cut (&rest params)
"Take n-ary function and n arguments and specialize some of them.
Arguments denoted by <> will be left unspecialized.
See SRFI-26 for detailed description."
(let* ((i 0)
(args (mapcar (lambda (x) (setq i (1+ i)) (make-symbol (format "D%d" i)))
(-filter (-partial 'eq '<>) params))))
`(lambda ,args
,(--map (if (eq it '<>) (pop args) it) params))))
(defun -not (pred)
"Take an unary predicates PRED and return an unary predicate
that returns t if PRED returns nil and nil if PRED returns
non-nil."
(lambda (x) (not (funcall pred x))))
(defun -orfn (&rest preds)
"Take list of unary predicates PREDS and return an unary
predicate with argument x that returns non-nil if at least one of
the PREDS returns non-nil on x.
In types: [a -> Bool] -> a -> Bool"
(lambda (x) (-any? (-cut funcall <> x) preds)))
(defun -andfn (&rest preds)
"Take list of unary predicates PREDS and return an unary
predicate with argument x that returns non-nil if all of the
PREDS returns non-nil on x.
In types: [a -> Bool] -> a -> Bool"
(lambda (x) (-all? (-cut funcall <> x) preds)))
(provide 'dash-functional)
;;; dash-functional.el ends here

@ -0,0 +1,5 @@
(define-package
"dash"
"1.8.0"
"A modern list library for Emacs."
'())

@ -3,7 +3,6 @@
;; Copyright (C) 2012 Magnar Sveen
;; Author: Magnar Sveen <magnars@gmail.com>
;; Version: 1.8.0
;; Keywords: lists
;; This program is free software; you can redistribute it and/or modify
@ -949,6 +948,8 @@ Returns nil if N is less than 1."
(declare (debug t))
`(-max-by (lambda (it) ,form) ,list))
(require 'dash-functional)
(eval-after-load "lisp-mode"
'(progn
(let ((new-keywords '(
@ -1037,6 +1038,13 @@ Returns nil if N is less than 1."
"-partial"
"-rpartial"
"-juxt"
"-applify"
"-on"
"-flip"
"-const"
"-cut"
"-orfn"
"-andfn"
"->"
"->>"
"-->"

@ -325,23 +325,6 @@
(--sort (< it other) '(3 1 2)) => '(1 2 3)
(let ((l '(3 1 2))) (-sort '> l) l) => '(3 1 2))
(defexamples -partial
(funcall (-partial '- 5) 3) => 2
(funcall (-partial '+ 5 2) 3) => 10)
(unless (version< emacs-version "24")
(defexamples -rpartial
(funcall (-rpartial '- 5) 8) => 3
(funcall (-rpartial '- 5 2) 10) => 3)
(defexamples -juxt
(funcall (-juxt '+ '-) 3 5) => '(8 -2)
(-map (-juxt 'identity 'square) '(1 2 3)) => '((1 1) (2 4) (3 9))))
(defexamples -applify
(-map (-applify '+) '((1 1 1) (1 2 3) (5 5 5))) => '(3 6 15)
(-map (-applify (lambda (a b c) `(,a (,b (,c))))) '((1 1 1) (1 2 3) (5 5 5))) => '((1 (1 (1))) (1 (2 (3))) (5 (5 (5)))))
(defexamples ->
(-> "Abc") => "Abc"
(-> "Abc" (concat "def")) => "Abcdef"
@ -377,6 +360,67 @@
(-if-let* ((x 5) (y 3) (z 7)) (+ x y z) "foo") => 15
(-if-let* ((x 5) (y nil) (z 7)) (+ x y z) "foo") => "foo")
(defexamples -partial
(funcall (-partial '- 5) 3) => 2
(funcall (-partial '+ 5 2) 3) => 10)
(unless (version< emacs-version "24")
(defexamples -rpartial
(funcall (-rpartial '- 5) 8) => 3
(funcall (-rpartial '- 5 2) 10) => 3)
(defexamples -juxt
(funcall (-juxt '+ '-) 3 5) => '(8 -2)
(-map (-juxt 'identity 'square) '(1 2 3)) => '((1 1) (2 4) (3 9))))
(defexamples -applify
(-map (-applify '+) '((1 1 1) (1 2 3) (5 5 5))) => '(3 6 15)
(-map (-applify (lambda (a b c) `(,a (,b (,c))))) '((1 1 1) (1 2 3) (5 5 5))) => '((1 (1 (1))) (1 (2 (3))) (5 (5 (5))))
(funcall (-applify '<) '(3 6)) => t)
(unless (version< emacs-version "24")
(defexamples -on
(-sort (-on '< 'length) '((1 2 3) (1) (1 2))) => '((1) (1 2) (1 2 3))
(-sort (-on 'string-lessp 'int-to-string) '(10 12 1 2 22)) => '(1 10 12 2 22)
(funcall (-on '+ '1+) 1 2) => 5
(funcall (-on '+ 'identity) 1 2) => 3
(funcall (-on '* 'length) '(1 2 3) '(4 5)) => 6
(funcall (-on (-on '+ 'length) 'cdr) '(1 2 3) '(4 5)) => 3
(funcall (-on '+ (lambda (x) (length (cdr x)))) '(1 2 3) '(4 5)) => 3
(-sort (-on '< 'car) '((3 2 5) (2) (1 2))) => '((1 2) (2) (3 2 5))
(-sort (-on '< (lambda (x) (length x))) '((1 2 3) (1) (1 2))) => '((1) (1 2) (1 2 3))
(-sort (-on (-on '< 'car) 'cdr) '((0 3) (2 1) (4 2 8))) => '((2 1) (4 2 8) (0 3))
(-sort (-on '< 'cadr) '((0 3) (2 1) (4 2 8))) => '((2 1) (4 2 8) (0 3)))
(defexamples -flip
(funcall (-flip '<) 2 1) => t
(funcall (-flip '-) 3 8) => 5
(-sort (-flip '<) '(4 3 6 1)) => '(6 4 3 1))
(defexamples -const
(funcall (-const 2) 1 3 "foo") => 2
(-map (-const 1) '("a" "b" "c" "d")) => '(1 1 1 1)
(-sum (-map (-const 1) '("a" "b" "c" "d"))) => 4)
(defexamples -cut
(funcall (-cut list 1 <> 3 <> 5) 2 4) => '(1 2 3 4 5)
(-map (-cut funcall <> 5) '(1+ 1- (lambda (x) (/ 1.0 x)))) => '(6 4 0.2)
(-filter (-cut < <> 5) '(1 3 5 7 9)) => '(1 3))
(defexamples -not
(funcall (-not 'even?) 5) => t
(-filter (-not (-partial '< 4)) '(1 2 3 4 5 6 7 8)) => '(1 2 3 4))
(defexamples -orfn
(-filter (-orfn 'even? (-partial (-flip '<) 5)) '(1 2 3 4 5 6 7 8 9 10)) => '(1 2 3 4 6 8 10)
(funcall (-orfn 'stringp 'even?) "foo") => t)
(defexamples -andfn
(funcall (-andfn (-cut < <> 10) 'even?) 6) => t
(funcall (-andfn (-cut < <> 10) 'even?) 12) => nil
(-filter (-andfn (-not 'even?) (-cut >= 5 <>)) '(1 2 3 4 5 6 7 8 9 10)) => '(1 3 5))
)
(defexamples !cons
(let (l) (!cons 5 l) l) => '(5)
(let ((l '(3))) (!cons 5 l) l) => '(5 3))

@ -4,4 +4,4 @@ if [ -z "$EMACS" ] ; then
EMACS="emacs"
fi
$EMACS -batch -l dev/ert.el -l dash.el -l dev/examples-to-tests.el -l dev/examples.el -f ert-run-tests-batch-and-exit
$EMACS -batch -l dev/ert.el -l dash-functional.el -l dash.el -l dev/examples-to-tests.el -l dev/examples.el -f ert-run-tests-batch-and-exit

Loading…
Cancel
Save