[elpa] externals/phps-mode 5273bdf42f 206/212: Started on cache feature

[Christian Johansson]

branch: externals/phps-mode
commit 5273bdf42fc88f1a94656aa795348a3ca082597d
Author: Christian Johansson <christian@cvj.se>
Commit: Christian Johansson <christian@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