Implement splay tree for overlay storage/lookup

This makes repeated overlay lookups during incremental parsing or buffer
analysis more efficient.

benchmarks/parse-file.el

@@ -1,13 +1,11 @@
 
 (require 'phpinspect-parser)
 
-
 (defun phpinspect-parse-current-buffer ()
   (phpinspect-parse-buffer-until-point
    (current-buffer)
    (point-max)))
 
-
 (let ((here (file-name-directory (or load-file-name buffer-file-name))))
 
   (with-temp-buffer
@@ -23,16 +21,23 @@
       (phpinspect-with-parse-context (phpinspect-make-pctx :incremental t :bmap bmap)
         (benchmark 1 '(phpinspect-parse-current-buffer)))
 
+      (garbage-collect)
+
       (message "Incremental parse (no edits):")
       (phpinspect-with-parse-context (phpinspect-make-pctx :incremental t :bmap bmap2 :previous-bmap bmap :edtrack (phpinspect-make-edtrack))
         (benchmark 1 '(phpinspect-parse-current-buffer)))
 
+      (garbage-collect)
+
       (message "Incremental parse repeat (no edits):")
       (phpinspect-with-parse-context (phpinspect-make-pctx :incremental t :previous-bmap bmap2 :edtrack (phpinspect-make-edtrack))
         (benchmark 1 '(phpinspect-parse-current-buffer)))
 
+      (garbage-collect)
+
       (let ((edtrack (phpinspect-make-edtrack))
-            (bmap (phpinspect-make-bmap)))
+            (bmap (phpinspect-make-bmap))
+            (bmap-after (phpinspect-make-bmap)))
         ;; Fresh
         (phpinspect-with-parse-context (phpinspect-make-pctx :incremental t :bmap bmap)
           (phpinspect-parse-current-buffer))
@@ -42,13 +47,40 @@
         (goto-char 9062)
         (delete-backward-char 1)
 
+        (garbage-collect)
+
         (phpinspect-edtrack-register-edit edtrack 9061 9061 1)
-        (phpinspect-with-parse-context (phpinspect-make-pctx :incremental t :previous-bmap bmap :edtrack edtrack)
-          (benchmark 1 '(phpinspect-parse-current-buffer)))))
+        (phpinspect-with-parse-context (phpinspect-make-pctx :bmap bmap-after :incremental t :previous-bmap bmap :edtrack edtrack)
+          (benchmark 1 '(phpinspect-parse-current-buffer)))
+
+        (phpinspect-edtrack-clear edtrack)
+        (insert "{")
+
+        (phpinspect-edtrack-register-edit edtrack 9061 9062 0)
+        ;; Mark region as edit without length deta
+        (phpinspect-edtrack-register-edit edtrack 19552 19562 10)
+
+        (garbage-collect)
+
+        ;;(profiler-start 'cpu+mem)
+        (message "Incremental parse after 2 more edits:")
+        (phpinspect-with-parse-context (phpinspect-make-pctx :incremental t :previous-bmap bmap-after :edtrack edtrack)
+          (benchmark 1 '(phpinspect-parse-current-buffer)))
+
+        ;; (save-current-buffer
+        ;;   (profiler-stop)
+        ;;   (profiler-report)
+        ;;   (profiler-report-write-profile (concat here "/profile.txt")))
+        )))
+
+  (with-temp-buffer
+    (insert-file-contents (concat here "/Response.php"))
 
+    (garbage-collect)
     (message "Bare (no token reuse) parse (warmup):")
     (benchmark 1 '(phpinspect-parse-current-buffer))
 
 
+    (garbage-collect)
     (message "Bare (no token reuse) parse:")
     (benchmark 1 '(phpinspect-parse-current-buffer))))

phpinspect-bmap.el

@@ -23,6 +23,8 @@
 
 ;;; Code:
 
+(require 'phpinspect-splayt)
+
 (cl-defstruct (phpinspect-bmap (:constructor phpinspect-make-bmap))
   (starts (make-hash-table :test #'eql
                            :size (floor (/ (point-max) 4))
@@ -35,8 +37,8 @@
                            :rehash-size 1.5))
   (token-stack nil
                :type list)
-  (overlays nil
-            :type list)
+  (overlays (phpinspect-make-splayt)
+            :type phpinspect-splayt)
   (last-token-start nil
                      :type integer))
 
@@ -288,10 +290,9 @@
       (gethash point (phpinspect-bmap-ends bmap)))))
 
 (defsubst phpinspect-bmap-overlay-at-point (bmap point)
-  (catch 'found
-    (dolist (overlay (phpinspect-bmap-overlays bmap))
-      (when (phpinspect-overlay-overlaps-point overlay point)
-        (throw 'found overlay)))))
+  (let ((overlay (phpinspect-splayt-find (phpinspect-bmap-overlays bmap) point #'<= #'<= #'<=)))
+    (when (and overlay (phpinspect-overlay-overlaps-point overlay point))
+      overlay)))
 
 (defsubst phpinspect-bmap-tokens-overlapping (bmap point)
   (let ((tokens))
@@ -311,7 +312,7 @@
   (or (gethash token (phpinspect-bmap-meta bmap))
       (let ((found?))
         (catch 'found
-          (dolist (overlay (phpinspect-bmap-overlays bmap))
+          (phpinspect-splayt-traverse (overlay (phpinspect-bmap-overlays bmap))
             (when (setq found? (phpinspect-bmap-token-meta overlay token))
               (throw 'found found?)))))))
 
@@ -347,27 +348,9 @@ giving up. If not provided, this is 100."
   (let* ((overlays (phpinspect-bmap-overlays bmap))
          (start (+ (phpinspect-meta-start token-meta) pos-delta))
          (end (+ (phpinspect-meta-end token-meta) pos-delta))
-         (overlay `(overlay ,start ,end ,pos-delta ,bmap-overlay ,token-meta))
-         (before))
+         (overlay `(overlay ,start ,end ,pos-delta ,bmap-overlay ,token-meta)))
     (phpinspect-bmap-register bmap start end (phpinspect-meta-token token-meta) whitespace-before overlay)
-
-    (if overlays
-        (progn
-          (catch 'break
-            (while (setq before (car overlays))
-              (if (> (phpinspect-overlay-start overlay) (phpinspect-overlay-end before))
-                  (throw 'break nil)
-                (setq overlays (cdr overlays)))))
-
-          (if (and before (cdr overlays))
-              ;; Append after
-              (progn
-                (setcdr overlays (cons overlay (cdr overlays))))
-            ;; Append at end of overlay list
-            (nconc (phpinspect-bmap-overlays bmap) (list overlay))))
-
-      ;; No exising overlays, overwrite
-      (push overlay (phpinspect-bmap-overlays bmap)))))
+    (phpinspect-splayt-insert (phpinspect-bmap-overlays bmap) (phpinspect-overlay-end overlay) overlay)))
 
 (defun phpinspect-bmap-make-location-resolver (bmap)
   (lambda (token)

phpinspect-splayt.el

@@ -0,0 +1,281 @@
+;;; phpinspect-splayt.el --- A Splay Tree Implementation  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021  Free Software Foundation, Inc
+
+;; Author: Hugo Thunnissen <devel@hugot.nl>
+;; Keywords: php, languages, tools, convenience
+;; Version: 0
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; A splay tree implementation exclusively using `cons' and `list' data
+;; structures with the aim to have as low a memory footprint as possible.
+;;
+;; Important functions:
+;; - `phpinspect-splayt-insert'
+;; - `phpinspect-splayt-find'
+;; - `phpinspect-splayt-traverse'
+
+;;; Code:
+
+(defsubst phpinspect-make-splayt-node (key value &optional left right)
+  (cons (cons key value) (cons left right)))
+
+(defsubst phpinspect-splayt-node-left (node)
+  (cadr node))
+
+(defsubst phpinspect-splayt-node-right (node)
+  (cddr node))
+
+(defsubst phpinspect-splayt-node-key (node)
+  (caar node))
+
+(defsubst phpinspect-splayt-node-value (node)
+  (cdar node))
+
+(gv-define-setter phpinspect-splayt-node-left (left node) `(setcar (cdr ,node) ,left))
+(gv-define-setter phpinspect-splayt-node-right (right node) `(setcdr (cdr ,node) ,right))
+(gv-define-setter phpinspect-splayt-node-key (key node) `(setcar (car ,node) ,value))
+(gv-define-setter phpinspect-splayt-node-value (value node) `(setcdr (car ,node) ,value))
+
+(defsubst phpinspect-splayt-node-update-parent (node parent new-val)
+  (if (eq node (phpinspect-splayt-node-left parent))
+      (setf (phpinspect-splayt-node-left parent) new-val)
+    (setf (phpinspect-splayt-node-right parent) new-val)))
+
+(defsubst phpinspect-make-splayt (&optional root-node)
+  (cons root-node nil))
+
+(defsubst phpinspect-splayt-root-node (splayt)
+  (car splayt))
+
+(gv-define-setter phpinspect-splayt-root-node (node splayt) `(setcar ,splayt ,node))
+
+(defsubst phpinspect-splayt-node-rotate-right (node &optional parent splayt)
+  (let* ((left (phpinspect-splayt-node-left node))
+         (left-right (phpinspect-splayt-node-right left)))
+    (setf (phpinspect-splayt-node-right left) node)
+    (setf (phpinspect-splayt-node-left node) left-right)
+
+    (when (and splayt (eq node (phpinspect-splayt-root-node splayt)))
+      (setf (phpinspect-splayt-root-node splayt) left))
+
+    (when parent
+      (phpinspect-splayt-node-update-parent node parent left))))
+
+(defsubst phpinspect-splayt-node-rotate-left (node &optional parent splayt)
+  (let* ((right (phpinspect-splayt-node-right node))
+         (right-left (phpinspect-splayt-node-left right)))
+    (setf (phpinspect-splayt-node-left right) node)
+    (setf (phpinspect-splayt-node-right node) right-left)
+
+    (when (and splayt (eq node (phpinspect-splayt-root-node splayt)))
+      (setf (phpinspect-splayt-root-node splayt) right))
+
+    (when parent
+      (phpinspect-splayt-node-update-parent node parent right))))
+
+(defsubst phpinspect-make-splayt-nav (splayt &optional current-node parents)
+  (cons splayt (cons (or current-node (phpinspect-splayt-root-node splayt))
+                     parents)))
+
+(defsubst phpinspect-splayt-nav-splayt (nav)
+  (car nav))
+
+(defsubst phpinspect-splayt-nav-current (nav)
+  (cadr nav))
+
+(defsubst phpinspect-splayt-nav-parents (nav)
+  (cddr nav))
+
+(gv-define-setter phpinspect-splayt-nav-current (node nav) `(setcar (cdr ,nav) ,node))
+(gv-define-setter phpinspect-splayt-nav-parents (parents nav) `(setcdr (cdr ,nav) ,parents))
+
+(defsubst phpinspect-splayt-nav-right (nav)
+  (push (phpinspect-splayt-nav-current nav) (phpinspect-splayt-nav-parents nav))
+  (setf (phpinspect-splayt-nav-current nav)
+        (phpinspect-splayt-node-right (phpinspect-splayt-nav-current nav))))
+
+(defsubst phpinspect-splayt-nav-left (nav)
+  (push (phpinspect-splayt-nav-current nav) (phpinspect-splayt-nav-parents nav))
+  (setf (phpinspect-splayt-nav-current nav)
+        (phpinspect-splayt-node-left (phpinspect-splayt-nav-current nav))))
+
+(defsubst phpinspect-splayt-nav-has-left-p (nav)
+  (phpinspect-splayt-node-left (phpinspect-splayt-nav-current nav)))
+
+(defsubst phpinspect-splayt-nav-has-right-p (nav)
+  (phpinspect-splayt-node-right (phpinspect-splayt-nav-current nav)))
+
+(defsubst phpinspect-splayt-nav-up (nav)
+  (setf (phpinspect-splayt-nav-current nav)
+        (pop (phpinspect-splayt-nav-parents nav))))
+
+(defsubst phpinspect-splayt-nav-current-value (nav)
+  (phpinspect-splayt-node-value (phpinspect-splayt-nav-current nav)))
+
+(defsubst phpinspect-splayt-nav-current-key (nav)
+  (phpinspect-splayt-node-key (phpinspect-splayt-nav-current nav)))
+
+(defsubst phpinspect-splayt-insert (splayt key value)
+  (phpinspect-splayt-insert-node splayt (phpinspect-make-splayt-node key value)))
+
+(defsubst phpinspect-splay (splayt node parents)
+  (let (grandparent great-grandparent)
+    (while parents
+      (setq parent (pop parents))
+      (setq grandparent (pop parents))
+
+      (if grandparent
+          (cond
+           ;; Zig-Zig rotation
+           ((and (eq parent (phpinspect-splayt-node-left grandparent))
+                 (eq node (phpinspect-splayt-node-left parent)))
+            (phpinspect-splayt-node-rotate-right grandparent (car parents) splayt)
+            (phpinspect-splayt-node-rotate-right parent (car parents) splayt))
+
+           ;; Zag-Zag rotation
+           ((and (eq parent (phpinspect-splayt-node-right grandparent))
+                 (eq node (phpinspect-splayt-node-right parent)))
+            (phpinspect-splayt-node-rotate-left grandparent (car parents) splayt)
+            (phpinspect-splayt-node-rotate-left parent (car parents) splayt))
+
+           ;; Zig-Zag rotation
+           ((and (eq parent (phpinspect-splayt-node-right grandparent))
+                 (eq node (phpinspect-splayt-node-left parent)))
+            (phpinspect-splayt-node-rotate-right parent grandparent splayt)
+            (phpinspect-splayt-node-rotate-left grandparent (car parents) splayt))
+
+           ;; Zag-Zig rotation
+           ((and (eq parent (phpinspect-splayt-node-left grandparent))
+                 (eq node (phpinspect-splayt-node-right parent)))
+            (phpinspect-splayt-node-rotate-left parent grandparent splayt)
+            (phpinspect-splayt-node-rotate-right grandparent (car parents) splayt))
+           (t
+            (error "Failed in determining rotation strategy")))
+        ;; Else
+        (if (eq node (phpinspect-splayt-node-left parent))
+            (phpinspect-splayt-node-rotate-right parent (car parents) splayt)
+          (phpinspect-splayt-node-rotate-left parent (car parents) splayt))))))
+
+(defsubst phpinspect-splayt-insert-node (splayt node)
+  (if (not (phpinspect-splayt-root-node splayt))
+      (setf (phpinspect-splayt-root-node splayt) node)
+
+    ;; Else
+    (let ((nav (phpinspect-make-splayt-nav splayt)))
+      (catch 'break
+        (while t
+          (if (< (phpinspect-splayt-node-key node)
+                 (phpinspect-splayt-nav-current-key nav))
+              (if (phpinspect-splayt-nav-has-left-p nav)
+                  (phpinspect-splayt-nav-left nav)
+                (setf (phpinspect-splayt-node-left (phpinspect-splayt-nav-current nav))
+                      node)
+                (throw 'break nil))
+
+            ;; Else
+            (if (phpinspect-splayt-nav-has-right-p nav)
+                (phpinspect-splayt-nav-right nav)
+              (setf (phpinspect-splayt-node-right (phpinspect-splayt-nav-current nav))
+                    node)
+              (throw 'break nil))))))))
+
+(defmacro phpinspect-splayt-traverse (place-and-splayt &rest body)
+  "Traverse splay tree in cadr of PLACE-AND-SPLAYT, executing BODY.
+
+The car of PLACE-AND-SPLAYT is assigned the value of each node.
+
+Traversal is breadth-first to take advantage of the splay trees
+main benefit: the most accessed interval of keys is likely to be
+near the top of the tee."
+  (declare (indent 1))
+  (let ((place (car place-and-splayt))
+        (current-sym (gensym))
+        (splayt-sym (gensym))
+        (stack-sym (gensym))
+        (queue-sym (gensym))
+        (reverse-sym (gensym))
+        (size-sym (gensym)))
+    `(let* ((,splayt-sym ,(cadr place-and-splayt))
+            ;; Make place locally scoped variable if a symbol
+            (,queue-sym (list (phpinspect-splayt-root-node ,splayt-sym)))
+            (,reverse-sym t)
+            ,size-sym
+            ,stack-sym
+            ,(if (symbolp place) place (gensym)))
+
+       (while ,queue-sym
+         (setq ,size-sym (length ,queue-sym))
+
+         (while (> ,size-sym 0)
+           (setq ,current-sym (car (last ,queue-sym))
+                 ,queue-sym (butlast ,queue-sym))
+
+           (if ,reverse-sym
+               (push ,current-sym ,stack-sym)
+             (setf ,place (phpinspect-splayt-node-value ,current-sym))
+             ,@body)
+
+           (when (phpinspect-splayt-node-right ,current-sym)
+             (setq ,queue-sym (nconc ,queue-sym (list (phpinspect-splayt-node-right ,current-sym)))))
+
+           (when (phpinspect-splayt-node-left ,current-sym)
+             (setq ,queue-sym (nconc ,queue-sym (list (phpinspect-splayt-node-left ,current-sym)))))
+
+           (setq ,size-sym (- ,size-sym 1)))
+
+         (when ,reverse-sym
+           (while ,stack-sym
+             (setq ,current-sym (pop ,stack-sym))
+             (setf ,place (phpinspect-splayt-node-value ,current-sym))
+             ,@body))
+
+         (setq ,reverse-sym (not ,reverse-sym))))))
+
+(defsubst phpinspect-splayt-find (splayt key &optional navigator matcher continue-predicate)
+  (unless navigator (setq navigator #'<))
+  (unless matcher (setq matcher #'=))
+
+  (let ((nav (phpinspect-make-splayt-nav splayt))
+        current next)
+    (when (phpinspect-splayt-nav-current nav)
+      (catch 'found
+        (while t
+          (setq current (phpinspect-splayt-nav-current nav)
+                next nil)
+          (cond
+           ((funcall navigator key (phpinspect-splayt-nav-current-key nav))
+            (when (phpinspect-splayt-nav-has-left-p nav)
+              (phpinspect-splayt-nav-left nav)
+              (setq next (phpinspect-splayt-nav-current nav))))
+           (t
+            (when (phpinspect-splayt-nav-has-right-p nav)
+              (phpinspect-splayt-nav-right nav)
+              (setq next (phpinspect-splayt-nav-current nav)))))
+
+          (if (funcall matcher key (phpinspect-splayt-node-key current))
+              (when (or (not next)
+                        (not continue-predicate)
+                        (not (funcall continue-predicate key (phpinspect-splayt-node-key next))))
+                (phpinspect-splay
+                 splayt current
+                 (if next (cdr (phpinspect-splayt-nav-parents nav)) (phpinspect-splayt-nav-parents nav)))
+                (throw 'found (phpinspect-splayt-node-value current)))
+            (unless next
+              (throw 'found nil))))))))
+
+(provide 'phpinspect-splayt)

test/phpinspect-test.el

@@ -610,6 +610,7 @@ class Thing
 (load-file (concat phpinspect-test-directory "/test-bmap.el"))
 (load-file (concat phpinspect-test-directory "/test-edtrack.el"))
 (load-file (concat phpinspect-test-directory "/test-resolvecontext.el"))
+(load-file (concat phpinspect-test-directory "/test-splayt.el"))
 
 (provide 'phpinspect-test)
 ;;; phpinspect-test.el ends here

test/test-splayt.el

@@ -0,0 +1,86 @@
+;; test-splayt.el --- Unit tests for phpinspect.el  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Hugo Thunnissen <devel@hugot.nl>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'phpinspect-splayt)
+
+(ert-deftest phpinspect-splayt-node-rotate ()
+  (let* ((one (phpinspect-make-splayt-node 1 "one"))
+         (node (phpinspect-make-splayt-node
+                3 "three"
+                one
+                (phpinspect-make-splayt-node 4 "four"))))
+    (phpinspect-splayt-node-rotate-right node)
+    (should (equal (phpinspect-make-splayt-node
+                    1 "one" nil
+                    (phpinspect-make-splayt-node
+                     3 "three" nil (phpinspect-make-splayt-node 4 "four")))
+                   one))
+
+    (phpinspect-splayt-node-rotate-left node one)
+
+    (should (equal (phpinspect-make-splayt-node
+                    1 "one" nil
+                    (phpinspect-make-splayt-node
+                     4 "four" (phpinspect-make-splayt-node 3 "three")))
+                   one))))
+
+(ert-deftest phpinspect-splayt ()
+  (let ((tree (phpinspect-make-splayt)))
+    (phpinspect-splayt-insert tree 9 "nine")
+    (phpinspect-splayt-insert tree 3 "three")
+    (phpinspect-splayt-insert tree 11 "eleven")
+    (phpinspect-splayt-insert tree 8 "eight")
+    (phpinspect-splayt-insert tree 12 "twelve")
+    (phpinspect-splayt-insert tree 4 "four")
+    (phpinspect-splayt-insert tree 1 "one")
+
+
+    (should (string= "eight" (phpinspect-splayt-find tree 8)))
+    (should (string= "one" (phpinspect-splayt-find tree 1)))
+    (should (string= "three" (phpinspect-splayt-find tree 3)))
+    (should (string= "nine" (phpinspect-splayt-find tree 9)))
+    (should (string= "four" (phpinspect-splayt-find tree 4)))
+    (should (string= "twelve" (phpinspect-splayt-find tree 12)))
+    (should (string= "eleven" (phpinspect-splayt-find tree 11)))))
+
+(ert-deftest phpinspect-splayt-traverse ()
+  (let ((tree (phpinspect-make-splayt)))
+    (phpinspect-splayt-insert tree 9 "nine")
+    (phpinspect-splayt-insert tree 3 "three")
+    (phpinspect-splayt-insert tree 11 "eleven")
+    (phpinspect-splayt-insert tree 8 "eight")
+    (phpinspect-splayt-insert tree 12 "twelve")
+    (phpinspect-splayt-insert tree 4 "four")
+    (phpinspect-splayt-insert tree 1 "one")
+
+    (let ((expected (sort '("nine" "three" "eleven" "eight" "twelve" "four" "one") #'string-lessp))
+          (result))
+
+      (phpinspect-splayt-traverse (item tree)
+        (push item result))
+
+      (setq result (sort result #'string-lessp))
+
+      (should (equal expected result)))))