[elpa] externals/m-buffer a8d5ce9755 050/115: Performance enhancements to subtract.

[ELPA Syncer]

branch: externals/m-buffer
commit a8d5ce975556101992c486b257f650f90a7fcee9
Author: Phillip Lord <phillip.lord@newcastle.ac.uk>
Commit: Phillip Lord <phillip.lord@newcastle.ac.uk>

    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