From 9abae5e6bc3b0f71f2bef38043796333559eaf00 Mon Sep 17 00:00:00 2001 From: Fuco1 Date: Fri, 16 Aug 2013 00:55:16 +0200 Subject: [PATCH] Add combinators --- README.md | 199 +++++++++++++++++++++++++++++++++------------ create-docs.sh | 2 +- dash-functional.el | 114 ++++++++++++++++++++++++++ dash-pkg.el | 5 ++ dash.el | 10 ++- dev/examples.el | 78 ++++++++++++++---- run-tests.sh | 2 +- 7 files changed, 339 insertions(+), 71 deletions(-) create mode 100644 dash-functional.el create mode 100644 dash-pkg.el diff --git a/README.md b/README.md index 33b53e8..4387f8e 100644 --- a/README.md +++ b/README.md @@ -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)` diff --git a/create-docs.sh b/create-docs.sh index 9607d10..0931a01 100755 --- a/create-docs.sh +++ b/create-docs.sh @@ -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 diff --git a/dash-functional.el b/dash-functional.el new file mode 100644 index 0000000..86357cb --- /dev/null +++ b/dash-functional.el @@ -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 +;; 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 . + +;;; 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 diff --git a/dash-pkg.el b/dash-pkg.el new file mode 100644 index 0000000..71dd0a7 --- /dev/null +++ b/dash-pkg.el @@ -0,0 +1,5 @@ +(define-package + "dash" + "1.8.0" + "A modern list library for Emacs." + '()) diff --git a/dash.el b/dash.el index bb2a97c..5d07a33 100644 --- a/dash.el +++ b/dash.el @@ -3,7 +3,6 @@ ;; Copyright (C) 2012 Magnar Sveen ;; Author: Magnar Sveen -;; 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" "->" "->>" "-->" diff --git a/dev/examples.el b/dev/examples.el index 907ba6d..d71de97 100644 --- a/dev/examples.el +++ b/dev/examples.el @@ -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)) diff --git a/run-tests.sh b/run-tests.sh index 739747d..9895e20 100755 --- a/run-tests.sh +++ b/run-tests.sh @@ -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