[elpa] externals/dash f939201 347/439: [-let] Optimize shifting/binding of unused _ places

[Phillip Lord]

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

    [-let] Optimize shifting/binding of unused _ places
---
 dash.el         |   79 ++++++++++++++++++++++++++++++++++++++++--------------
 dev/examples.el |   20 +++++++++++++-
 2 files changed, 77 insertions(+), 22 deletions(-)

diff --git a/dash.el b/dash.el
index 6434fa0..bd13d0c 100644
--- a/dash.el
+++ b/dash.el
@@ -1179,7 +1179,37 @@ otherwise do ELSE."
   (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)
+(defun dash--match-cons-skip-cdr (skip-cdr source)
+  "Helper function generating idiomatic shifting code."
+  (cond
+   ((= skip-cdr 0)
+    `(pop ,source))
+   (t
+    `(progn
+       (setq ,s (nthcdr ,skip-cdr ,s))
+       (pop ,s)))))
+
+(defun dash--match-cons-get-car (skip-cdr source)
+  "Helper function generating idiomatic code to get nth car."
+  (cond
+   ((= skip-cdr 0)
+    `(car ,source))
+   ((= skip-cdr 1)
+    `(cadr ,source))
+   (t
+    `(nth ,skip-cdr ,source))))
+
+(defun dash--match-cons-get-cdr (skip-cdr source)
+  "Helper function generating idiomatic code to get nth cdr."
+  (cond
+   ((= skip-cdr 0)
+    source)
+   ((= skip-cdr 1)
+    `(cdr ,source))
+   (t
+    `(nthcdr ,skip-cdr ,source))))
+
+(defun dash--match-cons-1 (match-form source &optional props)
   "Match MATCH-FORM against SOURCE.
 
 MATCH-FORM is a proper or improper list.  Each element of
@@ -1191,30 +1221,37 @@ 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)))
+  (let ((skip-cdr (or (plist-get props :skip-cdr) 0)))
     (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))
+     ((and (consp match-form)
+           (not (null match-form)))
       (cond
-       ((cdr match-form)
-        (cons (list (car match-form) `(pop ,s))
-              (dash--match-cons-1 (cdr match-form) s)))
+       ((symbolp (car match-form))
+        (cond
+         ((cdr match-form)
+          (cond
+           ((eq (aref (symbol-name (car match-form)) 0) ?_)
+            (dash--match-cons-1 (cdr match-form) s
+                                (plist-put props :skip-cdr (1+ skip-cdr))))
+           (t
+            (cons (list (car match-form) (dash--match-cons-skip-cdr skip-cdr 
s))
+                  (dash--match-cons-1 (cdr match-form) s)))))
+         ;; Last matching place, no need for shift
+         (t
+          (list (list (car match-form) (dash--match-cons-get-car skip-cdr 
s))))))
        (t
-        (list (list (car match-form) `(car ,s))))))
+        (cond
+         ((cdr match-form)
+          (-concat (dash--match (car match-form) (dash--match-cons-skip-cdr 
skip-cdr s))
+                   (dash--match-cons-1 (cdr match-form) s)))
+         ;; Last matching place, no need for shift
+         (t
+          (dash--match (car match-form) (dash--match-cons-get-car skip-cdr 
s)))))))
+     ((eq match-form nil)
+      nil)
+     ;; Handle improper lists.  Last matching place, no need for shift
      (t
-      (cond
-       ((cdr match-form)
-        (-concat (dash--match (car match-form) `(pop ,s))
-                 (dash--match-cons-1 (cdr match-form) s)))
-       (t
-        (dash--match (car match-form) `(car ,s)))))))
-   ((eq match-form nil)
-    nil)
-   (t
-    (list (list match-form s)))))
+      (list (list match-form (dash--match-cons-get-cdr skip-cdr s)))))))
 
 (defun dash--vector-tail (seq start)
   "Return the tail of SEQ starting at START."
diff --git a/dev/examples.el b/dev/examples.el
index de85ca3..99cc5dc 100644
--- a/dev/examples.el
+++ b/dev/examples.el
@@ -746,7 +746,25 @@ new list."
     (-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)) (list (list (list 1 2) 3) 4)] (list a b c)) => '(1 2 
(3)))
+    (-let [(((a b) . c)) (list (list (list 1 2) 3) 4)] (list a b c)) => '(1 2 
(3))
+    ;; cdr-skip optimization
+    (-let [(_ (_ (_ a))) (list 1 (list 2 (list 3 4)))] a) => 4
+    (-let [(_ (a)) (list 1 (list 2))] a) => 2
+    (-let [(_ _ _ a) (list 1 2 3 4 5)] a) => 4
+    (-let [(_ _ _ (a b)) (list 1 2 3 (list 4 5))] (list a b)) => '(4 5)
+    (-let [(_ a _ b) (list 1 2 3 4 5)] (list a b)) => '(2 4)
+    (-let [(_ (a b) _ c) (list 1 (list 2 3) 4 5)] (list a b c)) => '(2 3 5)
+    (-let [(_ (a b) _ . c) (list 1 (list 2 3) 4 5)] (list a b c)) => '(2 3 (5))
+    (-let [(_ (a b) _ (c d)) (list 1 (list 2 3) 4 (list 5 6))] (list a b c d)) 
=> '(2 3 5 6)
+    (-let [(_ (a b) _ _ _ (c d)) (list 1 (list 2 3) 4 5 6 (list 7 8))] (list a 
b c d)) => '(2 3 7 8)
+    (-let [(_ (a b) _ . (c d)) (list 1 (list 2 3) 4 5 6)] (list a b c d)) => 
'(2 3 5 6)
+    (-let [(_ (a b) _ _ _ [c d]) (list 1 (list 2 3) 4 5 6 (vector 7 8))] (list 
a b c d)) => '(2 3 7 8)
+    (-let [(_ [a b] _ _ _ [c d]) (list 1 (vector 2 3) 4 5 6 (vector 7 8))] 
(list a b c d)) => '(2 3 7 8)
+    (-let [(_ _ _ . a) (list 1 2 3 4 5)] a) => '(4 5)
+    (-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))
 
   (defexamples -let*
     (-let* (((a . b) (cons 1 2))