branch: externals/m-buffer
commit a8d5ce975556101992c486b257f650f90a7fcee9
Author: Phillip Lord <[email protected]>
Commit: Phillip Lord <[email protected]>
Performance enhancements to subtract.
---
m-buffer.el | 54 ++++++++++++++++++++++++++++++++++-----------------
test/m-buffer-test.el | 25 +++++++++++++++++++++++-
2 files changed, 60 insertions(+), 19 deletions(-)
diff --git a/m-buffer.el b/m-buffer.el
index 7ca2dafab6..a94e557426 100644
--- a/m-buffer.el
+++ b/m-buffer.el
@@ -39,8 +39,8 @@
;;
;; This library is early release at the moment. I write it become I got fed up
;; with writing (while (re-search-forward) do-stuff) forms. I found that it
-;; considerably simplified writing `linked-buffer'. I make no guarantees about
-;; the API at the moment.
+;; considerably simplified writing `linked-buffer'. The API is beginning to
+;; stablize now and should not undergo major changes.
;;; Code:
(require 'dash)
@@ -187,12 +187,12 @@ This is an internal function."
(if (plist-member pargs :case-fold-search)
(plist-get pargs :case-fold-search)
:default))
-
+
;; numeric
(numeric
(plist-get pargs :numeric)))
-
+
(list buffer regexp begin end post-match widen cfs numeric)))
(defun m-buffer-ensure-match (&rest match)
@@ -302,9 +302,13 @@ function. See `m-buffer-nil-marker' for details."
Matches are equal if they match the same region; subgroups are
ignored."
;; can we speed this up by not making subsets?
- (equal
- (-take 2 m)
- (-take 2 n)))
+ (and
+ (equal
+ (car m)
+ (car n))
+ (equal
+ (cadr m)
+ (cadr n))))
(defun m-buffer-match-subtract (m n)
"Remove from M any matches in N.
@@ -324,18 +328,32 @@ runs faster but has some restrictions."
"Remove from M any matches in N.
Both M and N must be fully ordered, and any element in N must be
in M."
- ;; copy n
- (let ((n-eaten n))
- (-remove
- (lambda (o)
- ;; check the first element of n
- (when (m-buffer-match-equal
+ (if n
+ (let ((n-eaten n))
+ (-remove
+ (lambda (o)
+ (cond
+ ;; we have a match so throw away the first element of n-eaten
+ ;; which we won't need again.
+ ((m-buffer-match-equal
(car n-eaten) o)
- ;; we have a match so throw away the first element of n-eaten
- ;; which we won't need again.
- (setq n-eaten (-drop 1 n-eaten))
- t))
- m)))
+ (progn
+ (setq n-eaten (-drop 1 n-eaten))
+ t))
+ ;; we should discard also if n-eaten 1 is less than o because, both
+ ;; are sorted, so we will never match
+ ((<
+ ;; first half of the first match in n-eaten
+ (caar n-eaten)
+ ;; first half of match
+ (car o))
+ (progn
+ (setq n-eaten (-drop 1 n-eaten))
+ t))))
+ m))
+ m))
+
+
;; marker/position utility functions
(defun m-buffer-nil-marker (markers)
diff --git a/test/m-buffer-test.el b/test/m-buffer-test.el
index 0dd7b5aa86..3253ce2505 100644
--- a/test/m-buffer-test.el
+++ b/test/m-buffer-test.el
@@ -321,7 +321,21 @@
(m-buffer-match
(current-buffer) "sentence")))))))
-(ert-deftest exact-substract ()
+(ert-deftest exact-subtract ()
+ (should
+ (equal
+ '((1 1)(2 2)(3 3))
+ (m-buffer-match-exact-subtract
+ '((0 0) (1 1) (2 2) (3 3) (4 4))
+ '((0 0) (4 4)))))
+
+ (should
+ (equal
+ '((1 1)(2 2)(3 3))
+ (m-buffer-match-exact-subtract
+ '((0 0) (1 1) (2 2) (3 3) (4 4))
+ '((-1 -1) (4 4)))))
+
(should
(equal
'((1 6) (17 23) (34 39))
@@ -334,5 +348,14 @@
(m-buffer-match
(current-buffer) "sentence")))))))
+(ert-deftest exact-subtract-with-nil ()
+ (should
+ (equal
+ '((1 1))
+ (m-buffer-match-exact-subtract
+ '((1 1))
+ nil))))
+
+
;;; m-buffer-test.el ends here
