Built-in files auto-update: Mon Jan 25 02:12:52 UTC 2021
This commit is contained in:
emacspace
Eugene Yaremenko
parent
8c18c1fc30
commit
e712eae9f1
|
|
@ -204,7 +204,8 @@ This function's anaphoric counterpart is `--map'."
|
|||
(defmacro --map (form list)
|
||||
"Eval FORM for each item in LIST and return the list of results.
|
||||
Each element of LIST in turn is bound to `it' before evaluating
|
||||
BODY.
|
||||
FORM.
|
||||
|
||||
This is the anaphoric counterpart to `-map'."
|
||||
(declare (debug (def-form form)))
|
||||
`(mapcar (lambda (it) (ignore it) ,form) ,list))
|
||||
|
|
@ -416,124 +417,151 @@ For other folds, see also `-reductions-r-from' and
|
|||
(list (funcall fn))))
|
||||
|
||||
(defmacro --filter (form list)
|
||||
"Anaphoric form of `-filter'.
|
||||
|
||||
See also: `--remove'."
|
||||
"Return a new list of the items in LIST for which FORM evals to non-nil.
|
||||
Each element of LIST in turn is bound to `it' and its index
|
||||
within LIST to `it-index' before evaluating FORM.
|
||||
This is the anaphoric counterpart to `-filter'.
|
||||
For the opposite operation, see also `--remove'."
|
||||
(declare (debug (form form)))
|
||||
(let ((r (make-symbol "result")))
|
||||
`(let (,r)
|
||||
(--each ,list (when ,form (!cons it ,r)))
|
||||
(--each ,list (when ,form (push it ,r)))
|
||||
(nreverse ,r))))
|
||||
|
||||
(defun -filter (pred list)
|
||||
"Return a new list of the items in LIST for which PRED returns a non-nil value.
|
||||
|
||||
Alias: `-select'
|
||||
|
||||
See also: `-keep', `-remove'."
|
||||
"Return a new list of the items in LIST for which PRED returns non-nil.
|
||||
Alias: `-select'.
|
||||
This function's anaphoric counterpart is `--filter'.
|
||||
For similar operations, see also `-keep' and `-remove'."
|
||||
(--filter (funcall pred it) list))
|
||||
|
||||
(defalias '-select '-filter)
|
||||
(defalias '--select '--filter)
|
||||
|
||||
(defmacro --remove (form list)
|
||||
"Anaphoric form of `-remove'.
|
||||
|
||||
See also `--filter'."
|
||||
"Return a new list of the items in LIST for which FORM evals to nil.
|
||||
Each element of LIST in turn is bound to `it' and its index
|
||||
within LIST to `it-index' before evaluating FORM.
|
||||
This is the anaphoric counterpart to `-remove'.
|
||||
For the opposite operation, see also `--filter'."
|
||||
(declare (debug (form form)))
|
||||
`(--filter (not ,form) ,list))
|
||||
|
||||
(defun -remove (pred list)
|
||||
"Return a new list of the items in LIST for which PRED returns nil.
|
||||
|
||||
Alias: `-reject'
|
||||
|
||||
See also: `-filter'."
|
||||
Alias: `-reject'.
|
||||
This function's anaphoric counterpart is `--remove'.
|
||||
For similar operations, see also `-keep' and `-filter'."
|
||||
(--remove (funcall pred it) list))
|
||||
|
||||
(defalias '-reject '-remove)
|
||||
(defalias '--reject '--remove)
|
||||
|
||||
(defun -remove-first (pred list)
|
||||
"Return a new list with the first item matching PRED removed.
|
||||
|
||||
Alias: `-reject-first'
|
||||
|
||||
See also: `-remove', `-map-first'"
|
||||
(let (front)
|
||||
(while (and list (not (funcall pred (car list))))
|
||||
(push (car list) front)
|
||||
(!cdr list))
|
||||
(if list
|
||||
(-concat (nreverse front) (cdr list))
|
||||
(nreverse front))))
|
||||
|
||||
(defmacro --remove-first (form list)
|
||||
"Anaphoric form of `-remove-first'."
|
||||
"Remove the first item from LIST for which FORM evals to non-nil.
|
||||
Each element of LIST in turn is bound to `it' and its index
|
||||
within LIST to `it-index' before evaluating FORM. This is a
|
||||
non-destructive operation, but only the front of LIST leading up
|
||||
to the removed item is a copy; the rest is LIST's original tail.
|
||||
If no item is removed, then the result is a complete copy.
|
||||
This is the anaphoric counterpart to `-remove-first'."
|
||||
(declare (debug (form form)))
|
||||
`(-remove-first (lambda (it) ,form) ,list))
|
||||
(let ((front (make-symbol "front"))
|
||||
(tail (make-symbol "tail")))
|
||||
`(let ((,tail ,list) ,front)
|
||||
(--each-while ,tail (not ,form)
|
||||
(push (pop ,tail) ,front))
|
||||
(if ,tail
|
||||
(nconc (nreverse ,front) (cdr ,tail))
|
||||
(nreverse ,front)))))
|
||||
|
||||
(defun -remove-first (pred list)
|
||||
"Remove the first item from LIST for which PRED returns non-nil.
|
||||
This is a non-destructive operation, but only the front of LIST
|
||||
leading up to the removed item is a copy; the rest is LIST's
|
||||
original tail. If no item is removed, then the result is a
|
||||
complete copy.
|
||||
Alias: `-reject-first'.
|
||||
This function's anaphoric counterpart is `--remove-first'.
|
||||
See also `-map-first', `-remove-item', and `-remove-last'."
|
||||
(--remove-first (funcall pred it) list))
|
||||
|
||||
(defalias '-reject-first '-remove-first)
|
||||
(defalias '--reject-first '--remove-first)
|
||||
|
||||
(defun -remove-last (pred list)
|
||||
"Return a new list with the last item matching PRED removed.
|
||||
|
||||
Alias: `-reject-last'
|
||||
|
||||
See also: `-remove', `-map-last'"
|
||||
(nreverse (-remove-first pred (reverse list))))
|
||||
|
||||
(defmacro --remove-last (form list)
|
||||
"Anaphoric form of `-remove-last'."
|
||||
"Remove the last item from LIST for which FORM evals to non-nil.
|
||||
Each element of LIST in turn is bound to `it' before evaluating
|
||||
FORM. The result is a copy of LIST regardless of whether an
|
||||
element is removed.
|
||||
This is the anaphoric counterpart to `-remove-last'."
|
||||
(declare (debug (form form)))
|
||||
`(-remove-last (lambda (it) ,form) ,list))
|
||||
`(nreverse (--remove-first ,form (reverse ,list))))
|
||||
|
||||
(defun -remove-last (pred list)
|
||||
"Remove the last item from LIST for which PRED returns non-nil.
|
||||
The result is a copy of LIST regardless of whether an element is
|
||||
removed.
|
||||
Alias: `-reject-last'.
|
||||
This function's anaphoric counterpart is `--remove-last'.
|
||||
See also `-map-last', `-remove-item', and `-remove-first'."
|
||||
(--remove-last (funcall pred it) list))
|
||||
|
||||
(defalias '-reject-last '-remove-last)
|
||||
(defalias '--reject-last '--remove-last)
|
||||
|
||||
(defun -remove-item (item list)
|
||||
"Remove all occurrences of ITEM from LIST.
|
||||
|
||||
Comparison is done with `equal'."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(--remove (equal it item) list))
|
||||
(defalias '-remove-item #'remove
|
||||
"Return a copy of LIST with all occurrences of ITEM removed.
|
||||
The comparison is done with `equal'.
|
||||
\n(fn ITEM LIST)")
|
||||
|
||||
(defmacro --keep (form list)
|
||||
"Anaphoric form of `-keep'."
|
||||
"Eval FORM for each item in LIST and return the non-nil results.
|
||||
Like `--filter', but returns the non-nil results of FORM instead
|
||||
of the corresponding elements of LIST. Each element of LIST in
|
||||
turn is bound to `it' and its index within LIST to `it-index'
|
||||
before evaluating FORM.
|
||||
This is the anaphoric counterpart to `-keep'."
|
||||
(declare (debug (form form)))
|
||||
(let ((r (make-symbol "result"))
|
||||
(m (make-symbol "mapped")))
|
||||
`(let (,r)
|
||||
(--each ,list (let ((,m ,form)) (when ,m (!cons ,m ,r))))
|
||||
(--each ,list (let ((,m ,form)) (when ,m (push ,m ,r))))
|
||||
(nreverse ,r))))
|
||||
|
||||
(defun -keep (fn list)
|
||||
"Return a new list of the non-nil results of applying FN to the items in LIST.
|
||||
|
||||
If you want to select the original items satisfying a predicate use `-filter'."
|
||||
"Return a new list of the non-nil results of applying FN to each item in LIST.
|
||||
Like `-filter', but returns the non-nil results of FN instead of
|
||||
the corresponding elements of LIST.
|
||||
Its anaphoric counterpart is `--keep'."
|
||||
(--keep (funcall fn it) list))
|
||||
|
||||
(defun -non-nil (list)
|
||||
"Return all non-nil elements of LIST."
|
||||
"Return a copy of LIST with all nil items removed."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(-remove 'null list))
|
||||
(--filter it list))
|
||||
|
||||
(defmacro --map-indexed (form list)
|
||||
"Anaphoric form of `-map-indexed'."
|
||||
"Eval FORM for each item in LIST and return the list of results.
|
||||
Each element of LIST in turn is bound to `it' and its index
|
||||
within LIST to `it-index' before evaluating FORM. This is like
|
||||
`--map', but additionally makes `it-index' available to FORM.
|
||||
|
||||
This is the anaphoric counterpart to `-map-indexed'."
|
||||
(declare (debug (form form)))
|
||||
(let ((r (make-symbol "result")))
|
||||
`(let (,r)
|
||||
(--each ,list
|
||||
(!cons ,form ,r))
|
||||
(push ,form ,r))
|
||||
(nreverse ,r))))
|
||||
|
||||
(defun -map-indexed (fn list)
|
||||
"Return a new list consisting of the result of (FN index item) for each item in LIST.
|
||||
"Apply FN to each index and item in LIST and return the list of results.
|
||||
This is like `-map', but FN takes two arguments: the index of the
|
||||
current element within LIST, and the element itself.
|
||||
|
||||
In the anaphoric form `--map-indexed', the index is exposed as symbol `it-index'.
|
||||
|
||||
See also: `-each-indexed'."
|
||||
This function's anaphoric counterpart is `--map-indexed'.
|
||||
For a side-effecting variant, see also `-each-indexed'."
|
||||
(--map-indexed (funcall fn it-index it) list))
|
||||
|
||||
(defmacro --map-when (pred rep list)
|
||||
|
|
@ -729,38 +757,45 @@ If ELEMENTS is non nil, append these to the list as well."
|
|||
(-concat list (list elem) elements))
|
||||
|
||||
(defmacro --first (form list)
|
||||
"Anaphoric form of `-first'."
|
||||
"Return the first item in LIST for which FORM evals to non-nil.
|
||||
Return nil if no such element is found.
|
||||
Each element of LIST in turn is bound to `it' and its index
|
||||
within LIST to `it-index' before evaluating FORM.
|
||||
This is the anaphoric counterpart to `-first'."
|
||||
(declare (debug (form form)))
|
||||
(let ((n (make-symbol "needle")))
|
||||
`(let (,n)
|
||||
(--each-while ,list (not ,n)
|
||||
(when ,form (setq ,n it)))
|
||||
(--each-while ,list (or (not ,form)
|
||||
(ignore (setq ,n it))))
|
||||
,n)))
|
||||
|
||||
(defun -first (pred list)
|
||||
"Return the first x in LIST where (PRED x) is non-nil, else nil.
|
||||
|
||||
"Return the first item in LIST for which PRED returns non-nil.
|
||||
Return nil if no such element is found.
|
||||
To get the first item in the list no questions asked, use `car'.
|
||||
|
||||
Alias: `-find'"
|
||||
Alias: `-find'.
|
||||
This function's anaphoric counterpart is `--first'."
|
||||
(--first (funcall pred it) list))
|
||||
|
||||
(defalias '-find '-first)
|
||||
(defalias '--find '--first)
|
||||
|
||||
(defmacro --some (form list)
|
||||
"Anaphoric form of `-some'."
|
||||
"Return non-nil if FORM evals to non-nil for at least one item in LIST.
|
||||
If so, return the first such result of FORM.
|
||||
Each element of LIST in turn is bound to `it' and its index
|
||||
within LIST to `it-index' before evaluating FORM.
|
||||
This is the anaphoric counterpart to `-some'."
|
||||
(declare (debug (form form)))
|
||||
(let ((n (make-symbol "needle")))
|
||||
`(let (,n)
|
||||
(--each-while ,list (not ,n)
|
||||
(setq ,n ,form))
|
||||
(--each-while ,list (not (setq ,n ,form)))
|
||||
,n)))
|
||||
|
||||
(defun -some (pred list)
|
||||
"Return (PRED x) for the first LIST item where (PRED x) is non-nil, else nil.
|
||||
|
||||
Alias: `-any'"
|
||||
Alias: `-any'.
|
||||
This function's anaphoric counterpart is `--some'."
|
||||
(--some (funcall pred it) list))
|
||||
|
||||
(defalias '-any '-some)
|
||||
|
|
@ -1716,23 +1751,24 @@ and when that result is non-nil, through the next form, etc."
|
|||
(->> ,result ,form))
|
||||
,@more))))
|
||||
|
||||
(defmacro -some--> (x &optional form &rest more)
|
||||
"When expr is non-nil, thread it through the first form (via `-->'),
|
||||
and when that result is non-nil, through the next form, etc."
|
||||
(declare (debug ->)
|
||||
(indent 1))
|
||||
(if (null form) x
|
||||
(defmacro -some--> (expr &rest forms)
|
||||
"Thread EXPR through FORMS via `-->', while the result is non-nil.
|
||||
When EXPR evaluates to non-nil, thread the result through the
|
||||
first of FORMS, and when that result is non-nil, thread it
|
||||
through the next form, etc."
|
||||
(declare (debug (form &rest &or symbolp consp)) (indent 1))
|
||||
(if (null forms) expr
|
||||
(let ((result (make-symbol "result")))
|
||||
`(-some--> (-when-let (,result ,x)
|
||||
(--> ,result ,form))
|
||||
,@more))))
|
||||
`(-some--> (-when-let (,result ,expr)
|
||||
(--> ,result ,(car forms)))
|
||||
,@(cdr forms)))))
|
||||
|
||||
(defmacro -doto (init &rest forms)
|
||||
"Evaluate INIT and pass it as argument to FORMS with `->'.
|
||||
The RESULT of evaluating INIT is threaded through each of FORMS
|
||||
individually using `->', which see. The return value is RESULT,
|
||||
which FORMS may have modified by side effect."
|
||||
(declare (debug (form body)) (indent 1))
|
||||
(declare (debug (form &rest &or symbolp consp)) (indent 1))
|
||||
(let ((retval (make-symbol "result")))
|
||||
`(let ((,retval ,init))
|
||||
,@(mapcar (lambda (form) `(-> ,retval ,form)) forms)
|
||||
|
|
@ -2569,20 +2605,22 @@ Alias: `-same-items-p'"
|
|||
(defalias '-same-items-p '-same-items?)
|
||||
|
||||
(defun -is-prefix? (prefix list)
|
||||
"Return non-nil if PREFIX is prefix of LIST.
|
||||
"Return non-nil if PREFIX is a prefix of LIST.
|
||||
|
||||
Alias: `-is-prefix-p'"
|
||||
Alias: `-is-prefix-p'."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(--each-while list (equal (car prefix) it)
|
||||
(!cdr prefix))
|
||||
(not prefix))
|
||||
(--each-while list (and (equal (car prefix) it)
|
||||
(!cdr prefix)))
|
||||
(null prefix))
|
||||
|
||||
(defun -is-suffix? (suffix list)
|
||||
"Return non-nil if SUFFIX is suffix of LIST.
|
||||
"Return non-nil if SUFFIX is a suffix of LIST.
|
||||
|
||||
Alias: `-is-suffix-p'"
|
||||
Alias: `-is-suffix-p'."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(-is-prefix? (reverse suffix) (reverse list)))
|
||||
(cond ((null suffix))
|
||||
((setq list (member (car suffix) list))
|
||||
(equal (cdr suffix) (cdr list)))))
|
||||
|
||||
(defun -is-infix? (infix list)
|
||||
"Return non-nil if INFIX is infix of LIST.
|
||||
|
|
@ -2920,8 +2958,16 @@ structure such as plist or alist."
|
|||
(defvar dash--keywords
|
||||
`(;; TODO: Do not fontify the following automatic variables
|
||||
;; globally; detect and limit to their local anaphoric scope.
|
||||
(,(concat "\\_<" (regexp-opt '("acc" "it" "it-index" "other")) "\\_>")
|
||||
(,(rx symbol-start (| "acc" "it" "it-index" "other") symbol-end)
|
||||
0 font-lock-variable-name-face)
|
||||
;; Macros in dev/examples.el. Based on `lisp-mode-symbol-regexp'.
|
||||
(,(rx ?\( (group (| "defexamples" "def-example-group")) symbol-end
|
||||
(+ (in "\t "))
|
||||
(group (* (| (syntax word) (syntax symbol) (: ?\\ nonl)))))
|
||||
(1 font-lock-keyword-face)
|
||||
(2 font-lock-function-name-face))
|
||||
;; Symbols in dev/examples.el.
|
||||
,(rx symbol-start (| "=>" "~>" "!!>") symbol-end)
|
||||
;; Elisp macro fontification was static prior to Emacs 25.
|
||||
,@(when (< emacs-major-version 25)
|
||||
(let ((macs '("!cdr"
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
;; Copyright (C) 2013 Wilfred Hughes
|
||||
|
||||
;; Author: Wilfred Hughes <me@wilfred.me.uk>
|
||||
;; Version: 2.3
|
||||
;; Version: 2.4
|
||||
;; Keywords: hash table, hash map, hash
|
||||
;; Package-Requires: ((dash "2.12.0"))
|
||||
|
||||
|
|
|
|||
|
|
@ -132,16 +132,17 @@
|
|||
rec)))
|
||||
|
||||
(cl-defmethod mocker-verify ((mock mocker-mock))
|
||||
(mapc #'(lambda (r) (when (and (oref r :-active)
|
||||
(< (oref r :-occurrences)
|
||||
(oref r :min-occur)))
|
||||
(signal 'mocker-record-error
|
||||
(list (format
|
||||
(concat "Expected call to mock `%s',"
|
||||
" with input like %s,"
|
||||
" was not run.")
|
||||
(oref mock :function)
|
||||
(mocker-get-record-expectations r))))))
|
||||
(mapc #'(lambda (r)
|
||||
(when (and (oref r :-active)
|
||||
(< (oref r :-occurrences)
|
||||
(oref r :min-occur)))
|
||||
(signal 'mocker-record-error
|
||||
(list (format
|
||||
(concat "Expected call to mock `%s',"
|
||||
" with input like %s,"
|
||||
" was not run.")
|
||||
(oref mock :function)
|
||||
(mocker-get-record-expectations r))))))
|
||||
(oref mock :records)))
|
||||
|
||||
;;; Mock record base object
|
||||
|
|
@ -159,11 +160,12 @@
|
|||
(let* ((obj (cl-call-next-method))
|
||||
(occur (oref obj :occur)))
|
||||
(when occur
|
||||
(oset obj :min-occur (max (oref obj :min-occur)
|
||||
occur))
|
||||
(oset obj :max-occur (if (oref obj :max-occur)
|
||||
(min (oref obj :max-occur) occur)
|
||||
occur)))
|
||||
occur))
|
||||
(oset obj :min-occur (min (oref obj :max-occur)
|
||||
(max (oref obj :min-occur)
|
||||
occur))))
|
||||
obj))
|
||||
|
||||
(cl-defmethod mocker-read-record ((rec (subclass mocker-record-base)) spec)
|
||||
|
|
@ -172,10 +174,15 @@
|
|||
(cl-defmethod mocker-use-record ((rec mocker-record-base))
|
||||
(let ((max (oref rec :max-occur))
|
||||
(n (1+ (oref rec :-occurrences))))
|
||||
(oset rec :-occurrences n)
|
||||
(when (and (not (null max))
|
||||
(= n max))
|
||||
(oset rec :-active nil))))
|
||||
(if (and max (> n max))
|
||||
(signal 'mocker-record-error
|
||||
(list (format
|
||||
"Unexpected call to mock `%s'"
|
||||
(oref mock :function))))
|
||||
(oset rec :-occurrences n)
|
||||
(when (and (not (null max))
|
||||
(= n max))
|
||||
(oset rec :-active nil)))))
|
||||
|
||||
(cl-defmethod mocker-skip-record ((rec mocker-record-base) args)
|
||||
(if (>= (oref rec :-occurrences)
|
||||
|
|
@ -343,7 +350,7 @@ specialized mini-languages for specific record classes.
|
|||
(cons 'progn
|
||||
(mapcar #'(lambda (rec)
|
||||
`(mocker-add-record ,(car m)
|
||||
,@rec))
|
||||
,@rec))
|
||||
(nth 2 m))))
|
||||
mocks))
|
||||
(verifs (mapcar #'(lambda (m)
|
||||
|
|
|
|||
Loading…
Reference in New Issue