upgrade dash to 1.2

vendor/dash.el

@@ -3,7 +3,8 @@
 ;; Copyright (C) 2012 Magnar Sveen
 
 ;; Author: Magnar Sveen <magnars@gmail.com>
-;; Version: 1.0.3
+;; Version: 20130424.943
+;; X-Original-Version: 1.2.0
 ;; Keywords: lists
 
 ;; This program is free software; you can redistribute it and/or modify
@@ -201,7 +202,7 @@ through the REP function."
 
 (defun -flatten (l)
   "Takes a nested list L and returns its contents as a single, flat list."
-  (if (listp l)
+  (if (and (listp l) (listp (cdr l)))
       (-mapcat '-flatten l)
     (list l)))
 
@@ -214,10 +215,28 @@ through the REP function."
   `(apply 'append (--map ,form ,list)))
 
 (defun -mapcat (fn list)
-  "Returns the result of applying concat to the result of applying map to FN and LIST.
-Thus function FN should return a collection."
+  "Returns the concatenation of the result of mapping FN over LIST.
+Thus function FN should return a list."
   (--mapcat (funcall fn it) list))
 
+(defun -cons* (&rest args)
+  "Makes a new list from the elements of ARGS.
+
+The last 2 members of ARGS are used as the final cons of the
+result so if the final member of ARGS is not a list the result is
+a dotted list."
+  (let (res)
+    (--each
+     args
+      (cond
+        ((not res)
+         (setq res it))
+        ((consp res)
+         (setcdr res (cons (cdr res) it)))
+        (t
+         (setq res (cons res it)))))
+    res))
+
 (defmacro --first (form list)
   "Anaphoric form of `-first'."
   (let ((n (make-symbol "needle")))
@@ -232,6 +251,29 @@ Thus function FN should return a collection."
 To get the first item in the list no questions asked, use `car'."
   (--first (funcall pred it) list))
 
+(defmacro --last (form list)
+  "Anaphoric form of `-last'."
+  (let ((n (make-symbol "needle")))
+    `(let (,n)
+       (--each ,list
+         (when ,form (setq ,n it)))
+       ,n)))
+
+(defun -last (pred list)
+  "Return the last x in LIST where (PRED x) is non-nil, else nil."
+  (--last (funcall pred it) list))
+
+(defmacro --count (pred list)
+  "Anaphoric form of `-count'."
+  (let ((r (make-symbol "result")))
+    `(let ((,r 0))
+       (--each ,list (when ,pred (setq ,r (1+ ,r))))
+       ,r)))
+
+(defun -count (pred list)
+  "Counts the number of items in LIST where (PRED item) is non-nil."
+  (--count (funcall pred it) list))
+
 (defun ---truthy? (val)
   (not (null val)))
 
@@ -302,6 +344,28 @@ Returns `nil` both if all items match the predicate, and if none of the items ma
 (defalias '-only-some-p '-only-some?)
 (defalias '--only-some-p '--only-some?)
 
+(defun -slice (list from &optional to)
+  "Return copy of LIST, starting from index FROM to index TO.
+FROM or TO may be negative."
+  (let ((length (length list))
+        (new-list nil)
+        (index 0))
+    ;; to defaults to the end of the list
+    (setq to (or to length))
+    ;; handle negative indices
+    (when (< from 0)
+      (setq from (mod from length)))
+    (when (< to 0)
+      (setq to (mod to length)))
+
+    ;; iterate through the list, keeping the elements we want
+    (while (< index to)
+      (when (>= index from)
+        (!cons (car list) new-list))
+      (!cdr list)
+      (setq index (1+ index)))
+    (nreverse new-list)))
+
 (defun -take (n list)
   "Returns a new list of the first N items in LIST, or all items if there are fewer than N."
   (let (result)
@@ -340,17 +404,37 @@ Returns `nil` both if all items match the predicate, and if none of the items ma
   (--drop-while (funcall pred it) list))
 
 (defun -split-at (n list)
-  "Returns a list of ((-take N LIST) (-drop N LIST))"
-  (list (-take n list)
-        (-drop n list)))
+  "Returns a list of ((-take N LIST) (-drop N LIST)), in no more than one pass through the list."
+  (let (result)
+    (--dotimes n
+      (when list
+        (!cons (car list) result)
+        (!cdr list)))
+    (list (nreverse result) list)))
+
+(defun -insert-at (n x list)
+  "Returns a list with X inserted into LIST at position N."
+  (let ((split-list (-split-at n list)))
+    (nconc (car split-list) (cons x (cadr split-list)))))
 
-(defmacro --split-with (form list)
+(defmacro --split-with (pred list)
   "Anaphoric form of `-split-with'."
-  `(list (--take-while ,form ,list)
-         (--drop-while ,form ,list)))
+  (let ((l (make-symbol "list"))
+        (r (make-symbol "result"))
+        (c (make-symbol "continue")))
+    `(let ((,l ,list)
+           (,r nil)
+           (,c t))
+       (while (and ,l ,c)
+         (let ((it (car ,l)))
+           (if (not ,pred)
+               (setq ,c nil)
+             (!cons it ,r)
+             (!cdr ,l))))
+       (list (nreverse ,r) ,l))))
 
 (defun -split-with (pred list)
-  "Returns a list of ((-take-while PRED LIST) (-drop-while PRED LIST))"
+  "Returns a list of ((-take-while PRED LIST) (-drop-while PRED LIST)), in no more than one pass through the list."
   (--split-with (funcall pred it) list))
 
 (defmacro --separate (form list)
@@ -362,7 +446,7 @@ Returns `nil` both if all items match the predicate, and if none of the items ma
        (list (nreverse ,y) (nreverse ,n)))))
 
 (defun -separate (pred list)
-  "Returns a list of ((-filter PRED LIST) (-remove PRED LIST))."
+  "Returns a list of ((-filter PRED LIST) (-remove PRED LIST)), in one pass through the list."
   (--separate (funcall pred it) list))
 
 (defun -partition (n list)
@@ -418,9 +502,46 @@ The last group may contain less than N items."
            (nreverse ,r))))))
 
 (defun -partition-by (fn list)
-  "Applies FN to each value in LIST, splitting it each time FN returns a new value."
+  "Applies FN to each item in LIST, splitting it each time FN returns a new value."
   (--partition-by (funcall fn it) list))
 
