[nongnu] elpa/tuareg 2a8ac59: Fix defun/phrase discovery (#250)

[ELPA Syncer]

branch: elpa/tuareg
commit 2a8ac599e85d9193b984d71fd395b8dc3651bdb2
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    Fix defun/phrase discovery (#250)
    
    Fix problems with phrase discovery in a previous change:
    Make sure that movement by defun isn't confused by separating ";;".
    Treat `let...and...` top level declaration as a single
    phrase although it is composed of multiple defuns, and treat
    `let...and...in...` as a single defun and phrase.
---
 tuareg-tests.el | 112 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 tuareg.el       |  92 ++++++++++++++++++++++++++++++++++++----------
 2 files changed, 184 insertions(+), 20 deletions(-)

diff --git a/tuareg-tests.el b/tuareg-tests.el
index 7cf298f..fd152d1 100644
--- a/tuareg-tests.el
+++ b/tuareg-tests.el
@@ -230,4 +230,116 @@ Returns the value of the last FORM."
       (end-of-defun)
       (should (equal (point) p8a)))))
 
+(ert-deftest tuareg-phrase-discovery ()
+  (with-temp-buffer
+    (tuareg-mode)
+    (tuareg--lets
+     (insert "let a = 1 and b = 2 in a + b\n")
+     (let p1 (point))
+     (insert "let f x =\n"
+             "  x + 1\n")
+     (let p2a (point))
+     (insert "and g x =\n"
+             "  x * 2\n")
+     (let p2b (point))
+     (insert ";;\n")
+     (let p2c (point))
+     (insert "(1 < 2) = false;;\n")
+     (let p3 (point))
+     (insert "'a';;\n")
+     (let p4 (point))
+     (insert "\"abc\" ^ \" \" ^ \"def\";;\n")
+     (let p5 (point))
+     (insert "{|with \\ special \" chars|};;\n")
+     (let p6 (point))
+
+     (goto-char (point-min))
+     (end-of-defun)
+     (should (equal (point) p1))
+     (end-of-defun)
+     (should (equal (point) p2a))
+     (end-of-defun)
+     (should (equal (point) p2b))
+     (end-of-defun)
+     (should (equal (point) p3))
+     (end-of-defun)
+     (should (equal (point) p4))
+     (end-of-defun)
+     (should (equal (point) p5))
+     (end-of-defun)
+     (should (equal (point) p6))
+
+     (beginning-of-defun)
+     (should (equal (point) p5))
+     (beginning-of-defun)
+     (should (equal (point) p4))
+     (beginning-of-defun)
+     (should (equal (point) p3))
+     (beginning-of-defun)
+     (should (equal (point) p2c))
+     (beginning-of-defun)
+     (should (equal (point) p2a))
+     (beginning-of-defun)
+     (should (equal (point) p1))
+     (beginning-of-defun)
+     (should (equal (point) (point-min)))
+
+     (should (equal (tuareg-discover-phrase (point-min))
+                    (list (point-min) (1- p1) (1- p1))))
+     (should (equal (tuareg-discover-phrase p1)
+                    (list p1 (1- p2b) (1- p2b))))
+     (should (equal (tuareg-discover-phrase p2c)
+                    (list p2c (1- p3) (1- p3))))
+     (should (equal (tuareg-discover-phrase p3)
+                    (list p3 (1- p4) (1- p4))))
+     (should (equal (tuareg-discover-phrase p4)
+                    (list p4 (1- p5) (1- p5))))
+     (should (equal (tuareg-discover-phrase p5)
+                    (list p5 (1- p6) (1- p6))))
+     )))
+
+(ert-deftest tuareg-defun-separator ()
+  ;; Check correct handling of ";;"-separated defuns/phrases.
+  (with-temp-buffer
+    (tuareg-mode)
+    (tuareg--lets
+     (insert "let _ = tata 3 ;;\n")
+     (let p1 (point))
+     (insert "let _ = titi 4 ;;\n")
+     (let p2 (point))
+     (insert "abc def ;;\n")
+     (let p3 (point))
+     (insert "ghi jkl ;;\n")
+     (let p4 (point))
+
+     (goto-char (point-min))
+     (end-of-defun)
+     (should (equal (point) p1))
+     (end-of-defun)
+     (should (equal (point) p2))
+     (end-of-defun)
+     (should (equal (point) p3))
+     (end-of-defun)
+     (should (equal (point) p4))
+     (beginning-of-defun)
+     (should (equal (point) p3))
+     (beginning-of-defun)
+     (should (equal (point) p2))
+     (beginning-of-defun)
+     (should (equal (point) p1))
+     (beginning-of-defun)
+     (should (equal (point) (point-min)))
+
+     (should (equal (tuareg-discover-phrase (point-min))
+                    (list (point-min) (1- p1) (1- p1))))
+     (should (equal (tuareg-discover-phrase p1)
+                    (list p1 (1- p2) (1- p2))))
+     (should (equal (tuareg-discover-phrase (+ p1 2))
+                    (list p1 (1- p2) (1- p2))))
+     (should (equal (tuareg-discover-phrase p2)
+                    (list p2 (1- p3) (1- p3))))
+     (should (equal (tuareg-discover-phrase p3)
+                    (list p3 (1- p4) (1- p4))))
+     )))
+
 (provide 'tuareg-tests)
diff --git a/tuareg.el b/tuareg.el
index 5b3ca16..81a67ba 100644
--- a/tuareg.el
+++ b/tuareg.el
@@ -2362,40 +2362,58 @@ Return a non-nil value if a comment was skipped."
   (while (tuareg--skip-forward-comment)))
 
 (defvar-local tuareg-smie--forward-and-cache nil
-  "Alist memoising positions from (smie-forward-sexp \"and\").")
+  "Alist memoising results from (smie-forward-sexp \"and\").")
 
 (defvar-local tuareg-smie--backward-and-cache nil
-  "Alist memoising results from (smie-backward-sexp \"and\").")
+  "Alist memoising results from (smie-backward-sexp \"and\").
+Each element is (POS-BEFORE POS-AFTER VALUE) where POS-BEFORE and
+POS-AFTER are the positions before and after the call
+respectivaly, and VALUE what the call returned.")
 
 (defvar-local tuareg-smie--and-cache-tick nil
   "Buffer-modification tick at which and-caches are valid.
 Applies to `tuareg-smie--forward-and-cache'
 and `tuareg-smie--backward-and-cache'.")
 
-(defun tuareg-backward-beginning-of-defun ()
+(defun tuareg-backward-beginning-of-defun (&optional stay-in-current)
   "Move the point backward to the beginning of a definition.
-Return the token starting the phrase (`nil' if it is an expression)."
+Return the token starting the phrase (`nil' if it is an expression).
+If STAY-IN-CURRENT is non-nil, don't go to the previous defun if already
+at the start of one."
   (let ((state (syntax-ppss)))
-    (if (nth 3 state); in a string
-        (goto-char (nth 8 state))
-      ;; If inside a word (e.g., "let" or "end"), move to the end of it.
-      (or (looking-at (rx symbol-start))
-          (/= (skip-syntax-forward "w_") 0)
-          (tuareg--skip-backward-comments-semicolon))))
+    (cond
+     ;; In a string: move to its end (via the beginning).
+     ((nth 3 state)
+      (goto-char (nth 8 state))
+      (smie-forward-sexp))
+     ;; In a comment: move to its beginning.
+     ((nth 4 state)
+      (goto-char (nth 8 state)))
+     ;; At start of a word and we may move to previous defun: stay put.
+     ((and (not stay-in-current)
+           (looking-at (rx symbol-start))))
+     ;; If in or at the beginning of a word, move to the end.
+     ((/= (skip-syntax-forward "w_") 0))
+     ;; Otherwise, skip possibly trailing ";;".
+     (t (tuareg--skip-backward-comments-semicolon))))
+
   ;; We treat each "and" clause belonging to "d-let" or "type" as defuns
   ;; in the own right since that is how programmers think about it.
-  (let* ((and-pos nil)
+  (let* ((opoint (point))
+         (and-pos nil)
          (ret-tok nil)
          (tick (buffer-chars-modified-tick))
          (cache-valid (eql tuareg-smie--and-cache-tick tick)))
     (while
         (and (not (bobp))
-             ;; Memoised call to (smie-backward-exp "and")
+             ;; Memoised call to (smie-backward-sexp "and")
              (let* ((cached
                      (and cache-valid
                           (assq (point) tuareg-smie--backward-and-cache)))
                     (td (if cached
-                            (cdr cached)
+                            (progn
+                              (goto-char (nth 1 cached))
+                              (nth 2 cached))
                           (unless cache-valid
                             (setq tuareg-smie--forward-and-cache nil)
                             (setq tuareg-smie--backward-and-cache nil)
@@ -2403,7 +2421,7 @@ Return the token starting the phrase (`nil' if it is an 
expression)."
                             (setq cache-valid t))
                           (let* ((pt (point))
                                  (r (smie-backward-sexp "and")))
-                            (push (cons pt r)
+                            (push (list pt (point) r)
                                   tuareg-smie--backward-and-cache)
                             r))))
                (and (nth 0 td)
@@ -2436,8 +2454,17 @@ Return the token starting the phrase (`nil' if it is an 
expression)."
                         (setq and-pos nil)
                         (goto-char tpos)
                         t)
-                       ;; Other tokens not starting a defun: keep going.
-                       ((member tok '(";;" "do" "downto" "to"))
+                       ((equal tok ";;")
+                        (if (and (= (point) opoint) (not stay-in-current))
+                            ;; Assume this ";;" to be the last part of
+                            ;; the defun to go past: skip and continue.
+                            (progn
+                              (goto-char tpos)
+                              t)
+                          ;; This marks the beginning of the defun.
+                          (setq ret-tok t)  ; Any non-nil value should do.
+                          nil))
+                       ((member tok '("do" "downto" "to"))
                         (goto-char tpos)
                         t)
                        ;; Left bracket or similar: keep going.
@@ -2470,6 +2497,24 @@ See variable `end-of-defun-function'."
   (interactive)
   (tuareg-smie--forward-token)       ; Skip the head token.
   (tuareg-smie--forward-sexp-and)
+  (let ((end (point)))
+    ;; Check whether this defun is part of a let...and... chain that
+    ;; ends with "in", in which case it is a single big defun.
+    ;; Otherwise, go back to the first end position.
+    (while
+        (let ((tok (tuareg-smie--forward-token)))
+          (cond ((equal tok "and")
+                 ;; Skip the "and" clause and keep looking.
+                 (tuareg-smie--forward-sexp-and)
+                 t)
+                ((equal tok "in")
+                 ;; It's an expression, not a declaration: go to its end.
+                 (tuareg-smie--forward-sexp-and)
+                 nil)
+                (t
+                 ;; No "in" found; use what we had at the start.
+                 (goto-char end)
+                 nil)))))
   (tuareg--skip-forward-comments-semicolon))
 
 (defun tuareg-beginning-of-defun (&optional arg)
@@ -2514,7 +2559,7 @@ See variable `beginning-of-defun-function'."
                 (or (null (car td))
                     (and (string= (nth 2 td) ";;")
                          (tuareg-smie-backward-token)))))
-    (tuareg-backward-beginning-of-defun)
+    (tuareg-backward-beginning-of-defun t)
     (forward-comment (- (point))))
   (when (looking-at-p "in")
     ;; Skip over `local...in' and continue.
@@ -2523,7 +2568,7 @@ See variable `beginning-of-defun-function'."
     (tuareg-skip-siblings)))
 
 (defun tuareg--current-fun-name ()
-  (when (tuareg-backward-beginning-of-defun)
+  (when (tuareg-backward-beginning-of-defun t)
     (save-excursion (tuareg-smie-forward-token)
                     (tuareg-skip-blank-and-comments)
                     (let ((name (tuareg-smie-forward-token)))
@@ -2561,9 +2606,16 @@ point at the beginning of the error and return `nil'."
         begin end)
     (save-excursion
       (if pos (goto-char pos))
-      (tuareg-backward-beginning-of-defun)
+      ;; If the beginning of the defun was an "and", try again until we
+      ;; get to the start of the phrase.
+      (while (equal (tuareg-backward-beginning-of-defun t) "and")
+        (forward-char -1))
       (setq begin (point))
-      (tuareg-end-of-defun) ; OK as point is as beginning of defun
+      ;; Go all the way to the end of the phrase (not just the defun,
+      ;; which could end at an "and").
+      (tuareg-smie-forward-token)
+      (smie-forward-sexp ";;")
+      (tuareg--skip-forward-comments-semicolon)
       (setq end (point))
       ;; Check if we were not stuck (after POS) because the phrase was
       ;; not well parenthesized.