branch: externals/phpinspect
commit e270729e14ff20dcab728d0830c52e0cc13168e9
Author: Hugo Thunnissen <de...@hugot.nl>
Commit: Hugo Thunnissen <de...@hugot.nl>
Implement splay tree for overlay storage/lookup
This makes repeated overlay lookups during incremental parsing or buffer
analysis more efficient.
---
benchmarks/parse-file.el | 42 ++++++-
phpinspect-bmap.el | 37 ++-----
phpinspect-splayt.el | 281 +++++++++++++++++++++++++++++++++++++++++++++++
test/phpinspect-test.el | 1 +
test/test-splayt.el | 86 +++++++++++++++
5 files changed, 415 insertions(+), 32 deletions(-)
diff --git a/benchmarks/parse-file.el b/benchmarks/parse-file.el
index 9af0171e45..c2f05b2b25 100644
--- a/benchmarks/parse-file.el
+++ b/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))))
diff --git a/phpinspect-bmap.el b/phpinspect-bmap.el
index cc8fe8c17a..1170def7be 100644
--- a/phpinspect-bmap.el
+++ b/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)
diff --git a/phpinspect-splayt.el b/phpinspect-splayt.el
new file mode 100644
index 0000000000..fa96aa7f61
--- /dev/null
+++ b/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 <de...@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)
diff --git a/test/phpinspect-test.el b/test/phpinspect-test.el
index 426838883c..53fc8be8e8 100644
--- a/test/phpinspect-test.el
+++ b/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
diff --git a/test/test-splayt.el b/test/test-splayt.el
new file mode 100644
index 0000000000..c399f7c1c5
--- /dev/null
+++ b/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 <de...@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)))))
