emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] elpa/tuareg 1a2aa93 5/6: Better phrase discovery


From: ELPA Syncer
Subject: [nongnu] elpa/tuareg 1a2aa93 5/6: Better phrase discovery
Date: Thu, 8 Jul 2021 23:57:20 -0400 (EDT)

branch: elpa/tuareg
commit 1a2aa93f3bb8b79a290d6a18e821cb10cd1bdf21
Author: Mattias EngdegÄrd <mattiase@acm.org>
Commit: Mattias EngdegÄrd <mattiase@acm.org>

    Better phrase discovery
    
    This rectifies imperfect phrase discovery and movement by defun for
    several constructs. Fixes issue #256.
---
 tuareg-tests.el | 92 ++++++++++++++++++++++++++++++++++++++-------------------
 tuareg.el       | 55 +++++++++++++++++++++-------------
 2 files changed, 95 insertions(+), 52 deletions(-)

diff --git a/tuareg-tests.el b/tuareg-tests.el
index cef8733..720e4ed 100644
--- a/tuareg-tests.el
+++ b/tuareg-tests.el
@@ -230,7 +230,7 @@ Returns the value of the last FORM."
       (end-of-defun)
       (should (equal (point) p8a)))))
 
-(ert-deftest tuareg-phrase-discovery ()
+(ert-deftest tuareg-phrase-discovery-1 ()
   (with-temp-buffer
     (tuareg-mode)
     (tuareg--lets
@@ -242,16 +242,13 @@ Returns the value of the last FORM."
      (insert "and g x =\n"
              "  x * 2\n")
      (let p2b (point))
+     (insert "type ta = A\n"
+             "        | B of tb\n")
+     (let p3a (point))
+     (insert "and tb = C\n"
+             "       | D of ta\n")
+     (let p3b (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)
@@ -261,22 +258,14 @@ Returns the value of the last FORM."
      (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))
+     (should (equal (point) p3a))
      (end-of-defun)
-     (should (equal (point) p6))
+     (should (equal (point) p3b))
 
      (beginning-of-defun)
-     (should (equal (point) p5))
+     (should (equal (point) p3a))
      (beginning-of-defun)
-     (should (equal (point) p4))
-     (beginning-of-defun)
-     (should (equal (point) p3))
-     (beginning-of-defun)
-     (should (equal (point) p2c))
+     (should (equal (point) p2b))
      (beginning-of-defun)
      (should (equal (point) p2a))
      (beginning-of-defun)
@@ -288,15 +277,56 @@ Returns the value of the last FORM."
                     (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))))
-     )))
+     (should (equal (tuareg-discover-phrase p2b)
+                    (list p2b (1- p3b) (1- p3b)))))))
+
+(ert-deftest tuareg-phrase-discovery-2 ()
+  (let ((lines
+         '("(1 < 2) = false;;"
+           "'a';;"
+           "\"abc\" ^ \" \" ^ \"def\";;"
+           "{|with \\ special \" chars|};;"
+           "max 1 2;;"
+           "if true then 1 else 2 ;;"
+           "while false do print_endline \"a\" done ;;"
+           "for i = 1 to 3 do print_int i done ;;"
+           "open Stdlib.Printf;;"
+           "begin print_char 'a'; print_char 'b'; end ;;"
+           "match [1;2] with a :: _ -> a | [] -> 3 ;;"
+           "exception E of int * string ;;"
+           "external myid : 'a -> 'a = \"%identity\";;"
+           "class k = object method m = 1 end;;")))
+
+    (with-temp-buffer
+      (tuareg-mode)
+      (dolist (line lines)
+        (insert line "\n"))
+
+      ;; Check movement by defun.
+      (goto-char (point-min))
+      (let ((pos (point-min)))
+        (dolist (line lines)
+          (let ((next-pos (+ pos (length line) 1)))
+            (ert-info ((prin1-to-string line) :prefix "line: ")
+              (end-of-defun)
+              (should (equal (point) next-pos))
+              (setq pos next-pos))))
+
+        (dolist (line (reverse lines))
+          (let ((prev-pos (- pos (length line) 1)))
+            (ert-info ((prin1-to-string line) :prefix "line: ")
+              (beginning-of-defun)
+              (should (equal (point) prev-pos))
+              (setq pos prev-pos)))))
+
+      ;; Check phrase discovery.
+      (let ((pos (point-min)))
+        (dolist (line lines)
+          (let ((next-pos (+ pos (length line) 1)))
+            (ert-info ((prin1-to-string line) :prefix "line: ")
+              (should (equal (tuareg-discover-phrase pos)
+                             (list pos (1- next-pos) (1- next-pos))))
+              (setq pos next-pos))))))))
 
 (ert-deftest tuareg-defun-separator ()
   ;; Check correct handling of ";;"-separated defuns/phrases.
diff --git a/tuareg.el b/tuareg.el
index 16fceea..12ea951 100644
--- a/tuareg.el
+++ b/tuareg.el
@@ -2497,26 +2497,35 @@ at the start of one."
   "Assuming that we are at the beginning of a definition, move to its end.
 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)))))
+  (let* ((start (point))
+         (head (tuareg-smie--forward-token)))       ; Skip the head token.
+    (cond
+     ((member head '("type" "d-let" "let" "and" "exception" "module"
+                     "class" "val" "external" "open"))
+      ;; Non-expression defun.
+      (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))))))
+     (t
+      ;; Expression: go back and skip it all at once.
+      (goto-char start)
+      (smie-forward-sexp ";;"))))
   (tuareg--skip-forward-comments-semicolon))
 
 (defun tuareg-beginning-of-defun (&optional arg)
@@ -2615,7 +2624,11 @@ point at the beginning of the error and return `nil'."
       (setq begin (point))
       ;; Go all the way to the end of the phrase (not just the defun,
       ;; which could end at an "and").
-      (tuareg-smie-forward-token)
+      (let ((head (tuareg-smie-forward-token)))
+        (unless (member head '("type" "d-let" "let" "and" "exception" "module"
+                               "class" "val" "external" "open"))
+          ;; Expression phrase.
+          (goto-char begin)))
       (smie-forward-sexp ";;")
       (tuareg--skip-forward-comments-semicolon)
       (setq end (point))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]