diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/dash-functional-20180107.1618/dash-functional.el')
-rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/dash-functional-20180107.1618/dash-functional.el | 219 |
1 files changed, 219 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/dash-functional-20180107.1618/dash-functional.el b/configs/shared/emacs/.emacs.d/elpa/dash-functional-20180107.1618/dash-functional.el new file mode 100644 index 000000000000..502e8c1ff78e --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/dash-functional-20180107.1618/dash-functional.el @@ -0,0 +1,219 @@ +;;; dash-functional.el --- Collection of useful combinators for Emacs Lisp -*- lexical-binding: t -*- + +;; Copyright (C) 2013-2014 Free Software Foundation, Inc. + +;; Authors: Matus Goljer <matus.goljer@gmail.com> +;; Magnar Sveen <magnars@gmail.com> +;; Version: 1.2.0 +;; Package-Version: 20180107.1618 +;; Package-Requires: ((dash "2.0.0") (emacs "24")) +;; 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: + +(require 'dash) + +(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." + (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)." + (lambda (&rest args) (mapcar (lambda (x) (apply x args)) fns))) + +(defun -compose (&rest fns) + "Takes a list of functions and returns a fn that is the +composition of those fns. The returned fn takes a variable +number of arguments, and returns the result of applying +each fn to the result of applying the previous fn to +the arguments (right-to-left)." + (lambda (&rest args) + (car (-reduce-r-from (lambda (fn xs) (list (apply fn xs))) + 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 _) 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 (_) (setq i (1+ i)) (make-symbol (format "D%d" i))) + (-filter (-partial 'eq '<>) params)))) + `(lambda ,args + ,(let ((body (--map (if (eq it '<>) (pop args) it) params))) + (if (eq (car params) '<>) + (cons 'funcall body) + body))))) + +(defun -not (pred) + "Take a unary predicate PRED and return a 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 a 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 a 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))) + +(defun -iteratefn (fn n) + "Return a function FN composed N times with itself. + +FN is a unary function. If you need to use a function of higher +arity, use `-applify' first to turn it into a unary function. + +With n = 0, this acts as identity function. + +In types: (a -> a) -> Int -> a -> a. + +This function satisfies the following law: + + (funcall (-iteratefn fn n) init) = (-last-item (-iterate fn init (1+ n)))." + (lambda (x) (--dotimes n (setq x (funcall fn x))) x)) + +(defun -counter (&optional beg end inc) + "Return a closure that counts from BEG to END, with increment INC. + +The closure will return the next value in the counting sequence +each time it is called, and nil after END is reached. BEG +defaults to 0, INC defaults to 1, and if END is nil, the counter +will increment indefinitely. + +The closure accepts any number of arguments, which are discarded." + (let ((inc (or inc 1)) + (n (or beg 0))) + (lambda (&rest _) + (when (or (not end) (< n end)) + (prog1 n + (setq n (+ n inc))))))) + +(defvar -fixfn-max-iterations 1000 + "The default maximum number of iterations performed by `-fixfn' + unless otherwise specified.") + +(defun -fixfn (fn &optional equal-test halt-test) + "Return a function that computes the (least) fixpoint of FN. + +FN must be a unary function. The returned lambda takes a single +argument, X, the initial value for the fixpoint iteration. The +iteration halts when either of the following conditions is satisified: + + 1. Iteration converges to the fixpoint, with equality being + tested using EQUAL-TEST. If EQUAL-TEST is not specified, + `equal' is used. For functions over the floating point + numbers, it may be necessary to provide an appropriate + appoximate comparsion test. + + 2. HALT-TEST returns a non-nil value. HALT-TEST defaults to a + simple counter that returns t after `-fixfn-max-iterations', + to guard against infinite iteration. Otherwise, HALT-TEST + must be a function that accepts a single argument, the + current value of X, and returns non-nil as long as iteration + should continue. In this way, a more sophisticated + convergence test may be supplied by the caller. + +The return value of the lambda is either the fixpoint or, if +iteration halted before converging, a cons with car `halted' and +cdr the final output from HALT-TEST. + +In types: (a -> a) -> a -> a." + (let ((eqfn (or equal-test 'equal)) + (haltfn (or halt-test + (-not + (-counter 0 -fixfn-max-iterations))))) + (lambda (x) + (let ((re (funcall fn x)) + (halt? (funcall haltfn x))) + (while (and (not halt?) (not (funcall eqfn x re))) + (setq x re + re (funcall fn re) + halt? (funcall haltfn re))) + (if halt? (cons 'halted halt?) + re))))) + +(defun -prodfn (&rest fns) + "Take a list of n functions and return a function that takes a +list of length n, applying i-th function to i-th element of the +input list. Returns a list of length n. + +In types (for n=2): ((a -> b), (c -> d)) -> (a, c) -> (b, d) + +This function satisfies the following laws: + + (-compose (-prodfn f g ...) (-prodfn f\\=' g\\=' ...)) = (-prodfn (-compose f f\\=') (-compose g g\\=') ...) + (-prodfn f g ...) = (-juxt (-compose f (-partial \\='nth 0)) (-compose g (-partial \\='nth 1)) ...) + (-compose (-prodfn f g ...) (-juxt f\\=' g\\=' ...)) = (-juxt (-compose f f\\=') (-compose g g\\=') ...) + (-compose (-partial \\='nth n) (-prod f1 f2 ...)) = (-compose fn (-partial \\='nth n))" + (lambda (x) (-zip-with 'funcall fns x))) + +(provide 'dash-functional) + +;;; dash-functional.el ends here |