[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/dash f939201 347/426: [-let] Optimize shifting/binding
From: |
Phillip Lord |
Subject: |
[elpa] externals/dash f939201 347/426: [-let] Optimize shifting/binding of unused _ places |
Date: |
Tue, 04 Aug 2015 19:38:47 +0000 |
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))
- [elpa] externals/dash 5637bd6 322/426: Add alias from -find to -first, (continued)
- [elpa] externals/dash 5637bd6 322/426: Add alias from -find to -first, Phillip Lord, 2015/08/04
- [elpa] externals/dash a4be872 338/426: Add `-let` and `-let*`, Phillip Lord, 2015/08/04
- [elpa] externals/dash 947ffda 341/426: Add support for &rest match for non-list sequences (like . for improper lists), Phillip Lord, 2015/08/04
- [elpa] externals/dash 9065e1b 344/426: [-let] Final cdr shift optimization, Phillip Lord, 2015/08/04
- [elpa] externals/dash d37947a 332/426: Add -tree-seq, Phillip Lord, 2015/08/04
- [elpa] externals/dash 51a0c9f 350/426: [-let] Fix expansion of _ symbols in vector matcher, Phillip Lord, 2015/08/04
- [elpa] externals/dash 8f9fc41 340/426: Add support for multiple input arguments to -lambda, Phillip Lord, 2015/08/04
- [elpa] externals/dash 7f2b3c7 343/426: [-lambda] test all match-forms before converting to regular lambda, Phillip Lord, 2015/08/04
- [elpa] externals/dash 6f81492 346/426: [-lambda] Better error-handling, Phillip Lord, 2015/08/04
- [elpa] externals/dash 6f0bb7d 348/426: [-let] Fix dynamic scoping issue, Phillip Lord, 2015/08/04
- [elpa] externals/dash f939201 347/426: [-let] Optimize shifting/binding of unused _ places,
Phillip Lord <=
- [elpa] externals/dash c1d555b 355/426: [-let] Optimize single-binding of vectors and kv, Phillip Lord, 2015/08/04
- [elpa] externals/dash edb1e31 356/426: [-let] Add more tests, Phillip Lord, 2015/08/04
- [elpa] externals/dash 9ec1a02 354/426: [-let] Abstract the _ test into a function, Phillip Lord, 2015/08/04
- [elpa] externals/dash 31f321a 358/426: Release 2.9.0, Phillip Lord, 2015/08/04
- [elpa] externals/dash 40849a7 357/426: [-let] Remove stale comment, Phillip Lord, 2015/08/04
- [elpa] externals/dash 2626840 336/426: Add -fixfn, Phillip Lord, 2015/08/04
- [elpa] externals/dash 2436bf8 361/426: Add debug declaration on -lambda, Phillip Lord, 2015/08/04
- [elpa] externals/dash 4d67b25 345/426: [-let] Do not reinvent `pop', Phillip Lord, 2015/08/04
- [elpa] externals/dash f7664c6 352/426: [-let] Add &keys support for cons matcher, Phillip Lord, 2015/08/04
- [elpa] externals/dash 4b63be1 362/426: Declare --mapcat macro before using it. #102, Phillip Lord, 2015/08/04