about summary refs log tree commit diff
path: root/configs/shared/emacs/.emacs.d/elpa/dash-functional-20180107.818/dash-functional.el
blob: 7479f23661af0acb0a6cefcd26cfeef7a29316f2 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
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.818
;; 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