+(defmacro --partition-by-header (form list)
+  "Anaphoric form of `-partition-by-header'."
+  (let ((r (make-symbol "result"))
+        (s (make-symbol "sublist"))
+        (h (make-symbol "header-value"))
+        (b (make-symbol "seen-body?"))
+        (n (make-symbol "new-value"))
+        (l (make-symbol "list")))
+    `(let ((,l ,list))
+       (when ,l
+         (let* ((,r nil)
+                (it (car ,l))
+                (,s (list it))
+                (,h ,form)
+                (,b nil)
+                (,l (cdr ,l)))
+           (while ,l
+             (let* ((it (car ,l))
+                    (,n ,form))
+               (if (equal ,h, n)
+                   (when ,b
+                     (!cons (nreverse ,s) ,r)
+                     (setq ,s nil)
+                     (setq ,b nil))
+                 (setq ,b t))
+               (!cons it ,s)
+               (!cdr ,l)))
+           (!cons (nreverse ,s) ,r)
+           (nreverse ,r))))))
+
+(defun -partition-by-header (fn list)
+  "Applies FN to the first item in LIST. That is the header
+  value. Applies FN to each item in LIST, splitting it each time
+  FN returns the header value, but only after seeing at least one
+  other value (the body)."
+  (--partition-by-header (funcall fn it) list))
+
 (defmacro --group-by (form list)
   "Anaphoric form of `-group-by'."
   (let ((l (make-symbol "list"))
@@ -472,6 +593,41 @@ elements of LIST.  Keys are compared by `equal'."
       (setq lists (-map 'cdr lists)))
     (nreverse result)))
 
+(defmacro --zip-with (form list1 list2)
+  "Anaphoric form of `-zip-with'.
+
+The elements in list1 is bound as `it`, the elements in list2 as `other`."
+  (let ((r (make-symbol "result"))
+        (l1 (make-symbol "list1"))
+        (l2 (make-symbol "list2")))
+    `(let ((,r nil)
+           (,l1 ,list1)
+           (,l2 ,list2))
+       (while (and ,l1 ,l2)
+         (let ((it (car ,l1))
+               (other (car ,l2)))
+           (!cons ,form ,r)
+           (!cdr ,l1)
+           (!cdr ,l2)))
+       (nreverse ,r))))
+
+(defun -zip-with (fn list1 list2)
+  "Zip the two lists LIST1 and LIST2 using a function FN.  This
+function is applied pairwise taking as first argument element of
+LIST1 and as second argument element of LIST2 at corresponding
+position.
+
+The anaphoric form `--zip-with' binds the elements from LIST1 as `it`,
+and the elements from LIST2 as `other`."
+  (--zip-with (funcall fn it other) list1 list2))
+
+(defun -zip (list1 list2)
+  "Zip the two lists together.  Return the list where elements
+are cons pairs with car being element from LIST1 and cdr being
+element from LIST2.  The length of the returned list is the
+length of the shorter one."
+  (-zip-with 'cons list1 list2))
+
 (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.
@@ -532,6 +688,66 @@ in in second form, etc."
 (put '->> 'lisp-indent-function 1)
 (put '--> 'lisp-indent-function 1)
 
+(defmacro -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."
+  (let ((var (car var-val))
+        (val (cadr var-val)))
+    `(let ((,var ,val))
+       (when ,var
+         ,@body))))
+
+(defmacro -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*')."
+  (if (= (length vars-vals) 1)
+      `(-when-let ,(car vars-vals)
+         ,@body)
+    `(-when-let ,(car vars-vals)
+       (-when-let* ,(cdr vars-vals)
+         ,@body))))
+
+(defmacro --when-let (val &rest body)
+  "If VAL evaluates to non-nil, bind it to `it' and execute
+body."
+  `(let ((it ,val))
+     (when it
+       ,@body)))
+
+(defmacro -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."
+  (let ((var (car var-val))
+        (val (cadr var-val)))
+    `(let ((,var ,val))
+       (if ,var ,then ,else))))
+
+(defmacro -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*')."
+  (let ((first-pair (car vars-vals))
+        (rest (cdr vars-vals)))
+    (if (= (length vars-vals) 1)
+        `(-if-let ,first-pair ,then ,else)
+      `(-if-let ,first-pair
+         (-if-let* ,rest ,then ,else)
+         ,else))))
+
+(defmacro --if-let (val then &optional else)
+  "If VAL evaluates to non-nil, bind it to `it' and do THEN,
+otherwise do ELSE."
+  `(let ((it ,val))
+     (if it ,then ,else)))
+
+(put '-when-let 'lisp-indent-function 1)
+(put '-when-let* 'lisp-indent-function 1)
+(put '--when-let 'lisp-indent-function 1)
+(put '-if-let 'lisp-indent-function 1)
+(put '-if-let* 'lisp-indent-function 1)
+(put '--if-let 'lisp-indent-function 1)
+
 (defun -distinct (list)
   "Return a new list with all duplicates removed.
 The test for equality is done with `equal',
@@ -589,6 +805,13 @@ or with `-compare-fn' if that's non-nil."
 
 (defalias '-contains-p '-contains?)
 
+(defun -repeat (n x)
+  "Return a list with X repeated N times.
+Returns nil if N is less than 1."
+  (let (ret)
+    (--dotimes n (!cons x ret))
+    ret))
+
 (eval-after-load "lisp-mode"
   '(progn
      (let ((new-keywords '(
@@ -651,12 +874,16 @@ or with `-compare-fn' if that's non-nil."
                            "--drop-while"
                            "-drop-while"
                            "-split-at"
+                           "-insert-at"
                            "--split-with"
                            "-split-with"
                            "-partition"
                            "-partition-all"
                            "-interpose"
                            "-interleave"
+                           "--zip-with"
+                           "-zip-with"
+                           "-zip"
                            "--map-when"
                            "-map-when"
                            "--replace-where"
@@ -666,16 +893,25 @@ or with `-compare-fn' if that's non-nil."
                            "->"
                            "->>"
                            "-->"
+                           "-when-let"
+                           "-when-let*"
+                           "--when-let"
+                           "-if-let"
+                           "-if-let*"
+                           "--if-let"
                            "-distinct"
                            "-intersection"
                            "-difference"
                            "-contains?"
                            "-contains-p"
+                           "-repeat"
+                           "-cons*"
                            ))
            (special-variables '(
                                 "it"
                                 "it-index"
                                 "acc"
+                                "other"
                                 )))
        (font-lock-add-keywords 'emacs-lisp-mode `((,(concat "\\<" (regexp-opt special-variables 'paren) "\\>")
                                                    1 font-lock-variable-name-face)) 'append)