[elpa] externals/dash 0fc5d73 351/439: [-let] Make the cons matcher temp-bind as late as possible

[Phillip Lord]

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

    [-let] Make the cons matcher temp-bind as late as possible
---
 dash.el         |   28 +++++++++++++++++++++++-----
 dev/examples.el |   22 +++++++++++++++++++++-
 2 files changed, 44 insertions(+), 6 deletions(-)

diff --git a/dash.el b/dash.el
index c456b88..6fa8454 100644
--- a/dash.el
+++ b/dash.el
@@ -1174,11 +1174,6 @@ 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-skip-cdr (skip-cdr source)
   "Helper function generating idiomatic shifting code."
   (cond
@@ -1209,6 +1204,29 @@ otherwise do ELSE."
    (t
     `(nthcdr ,skip-cdr ,source))))
 
+(defun dash--match-cons (match-form source)
+  "Setup a cons matching environment and call the real matcher."
+  (let ((s (make-symbol "--dash-source--"))
+        (n 0)
+        (m match-form))
+    (while (and (consp m)
+                (symbolp (car m))
+                (eq (aref (symbol-name (car m)) 0) ?_))
+      (setq n (1+ n)) (!cdr m))
+    (cond
+     ;; handle improper lists
+     ((and (consp m)
+           (not (cdr m)))
+      (dash--match (car m) (dash--match-cons-get-car n source)))
+     ;; handle other special types
+     ((> n 0)
+      (dash--match m (dash--match-cons-get-cdr n source)))
+     ;; this is the only entry-point for dash--match-cons-1, that's
+     ;; why we can't simply use the above branch, it would produce
+     ;; infinite recursion
+     (t
+      (cons (list s source) (dash--match-cons-1 match-form s))))))
+
 (defun dash--match-cons-1 (match-form source &optional props)
   "Match MATCH-FORM against SOURCE.
 
diff --git a/dev/examples.el b/dev/examples.el
index ba09d1f..ee03c33 100644
--- a/dev/examples.el
+++ b/dev/examples.el
@@ -768,7 +768,27 @@ new list."
     (-let [(_ a _ _) (list 1 2 3 4 5)] a) => 2
     (-let [(_ . b) (cons 1 2)] b) => 2
     (-let [([a b c d] . e) (cons (vector 1 2 3 4) 5)] (list a b c d e)) => '(1 
2 3 4 5)
-    (-let [([a b c d] _ . e) (cons (vector 1 2 3 4) (cons 5 6))] (list a b c d 
e)) => '(1 2 3 4 6))
+    (-let [([a b c d] _ . e) (cons (vector 1 2 3 4) (cons 5 6))] (list a b c d 
e)) => '(1 2 3 4 6)
+    ;; late-binding optimization
+    (-let [(((a))) (list (list (list 1 2) 3) 4)] a) => 1
+    (-let [(((&plist :foo a :bar b))) (list (list (list :bar 1 :foo 2) 3) 4)] 
(list a b)) => '(2 1)
+    (-let [(((a b) c) d) (list (list (list 1 2) 3) 4)] (list a b c d)) => '(1 
2 3 4)
+    (-let [(((a b) c) . d) (list (list (list 1 2) 3) 4)] (list a b c d)) => 
'(1 2 3 (4))
+    (-let [(((a b) c)) (list (list (list 1 2) 3) 4)] (list a b c)) => '(1 2 3)
+    (-let [(a b c d) (list 1 2 3 4)] (list a b c d)) => '(1 2 3 4)
+    (-let [(a) (list 1 2 3 4)] (list a)) => '(1)
+    (-let [(_ a) (list 1 2 3 4)] (list a)) => '(2)
+    (-let [(_ _ a) (list 1 2 3 4)] (list a)) => '(3)
+    (-let [(_ _ . a) (list 1 2 3 4)] a) => '(3 4)
+    (-let [(_ _ [a b]) (list 1 2 (vector 3 4))] (list a b)) => '(3 4)
+    (-let [(a _ _ b) (list 1 2 3 4 5 6 7 8)] (list a b)) => '(1 4)
+    (-let [(_ _ a _ _ b) (list 1 2 3 4 5 6 7 8)] (list a b)) => '(3 6)
+    (-let [(_ _ a _ _ . b) (list 1 2 3 4 5 6 7 8)] (cons a b)) => '(3 6 7 8)
+    (-let [(_ a _ b) (list 1 2 3 4)] (list a b)) => '(2 4)
+    (-let [(a b c (d e)) (list 1 2 3 (list 4 5))] (list a b c d e)) => '(1 2 3 
4 5)
+    (-let [(_ _ (_ _ (_ _ a))) (list 1 2 (list 3 4 (list 5 6 7)))] a) => 7
+    (-let [(_ (_ (_ a))) (list 1 (list 2 (list 3 4)))] a) => 4
+    (-let [(_ _ . (&plist :foo a :bar b)) (list 1 2 :bar 2 :foo 1)] (list a 
b)) => '(1 2))
 
   (defexamples -let*
     (-let* (((a . b) (cons 1 2))