[elpa] externals/dash a4be872 338/426: Add `-let` and `-let*`

[Phillip Lord]

branch: externals/dash
commit a4be872addc1dc612d5ea599f7aafce6b58719f0
Author: Matus Goljer <address@hidden>
Commit: Matus Goljer <address@hidden>

    Add `-let` and `-let*`
---
 README.md       |  104 +++++++++++++++++++++++++
 dash.el         |  232 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 dev/examples.el |   66 +++++++++++++++-
 3 files changed, 401 insertions(+), 1 deletions(-)

diff --git a/README.md b/README.md
index 830bc4f..d47a2fe 100644
--- a/README.md
+++ b/README.md
@@ -217,6 +217,8 @@ Convenient versions of `let` and `let*` constructs combined 
with flow control.
 * [-when-let*](#-when-let-vars-vals-rest-body) `(vars-vals &rest body)`
 * [-if-let](#-if-let-var-val-then-rest-else) `(var-val then &rest else)`
 * [-if-let*](#-if-let-vars-vals-then-rest-else) `(vars-vals then &rest else)`
+* [-let](#-let-varlist-rest-body) `(varlist &rest body)`
+* [-let*](#-let-varlist-rest-body) `(varlist &rest body)`
 
 ### Side-effects
 
@@ -1698,6 +1700,108 @@ of (`var` `val`) pairs (corresponding to the bindings 
of `let*`).
 (-if-let* ((x 5) (y nil) (z 7)) (+ x y z) "foo") ;; => "foo"
 ```
 
+#### -let `(varlist &rest body)`
+
+Bind variables according to `varlist` then eval `body`.
+
+`varlist` is a list of lists of the form (`pattern` `source`).  Each
+`pattern` is matched against the `source` "structurally".  `source`
+is only evaluated once for each `pattern`.  Each `pattern` is matched
+recursively, and can therefore contain sub-patterns which are
+matched against corresponding sub-expressions of `source`.
+
+All the SOURCEs are evalled before any symbols are
+bound (i.e. "in parallel").
+
+If `varlist` only contains one (`pattern` `source`) element, you can
+optionally specify it using a vector and discarding the
+outer-most parens.  Thus
+
+    (-let ((`pattern` `source`)) ..)
+
+becomes
+
+    (-let [`pattern` `source`] ..).
+
+`-let` uses a convention of not binding places (symbols) starting
+with _ whenever it's possible.  You can use this to skip over
+entries you don't care about.  However, this is not *always*
+possible (as a result of implementation) and these symbols might
+get bound to undefined values.
+
+Following is the overview of supported patterns.  Remember that
+patterns can be matched recursively, so every a, b, aK in the
+following can be a matching construct and not necessarily a
+symbol/variable.
+
+Symbol:
+
+    a - bind the `source` to `a`.  This is just like regular `let`.
+
+Conses and lists:
+
+    (a) - bind `car` of cons/list to `a`
+
+    (a . b) - bind car of cons to `a` and `cdr` to `b`
+
+    (a b) - bind car of list to `a` and `cadr` to `b`
+
+    (a1 a2 a3  ...) - bind 0th car of list to `a1`, 1st to `a2`, 2nd to `a3` 
...
+
+    (a1 a2 a3 ... aN . rest) - as above, but bind the Nth cdr to `rest`.
+
+Vectors:
+
+    [a] - bind 0th element of a non-list sequence to `a` (works with
+          vectors, strings, bit arrays...)
+
+    [a1 a2 a3 ...] - bind 0th element of non-list sequence to `a0`, 1st to
+                     `a1`, 2nd to `a2`, ...
+                     If the `pattern` is shorter than `source`, the values at
+                     places not in `pattern` are ignored.
+                     If the `pattern` is longer than `source`, an `error` is
+                     thrown.
+
+Key/value stores:
+
+    (&plist key0 a0 ... keyN aN) - bind value mapped by keyK in the
+                                   `source` plist to aK.  If the
+                                   value is not found, aK is nil.
+
+    (&alist key0 a0 ... keyN aN) - bind value mapped by keyK in the
+                                   `source` alist to aK.  If the
+                                   value is not found, aK is nil.
+
+    (&hash key0 a0 ... keyN aN) - bind value mapped by keyK in the
+                                  `source` hash table to aK.  If the
+                                  value is not found, aK is nil.
+
+```cl
+(-let (([a (b c) d] [1 (2 3) 4])) (list a b c d)) ;; => '(1 2 3 4)
+(-let [(a b c . d) (list 1 2 3 4 5 6)] (list a b c d)) ;; => '(1 2 3 (4 5 6))
+(-let [(&plist :foo foo :bar bar) (list :baz 3 :foo 1 :qux 4 :bar 2)] (list 
foo bar)) ;; => '(1 2)
+```
+
+#### -let* `(varlist &rest body)`
+
+Bind variables according to `varlist` then eval `body`.
+
+`varlist` is a list of lists of the form (`pattern` `source`).  Each
+`pattern` is matched against the `source` structurally.  `source` is
+only evaluated once for each `pattern`.
+
+Each `source` can refer to the symbols already bound by this
+`varlist`.  This is useful if you want to destructure `source`
+recursively but also want to name the intermediate structures.
+
+See `-let` for the list of all possible patterns.
+
+```cl
+(-let* (((a . b) (cons 1 2)) ((c . d) (cons 3 4))) (list a b c d)) ;; => '(1 2 
3 4)
+(-let* (((a . b) (cons 1 (cons 2 3))) ((c . d) b)) (list a b c d)) ;; => '(1 
(2 . 3) 2 3)
+(-let* (((&alist "foo" foo "bar" bar) (list (cons "foo" 1) (cons "bar" (list 
'a 'b 'c)))) ((a b c) bar)) (list foo a b c bar)) ;; => '(1 a b c (a b c))
+```
+
 
 ## Side-effects
 
diff --git a/dash.el b/dash.el
index 6bebaa6..6fd4fdb 100644
--- a/dash.el
+++ b/dash.el
@@ -1174,6 +1174,236 @@ otherwise do ELSE."
   `(let ((it ,val))
      (if it ,then ,@else)))
 
+(defun dash--match-cons (match-form source)
+  "Setup a cons matching environment and call the real matcher."
+  (let ((s (make-symbol "--dash-source--")))
+    (cons (list s source) (dash--match-cons-1 match-form s))))
+
+(defun dash--match-cons-1 (match-form source)
+  "Match MATCH-FORM against SOURCE.
+
+MATCH-FORM is a proper or improper list.  Each element of
+MATCH-FORM is either a symbol, which gets bound to the respective
+value in source or another match form which gets destructured
+recursively.
+
+If the cdr of last cons cell in the list is `nil', matching stops
+there.
+
+SOURCE is a proper or improper list."
+  (cond
+   ((and (consp match-form)
+         (not (null match-form)))
+    (cond
+     ;; because each bind-body has a side-effect of chopping the head
+     ;; of the list, we must create a binding even for _ places
+     ((symbolp (car match-form))
+      (cons (list (car match-form) `(prog1 (car ,s) (!cdr ,s)))
+            (dash--match-cons-1 (cdr match-form) s)))
+     (t
+      (-concat (dash--match (car match-form) `(prog1 (car ,s) (!cdr ,s)))
+               (dash--match-cons-1 (cdr match-form) s)))))
+   ((eq match-form nil)
+    nil)
+   (t
+    (list (list match-form s)))))
+
+;; TODO: add support to match the "rest" of the sequence, so that we
+;; can break apart strings for example
+;; (-let (([h &rest tail] "fobar")) (list h tail)) => (102 "obar")
+(defun dash--match-vector (match-form source)
+  "Setup a vector matching environment and call the real matcher."
+  (let ((s (make-symbol "--dash-source--")))
+    (cons (list s source) (dash--match-vector-1 match-form s))))
+
+(defun dash--match-vector-1 (match-form source)
+  "Match MATCH-FORM against SOURCE.
+
+MATCH-FORM is a vector.  Each element of MATCH-FORM is either a
+symbol, which gets bound to the respective value in source or
+another match form which gets destructured recursively.
+
+SOURCE is a vector.
+
+If the MATCH-FORM vector is shorter than SOURCE vector, only
+the (length MATCH-FORM) places are bound, the rest of the SOURCE
+is discarded."
+  (let ((i 0))
+    (-flatten-n 1 (--map
+                   (let ((m (aref match-form i)))
+                     (prog1 (cond
+                             ((and (symbolp m)
+                                   ;; do not match symbols starting with _
+                                   (not (eq (aref (symbol-name m) 0) ?_)))
+                              (list (list m `(aref ,source ,i))))
+                             (t (dash--match m `(aref ,source ,i))))
+                       (setq i (1+ i))))
+                   match-form))))
+
+(defun dash--match-kv (match-form source)
+  "Setup a kv matching environment and call the real matcher.
+
+kv can be any key-value store, such as plist, alist or hash-table."
+  (let ((s (make-symbol "--dash-source--")))
+    (cons (list s source) (dash--match-kv-1 (cdr match-form) s (car 
match-form)))))
+
+(defun dash--match-kv-1 (match-form source type)
+  "Match MATCH-FORM against SOURCE of type TYPE.
+
+MATCH-FORM is a proper list of the form (key1 place1 ... keyN
+placeN).  Each placeK is either a symbol, which gets bound to the
+value of keyK retrieved from the key-value store, or another
+match form which gets destructured recursively.
+
+SOURCE is a key-value store of type TYPE, which can be a plist,
+an alist or a hash table.
+
+TYPE is a token specifying the type of the key-value store.
+Valid values are &plist, &alist and &hash."
+  (-flatten-n 1 (-map
+                 (lambda (kv)
+                   (let* ((k (car kv))
+                          (v (cadr kv))
+                          (getter (cond
+                                   ((eq type '&plist)
+                                    `(plist-get ,source ,k))
+                                   ((eq type '&alist)
+                                    `(cdr (assoc ,k ,source)))
+                                   ((eq type '&hash)
+                                    `(gethash ,k ,source)))))
+                     (cond
+                      ((symbolp v)
+                       (list (list v getter)))
+                      (t (dash--match v getter)))))
+                 (-partition 2 match-form))))
+
+(defun dash--match-symbol (match-form source)
+  "Bind a symbol.
+
+This works just like `let', there is no destructuring."
+  (list (list match-form source)))
+
+(defun dash--match (match-form source)
+  "Match MATCH-FORM against SOURCE.
+
+This function tests the MATCH-FORM and dispatches to specific
+matchers based on the type of the expression.
+
+Key-value stores are disambiguated by placing a token &plist,
+&alist or &hash as a first item in the MATCH-FORM."
+  (cond
+   ((symbolp match-form)
+    (dash--match-symbol match-form source))
+   ((consp match-form)
+    (cond
+     ((memq (car match-form) '(&plist &alist &hash))
+      (dash--match-kv match-form source))
+     (t (dash--match-cons match-form source))))
+   ((vectorp match-form)
+    (dash--match-vector match-form source))))
+
+(defmacro -let* (varlist &rest body)
+  "Bind variables according to VARLIST then eval BODY.
+
+VARLIST is a list of lists of the form (PATTERN SOURCE).  Each
+PATTERN is matched against the SOURCE structurally.  SOURCE is
+only evaluated once for each PATTERN.
+
+Each SOURCE can refer to the symbols already bound by this
+VARLIST.  This is useful if you want to destructure SOURCE
+recursively but also want to name the intermediate structures.
+
+See `-let' for the list of all possible patterns."
+  (declare (debug ((&rest (sexp form)) body))
+           (indent 1))
+  (let ((bindings (--mapcat (dash--match (car it) (cadr it)) varlist)))
+    `(let* ,bindings
+       ,@body)))
+
+(defmacro -let (varlist &rest body)
+  "Bind variables according to VARLIST then eval BODY.
+
+VARLIST is a list of lists of the form (PATTERN SOURCE).  Each
+PATTERN is matched against the SOURCE \"structurally\".  SOURCE
+is only evaluated once for each PATTERN.  Each PATTERN is matched
+recursively, and can therefore contain sub-patterns which are
+matched against corresponding sub-expressions of SOURCE.
+
+All the SOURCEs are evalled before any symbols are
+bound (i.e. \"in parallel\").
+
+If VARLIST only contains one (PATTERN SOURCE) element, you can
+optionally specify it using a vector and discarding the
+outer-most parens.  Thus
+
+  (-let ((PATTERN SOURCE)) ..)
+
+becomes
+
+  (-let [PATTERN SOURCE] ..).
+
+`-let' uses a convention of not binding places (symbols) starting
+with _ whenever it's possible.  You can use this to skip over
+entries you don't care about.  However, this is not *always*
+possible (as a result of implementation) and these symbols might
+get bound to undefined values.
+
+Following is the overview of supported patterns.  Remember that
+patterns can be matched recursively, so every a, b, aK in the
+following can be a matching construct and not necessarily a
+symbol/variable.
+
+Symbol:
+
+  a - bind the SOURCE to A.  This is just like regular `let'.
+
+Conses and lists:
+
+  (a) - bind `car' of cons/list to A
+
+  (a . b) - bind car of cons to A and `cdr' to B
+
+  (a b) - bind car of list to A and `cadr' to B
+
+  (a1 a2 a3  ...) - bind 0th car of list to A1, 1st to A2, 2nd to A3 ...
+
+  (a1 a2 a3 ... aN . rest) - as above, but bind the Nth cdr to REST.
+
+Vectors:
+
+  [a] - bind 0th element of a non-list sequence to A (works with
+        vectors, strings, bit arrays...)
+
+  [a1 a2 a3 ...] - bind 0th element of non-list sequence to A0, 1st to
+                   A1, 2nd to A2, ...
+                   If the PATTERN is shorter than SOURCE, the values at
+                   places not in PATTERN are ignored.
+                   If the PATTERN is longer than SOURCE, an `error' is
+                   thrown.
+
+Key/value stores:
+
+  (&plist key0 a0 ... keyN aN) - bind value mapped by keyK in the
+                                 SOURCE plist to aK.  If the
+                                 value is not found, aK is nil.
+
+  (&alist key0 a0 ... keyN aN) - bind value mapped by keyK in the
+                                 SOURCE alist to aK.  If the
+                                 value is not found, aK is nil.
+
+  (&hash key0 a0 ... keyN aN) - bind value mapped by keyK in the
+                                SOURCE hash table to aK.  If the
+                                value is not found, aK is nil."
+  (declare (debug ((&rest (sexp form)) body))
+           (indent 1))
+  (if (vectorp varlist)
+      `(let* ,(dash--match (aref varlist 0) (aref varlist 1))
+         ,@body)
+    (let* ((inputs (--map-indexed (list (make-symbol (format "input%d" 
it-index)) (cadr it)) varlist))
+           (new-varlist (--map (list (caar it) (cadr it)) (-zip varlist 
inputs))))
+      `(let ,inputs
+         (-let* ,new-varlist ,@body)))))
+
 (defun -distinct (list)
   "Return a new list with all duplicates removed.
 The test for equality is done with `equal',
@@ -1719,6 +1949,8 @@ structure such as plist or alist."
                              "-if-let"
                              "-if-let*"
                              "--if-let"
+                             "-let*"
+                             "-let"
                              "-distinct"
                              "-uniq"
                              "-union"
diff --git a/dev/examples.el b/dev/examples.el
index 9d8c9ea..fa9fdd5 100644
--- a/dev/examples.el
+++ b/dev/examples.el
@@ -86,7 +86,10 @@ new list."
     (-slice '(1 2 3 4 5 6) 1 4 2) => '(2 4)
     (-slice '(1 2 3 4 5 6) 2 6 3) => '(3 6)
     (-slice '(1 2 3 4 5 6) 2 -1 2) => '(3 5)
+    (-slice '(1 2 3 4 5 6) 0 -4 2) => '(1)
     (-slice '(1 2 3 4 5 6) -4 -1 2) => '(3 5)
+    (-slice '(1 2 3 4 5 6) -4 5 2) => '(3 5)
+    (-slice '(1 2 3 4 5 6) -3 5 1) => '(4 5)
     (-slice '(1 2 3 4 5 6) 1 2 10) => '(2))
 
   (defexamples -take
@@ -688,7 +691,68 @@ new list."
 
   (defexamples -if-let*
     (-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"))
+    (-if-let* ((x 5) (y nil) (z 7)) (+ x y z) "foo") => "foo")
+
+  (defexamples -let
+    (-let (([a (b c) d] [1 (2 3) 4])) (list a b c d)) => '(1 2 3 4)
+    (-let [(a b c . d) (list 1 2 3 4 5 6)] (list a b c d)) => '(1 2 3 (4 5 6))
+    (-let [(&plist :foo foo :bar bar) (list :baz 3 :foo 1 :qux 4 :bar 2)] 
(list foo bar)) => '(1 2)
+    (let ((a (list 1 2 3))
+          (b (list 'a 'b 'c)))
+      (-let (((a . b) a)
+             ((c . d) b))
+        (list a b c d))) => '(1 (2 3) a (b c))
+    (-let ((a "foo") (b "bar")) (list a b)) => '("foo" "bar")
+    (-let [foo (list 1 2 3)] foo) => '(1 2 3)
+    (-let [(&plist :foo foo :bar bar) (list :foo 1 :bar 2)] (list foo bar)) => 
'(1 2)
+    (-let [(&plist :foo (a b) :bar c) (list :foo (list 1 2) :bar 3)] (list a b 
c)) => '(1 2 3)
+    ;; nil value in plist means subsequent cons matches are nil, because
+    ;; (car nil) => nil
+    (-let [(&plist :foo (a b)) (list :bar 1)] (list a b)) => '(nil nil)
+    (-let [(&plist :foo (&plist :baz baz) :bar bar)
+           (list :foo (list 1 2 :baz 2 :bar 4) :bar 3)]
+      (list baz bar)) => '(2 3)
+    (-let [(_ (&plist :level level :title title))
+           (list 'paragraph (list :title "foo" :level 2))]
+      (list level title)) => '(2 "foo")
+    (-let [(&alist :foo (&plist 'face face 'invisible inv) :bar bar)
+           (list (cons :bar 2) (cons :foo (list 'face 'foo-face 'invisible 
t)))]
+      (list bar face inv)) => '(2 foo-face t)
+    (-let [(a (b c) d) (list 1 (list 2 3) 4 5 6)] (list a b c d)) => '(1 2 3 4)
+    (-let [[a _ c] [1 2 3 4]] (list a c)) => '(1 3)
+    (-let [[a b c] (string ?f ?o ?b ?a ?r)] (list a b c)) => '(?f ?o ?b)
+    (-let [[a (b [c]) d] [1 (2 [3 4]) 5 6]] (list a b c d)) => '(1 2 3 5)
+    (-let [(a b c d) (list 1 2 3 4 5 6)] (list a b c d)) => '(1 2 3 4)
+    ;; d is bound to nil. I don't think we want to error in such a case.
+    ;; After all (car nil) => nil
+    (-let [(a b c d) (list 1 2 3)] (list a b c d)) => '(1 2 3 nil)
+    (-let [[a b c] [1 2 3 4]] (list a b c)) => '(1 2 3)
+    ;; here we error, because "vectors" are rigit, immutable structures,
+    ;; so we should know how many elements there are
+    (condition-case nil
+        (-let [[a b c d] [1 2 3]]
+          (progn
+            (list a b c d)
+            (error "previous call should fail.")))
+      (error t)) => t
+    (-let [(a . (b . c)) (cons 1 (cons 2 3))] (list a b c)) => '(1 2 3))
+
+  (defexamples -let*
+    (-let* (((a . b) (cons 1 2))
+            ((c . d) (cons 3 4)))
+      (list a b c d)) => '(1 2 3 4)
+    (-let* (((a . b) (cons 1 (cons 2 3)))
+            ((c . d) b))
+      (list a b c d)) => '(1 (2 . 3) 2 3)
+    (-let* (((&alist "foo" foo "bar" bar) (list (cons "foo" 1) (cons "bar" 
(list 'a 'b 'c))))
+            ((a b c) bar))
+      (list foo a b c bar)) => '(1 a b c (a b c))
+    (let ((a (list 1 2 3))
+          (b (list 'a 'b 'c)))
+      (-let* (((a . b) a)
+              ((c . d) b)) ;; b here comes from above binding
+        (list a b c d))) => '(1 (2 3) 2 (3))
+    (-let* ((a "foo") (b a)) (list a b)) => '("foo" "foo")))
 
 (def-example-group "Side-effects"
   "Functions iterating over lists for side-effect only."