branch: externals/phps-mode
commit 5273bdf42fc88f1a94656aa795348a3ca082597d
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
Started on cache feature
---
Makefile | 6 +-
phps-mode-cache.el | 82 +++++++++++++
phps-mode-lex-analyzer.el | 269 +++++++++++++++++++++++++------------------
test/phps-mode-test-cache.el | 52 +++++++++
4 files changed, 297 insertions(+), 112 deletions(-)
diff --git a/Makefile b/Makefile
index f5e8f3d390..340eff5aed 100644
--- a/Makefile
+++ b/Makefile
@@ -20,12 +20,16 @@ compile:
find . -name "*.el" -exec $(EMACS_CMD) -f batch-byte-compile {} \;
.PHONY: tests
-tests: test-integration test-lexer test-lex-analyzer test-parser
test-syntax-table test-ast test-indent
+tests: test-integration test-lexer test-lex-analyzer test-parser
test-syntax-table test-ast test-indent test-cache
.PHONY: test-ast
test-ast:
$(EMACS_CMD) -l test/phps-mode-test-ast.el
+.PHONY: test-cache
+test-cache:
+ $(EMACS_CMD) -l test/phps-mode-test-cache.el
+
.PHONY: test-indent
test-indent:
$(EMACS_CMD) -l test/phps-mode-test-indent.el
diff --git a/phps-mode-cache.el b/phps-mode-cache.el
new file mode 100644
index 0000000000..af05116715
--- /dev/null
+++ b/phps-mode-cache.el
@@ -0,0 +1,82 @@
+;;; phps-mode-cache.el -- Cache for phps-mode -*- lexical-binding: t -*-
+
+;; Copyright (C) 2018-2022 Free Software Foundation, Inc.
+
+
+;;; Commentary:
+
+
+;;; Code:
+
+
+(defvar
+ phps-mode-cache--base-filename
+ "~/.phps-mode-cache/"
+ "Base filename for cache files.")
+
+(defun phps-mode-cache--get-filename-for-key (key)
+ "Get filename for KEY."
+ (let ((directory-filename
+ (expand-file-name phps-mode-cache--base-filename)))
+ (unless (file-exists-p directory-filename)
+ (make-directory directory-filename))
+ (let ((filename
+ (expand-file-name
+ (replace-regexp-in-string
+ "\\(/\\|@\\|:\\)" "_"
+ key)
+ directory-filename)))
+ filename)))
+
+(defun phps-mode-cache-test-p (key &optional source-file)
+ "Test whether KEY exists in cache and that it is optionally not older than
SOURCE-FILE."
+ (let ((cache-filename (phps-mode-cache--get-filename-for-key key))
+ (exists))
+ (when (file-exists-p cache-filename)
+ (if (and
+ source-file
+ (file-exists-p source-file))
+ (unless
+ (file-newer-than-file-p
+ source-file
+ cache-filename)
+ (setq
+ exists
+ t))
+ (setq
+ exists
+ t)))
+ exists))
+
+(defun phps-mode-cache-delete (key)
+ "Delete cache for KEY."
+ (let ((cache-filename (phps-mode-cache--get-filename-for-key key)))
+ (when (file-exists-p cache-filename)
+ (delete-file cache-filename nil))))
+
+(defun phps-mode-cache-save (data key)
+ "Save DATA in cache for KEY."
+ (let ((cache-filename (phps-mode-cache--get-filename-for-key key)))
+ (with-temp-buffer
+ (insert (format "'%S" data))
+ (write-file cache-filename nil))))
+
+(defun phps-mode-cache-load (key)
+ "Load DATA in cache for KEY."
+ (with-temp-buffer
+ (insert-file-contents
+ (phps-mode-cache--get-filename-for-key
+ key))
+ (let ((data
+ (eval
+ (car
+ (read-from-string
+ (buffer-substring-no-properties
+ (point-min)
+ (point-max)))))))
+ data)))
+
+
+(provide 'phps-mode-cache)
+
+;;; phps-mode-cache.el ends here
diff --git a/phps-mode-lex-analyzer.el b/phps-mode-lex-analyzer.el
index 81fb3abcfa..9d01c1bffc 100644
--- a/phps-mode-lex-analyzer.el
+++ b/phps-mode-lex-analyzer.el
@@ -16,6 +16,7 @@
;;; Code:
+(require 'phps-mode-cache)
(require 'phps-mode-lexer)
(require 'phps-mode-macros)
(require 'phps-mode-parser)
@@ -207,7 +208,18 @@
buffer-name
(lambda()
- (phps-mode-lex-analyzer--lex-string buffer-contents))
+ (phps-mode-lex-analyzer--lex-string
+ buffer-contents
+ nil
+ nil
+ nil
+ nil
+ nil
+ nil
+ nil
+ nil
+ nil
+ buffer-file-name))
(lambda(lex-result)
(when (get-buffer buffer-name)
@@ -314,7 +326,7 @@
(defun phps-mode-lex-analyzer--incremental-lex-string
(buffer-name buffer-contents incremental-start-new-buffer point-max
- head-states incremental-state incremental-state-stack
incremental-heredoc-label incremental-heredoc-label-stack
incremental-nest-location-stack head-tokens &optional force-synchronous)
+ head-states incremental-state incremental-state-stack
incremental-heredoc-label incremental-heredoc-label-stack
incremental-nest-location-stack head-tokens &optional force-synchronous
filename)
"Incremental lex region."
(let ((async (and (boundp 'phps-mode-async-process)
phps-mode-async-process))
@@ -337,7 +349,8 @@
incremental-heredoc-label
incremental-heredoc-label-stack
incremental-nest-location-stack
- head-tokens))
+ head-tokens
+ filename))
(lambda(lex-result)
(when (get-buffer buffer-name)
@@ -668,7 +681,8 @@
incremental-heredoc-label-stack
incremental-nest-location-stack
head-tokens
- force-synchronous)
+ force-synchronous
+ buffer-file-name)
(phps-mode-debug-message
(message "Incremental tokens: %s"
incremental-tokens)))
@@ -1049,119 +1063,152 @@
token-start)))
parser-tokens))
-(defun phps-mode-lex-analyzer--lex-string (contents &optional start end states
state state-stack heredoc-label heredoc-label-stack nest-location-stack tokens)
+(defun phps-mode-lex-analyzer--lex-string (contents &optional start end states
state state-stack heredoc-label heredoc-label-stack nest-location-stack tokens
filename)
"Run lexer on CONTENTS."
;; Create a separate buffer, run lexer inside of it, catch errors and return
them
;; to enable nice presentation
(require 'phps-mode-macros)
- (let* ((buffer (generate-new-buffer "*PHPs Lexer*"))
- (parse-error)
- (parse-trail)
- (ast-tree)
- (imenu-index)
- (bookkeeping-index))
-
- ;; Create temporary buffer and run lexer in it
- (when (get-buffer buffer)
- (with-current-buffer buffer
- (insert contents)
-
- (if tokens
- (setq
- phps-mode-lexer--generated-tokens
- (nreverse tokens))
- (setq
- phps-mode-lexer--generated-tokens
- nil))
- (if state
- (setq
- phps-mode-lexer--state state)
+
+ (let ((loaded-from-cache))
+ (when (and
+ (not end)
+ filename)
+ (let ((cache-key
+ (format "lex-%s" filename)))
+ (when
+ (phps-mode-cache-test-p
+ cache-key
+ filename)
(setq
- phps-mode-lexer--state
- 'ST_INITIAL))
+ loaded-from-cache
+ (phps-mode-cache-load
+ cache-key)))))
+
+ (if loaded-from-cache
+ loaded-from-cache
+ (let* ((buffer
+ (generate-new-buffer "*PHPs Lexer*"))
+ (parse-error)
+ (parse-trail)
+ (ast-tree)
+ (imenu-index)
+ (bookkeeping-index))
+
+ ;; Create temporary buffer and run lexer in it
+ (when (get-buffer buffer)
+ (with-current-buffer buffer
+ (insert contents)
+
+ (if tokens
+ (setq
+ phps-mode-lexer--generated-tokens
+ (nreverse tokens))
+ (setq
+ phps-mode-lexer--generated-tokens
+ nil))
+ (if state
+ (setq
+ phps-mode-lexer--state state)
+ (setq
+ phps-mode-lexer--state
+ 'ST_INITIAL))
- (setq
- phps-mode-lexer--states
- states)
- (setq
- phps-mode-lexer--state-stack
- state-stack)
- (setq
- phps-mode-lexer--heredoc-label
- heredoc-label)
- (setq
- phps-mode-lexer--heredoc-label-stack
- heredoc-label-stack)
- (setq
- phps-mode-lexer--nest-location-stack
- nest-location-stack)
- (unless end
- (setq end (point-max)))
- (unless start
- (setq start (point-min)))
- (setq-local
- phps-mode-lex-analyzer--lexer-index
- start)
- (setq-local
- phps-mode-lex-analyzer--lexer-max-index
- end)
-
- ;; Catch errors to kill generated buffer
- (let ((got-error t))
- (unwind-protect
- ;; Run lexer or incremental lexer
- (progn
- (phps-mode-lex-analyzer--re2c-lex-analyzer)
- (setq got-error nil))
- (when got-error
- (kill-buffer))))
-
- ;; Copy variables outside of buffer
- (setq state phps-mode-lexer--state)
- (setq state-stack phps-mode-lexer--state-stack)
- (setq states phps-mode-lexer--states)
-
- ;; NOTE Generate parser tokens here before nreverse destructs list
- (setq
- phps-mode-parser-tokens
- (phps-mode-lex-analyzer--generate-parser-tokens
- phps-mode-lexer--generated-tokens))
- (setq tokens (nreverse phps-mode-lexer--generated-tokens))
- (setq heredoc-label phps-mode-lexer--heredoc-label)
- (setq heredoc-label-stack phps-mode-lexer--heredoc-label-stack)
- (setq nest-location-stack phps-mode-lexer--nest-location-stack)
-
- ;; Error-free parse here
- (condition-case conditions
- (progn
- (phps-mode-ast--generate)
- (phps-mode-ast-bookkeeping--generate)
- (phps-mode-ast-imenu--generate))
- (error
- (setq
- parse-error
- conditions)))
-
- ;; Need to copy buffer-local values before killing buffer
- (setq parse-trail phps-mode-ast--parse-trail)
- (setq ast-tree phps-mode-ast--tree)
- (setq imenu-index phps-mode-ast-imenu--index)
- (setq bookkeeping-index phps-mode-ast-bookkeeping--index)
-
- (kill-buffer)))
- (list
- tokens
- states
- state
- state-stack
- heredoc-label
- heredoc-label-stack
- nest-location-stack
- parse-trail
- parse-error
- ast-tree
- imenu-index
- bookkeeping-index)))
+ (setq
+ phps-mode-lexer--states
+ states)
+ (setq
+ phps-mode-lexer--state-stack
+ state-stack)
+ (setq
+ phps-mode-lexer--heredoc-label
+ heredoc-label)
+ (setq
+ phps-mode-lexer--heredoc-label-stack
+ heredoc-label-stack)
+ (setq
+ phps-mode-lexer--nest-location-stack
+ nest-location-stack)
+ (unless end
+ (setq end (point-max)))
+ (unless start
+ (setq start (point-min)))
+ (setq-local
+ phps-mode-lex-analyzer--lexer-index
+ start)
+ (setq-local
+ phps-mode-lex-analyzer--lexer-max-index
+ end)
+
+ ;; Catch errors to kill generated buffer
+ (let ((got-error t))
+ (unwind-protect
+ ;; Run lexer or incremental lexer
+ (progn
+ (phps-mode-lex-analyzer--re2c-lex-analyzer)
+ (setq got-error nil))
+ (when got-error
+ (kill-buffer))))
+
+ ;; Copy variables outside of buffer
+ (setq state phps-mode-lexer--state)
+ (setq state-stack phps-mode-lexer--state-stack)
+ (setq states phps-mode-lexer--states)
+
+ ;; NOTE Generate parser tokens here before nreverse destructs list
+ (setq
+ phps-mode-parser-tokens
+ (phps-mode-lex-analyzer--generate-parser-tokens
+ phps-mode-lexer--generated-tokens))
+ (setq tokens (nreverse phps-mode-lexer--generated-tokens))
+ (setq heredoc-label phps-mode-lexer--heredoc-label)
+ (setq heredoc-label-stack phps-mode-lexer--heredoc-label-stack)
+ (setq nest-location-stack phps-mode-lexer--nest-location-stack)
+
+ ;; Error-free parse here
+ (condition-case conditions
+ (progn
+ (phps-mode-ast--generate)
+ (phps-mode-ast-bookkeeping--generate)
+ (phps-mode-ast-imenu--generate))
+ (error
+ (setq
+ parse-error
+ conditions)))
+
+ ;; Need to copy buffer-local values before killing buffer
+ (setq parse-trail phps-mode-ast--parse-trail)
+ (setq ast-tree phps-mode-ast--tree)
+ (setq imenu-index phps-mode-ast-imenu--index)
+ (setq bookkeeping-index phps-mode-ast-bookkeeping--index)
+
+ (kill-buffer)))
+
+ (let
+ ((data
+ (list
+ tokens
+ states
+ state
+ state-stack
+ heredoc-label
+ heredoc-label-stack
+ nest-location-stack
+ parse-trail
+ parse-error
+ ast-tree
+ imenu-index
+ bookkeeping-index)))
+
+ (when (and
+ (not end)
+ filename)
+ (let ((cache-key
+ (format "lex-%s" filename)))
+ (phps-mode-cache-save
+ data
+ cache-key)))
+
+ data)))))
(provide 'phps-mode-lex-analyzer)
diff --git a/test/phps-mode-test-cache.el b/test/phps-mode-test-cache.el
new file mode 100644
index 0000000000..3218ea687c
--- /dev/null
+++ b/test/phps-mode-test-cache.el
@@ -0,0 +1,52 @@
+;;; phps-mode-test-cache.el --- Tests for cache -*- lexical-binding: t -*-
+
+;; Copyright (C) 2018-2022 Free Software Foundation, Inc.
+
+
+;;; Commentary:
+
+
+;; Run from terminal make test-cache
+
+
+;;; Code:
+
+
+(require 'phps-mode-cache)
+
+(require 'ert)
+
+(defun phps-mode-test-cache ()
+ "Run test."
+
+ (phps-mode-cache-delete "abc")
+
+ (should
+ (equal
+ (phps-mode-cache-test-p "abc")
+ nil))
+ (message "Passed cache test function 1")
+
+ (phps-mode-cache-save '(0 1 2) "abc")
+
+ (should
+ (equal
+ (phps-mode-cache-test-p "abc")
+ t))
+
+ (message "Passed cache test function 2")
+
+ (should
+ (equal
+ (phps-mode-cache-load "abc")
+ '(0 1 2)))
+
+ (message "Passed cache load function")
+
+ (message "Passed tests for cache"))
+
+(phps-mode-test-cache)
+
+(provide 'phps-mode-test-cache)
+
+;;; phps-mode-test-cache.el ends here
