branch: externals/dash
commit 0fc5d7394ab222bcc765741f4a92a5d69efce192
Author: Matus Goljer <[email protected]>
Commit: Matus Goljer <[email protected]>
[-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))
