[elpa] master 77254a2: * packages/sml-mode/sml-mode.el: Parse "local" correctly

[Stefan Monnier]

branch: master
commit 77254a24fe17cb137a50a439454997404d344375
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * packages/sml-mode/sml-mode.el: Parse "local" correctly
    
    Also use `setq-local` and `defvar-local`.
    
    (sml-smie--pending-token): New var.
    (sml-smie-forward-token, sml-smie-backward-token): Use it for "local".
    (sml-smie-rules): Drop ad-hoc indentation rule for "local".
---
 packages/sml-mode/sml-mode.el   | 184 +++++++++++++++++++++-------------------
 packages/sml-mode/testcases.sml |  16 ++--
 2 files changed, 104 insertions(+), 96 deletions(-)

diff --git a/packages/sml-mode/sml-mode.el b/packages/sml-mode/sml-mode.el
index e128832..172ffe5 100644
--- a/packages/sml-mode/sml-mode.el
+++ b/packages/sml-mode/sml-mode.el
@@ -1,9 +1,9 @@
 ;;; sml-mode.el --- Major mode for editing (Standard) ML  -*- lexical-binding: 
t; coding: utf-8 -*-
 
-;; Copyright (C) 1989,1999,2000,2004,2007,2010-2018  Free Software Foundation, 
Inc.
+;; Copyright (C) 1989-2020  Free Software Foundation, Inc.
 
 ;; Maintainer: Stefan Monnier <address@hidden>
-;; Version: 6.9
+;; Version: 6.10
 ;; Keywords: SML
 ;; Author:     Lars Bo Nielsen
 ;;             Olin Shivers
@@ -12,7 +12,7 @@
 ;;             Matthew Morley <address@hidden>
 ;;             Matthias Blume <address@hidden>
 ;;             (Stefan Monnier) <address@hidden>
-;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
+;; Package-Requires: ((emacs "24.3") (cl-lib "0.5"))
 
 ;; This file is part of GNU Emacs.
 
@@ -55,6 +55,7 @@
 
 ;; - new var sml-abbrev-skeletons to control whether to include skeletons
 ;;   in the main abbrev table.
+;; - change parsing rule of "local"
 
 ;;;;; Changes since 5.0:
 
@@ -563,22 +564,6 @@ Regexp match data 0 points to the chars."
      (cond
       ((smie-rule-parent-p "datatype") (if (smie-rule-bolp) 2))
       ((smie-rule-parent-p "structure" "signature" "functor") 0)))
-    ;; Indent an expression starting with "local" as if it were starting
-    ;; with "fun".
-    (`(:before . "local") (smie-indent-keyword "fun"))
-    ;; FIXME: type/val/fun/... are separators but "local" is not, even though
-    ;; it appears in the same list.  Try to fix up the problem by hand.
-    ;; ((or (equal token "local")
-    ;;      (equal (cdr (assoc token smie-grammar))
-    ;;             (cdr (assoc "fun" smie-grammar))))
-    ;;  (let ((parent (save-excursion (smie-backward-sexp))))
-    ;;    (when (or (and (equal (nth 2 parent) "local")
-    ;;                   (null (car parent)))
-    ;;              (progn
-    ;;                (setq parent (save-excursion (smie-backward-sexp "fun")))
-    ;;                (eq (car parent) (nth 1 (assoc "fun" smie-grammar)))))
-    ;;      (goto-char (nth 1 parent))
-    ;;      (cons 'column (smie-indent-virtual)))))
     ))
 
 (defun sml-smie-definitional-equal-p ()
@@ -635,16 +620,37 @@ Assumes point is right before the | symbol."
          (skip-syntax-forward ".'"))
      (point))))
 
+;; "local...end" acts as a kind of parentheses, but it *also* terminates
+;; any preceding declaration: SMIE doesn't really know how to handle such
+;; a token correctly.  In the past we solved this problem in the
+;; `sml-smie-rules' with an ad-hoc indentation rule for `local', but instead
+;; we now just emit two tokens ("val" and "local") when we encounter
+;; a "local" keyword.
+(defvar-local sml-smie--pending-token nil
+  "Tokens already parsed but not yet emitted.
+Used when several tokens should be emitted at the same buffer position.
+Takes the form (DIR POS . TOKENS).")
+
 (defun sml-smie-forward-token ()
-  (let ((sym (sml-smie-forward-token-1)))
-    (cond
-     ((equal "op" sym)
-      (concat "op " (sml-smie-forward-token-1)))
-     ((member sym '("|" "of" "="))
-      ;; The important lexer for indentation's performance is the backward
-      ;; lexer, so for the forward lexer we delegate to the backward one.
-      (save-excursion (sml-smie-backward-token)))
-     (t sym))))
+  (or
+   (when sml-smie--pending-token
+     (if (and (eq 'forward (car sml-smie--pending-token))
+              (eql (point) (nth 1 sml-smie--pending-token))
+              (nthcdr 2 sml-smie--pending-token))
+         (pop (nthcdr 2 sml-smie--pending-token))
+       (setq sml-smie--pending-token nil)))
+   (let ((sym (sml-smie-forward-token-1)))
+     (cond
+      ((equal "op" sym)
+       (concat "op " (sml-smie-forward-token-1)))
+      ((member sym '("|" "of" "="))
+       ;; The important lexer for indentation's performance is the backward
+       ;; lexer, so for the forward lexer we delegate to the backward one.
+       (save-excursion (sml-smie-backward-token)))
+      ((string= sym "local")
+       (setq sml-smie--pending-token `(forward ,(point) ,sym))
+       "val")
+      (t sym)))))
 
 (defun sml-smie-backward-token-1 ()
   (forward-comment (- (point)))
@@ -656,18 +662,28 @@ Assumes point is right before the | symbol."
      (point))))
 
 (defun sml-smie-backward-token ()
-  (let ((sym (sml-smie-backward-token-1)))
-    (unless (zerop (length sym))
-      ;; FIXME: what should we do if `sym' = "op" ?
-      (let ((point (point)))
-       (if (equal "op" (sml-smie-backward-token-1))
-           (concat "op " sym)
-         (goto-char point)
-         (cond
-          ((string= sym "=") (if (sml-smie-definitional-equal-p) "d=" "="))
-          ((string= sym "of") (if (sml-smie-non-nested-of-p) "=of" "of"))
-           ((string= sym "|") (if (sml-smie-datatype-|-p) "d|" "|"))
-          (t sym)))))))
+  (or
+   (when sml-smie--pending-token
+     (if (and (eq 'backward (car sml-smie--pending-token))
+              (eql (point) (nth 1 sml-smie--pending-token))
+              (nthcdr 2 sml-smie--pending-token))
+         (pop (nthcdr 2 sml-smie--pending-token))
+       (setq sml-smie--pending-token nil)))
+   (let ((sym (sml-smie-backward-token-1)))
+     (unless (zerop (length sym))
+       ;; FIXME: what should we do if `sym' = "op" ?
+       (let ((point (point)))
+        (if (equal "op" (sml-smie-backward-token-1))
+            (concat "op " sym)
+          (goto-char point)
+          (cond
+           ((string= sym "=") (if (sml-smie-definitional-equal-p) "d=" "="))
+           ((string= sym "of") (if (sml-smie-non-nested-of-p) "=of" "of"))
+            ((string= sym "|") (if (sml-smie-datatype-|-p) "d|" "|"))
+            ((string= sym "local")
+             (setq sml-smie--pending-token `(backward ,(point) "val"))
+             sym)
+           (t sym))))))))
 
 ;;;;
 ;;;; Imenu support
@@ -722,9 +738,8 @@ Assumes point is right before the | symbol."
     map)
   "Keymap for `sml-prog-proc-mode'.")
 
-(defvar sml-prog-proc--buffer nil
+(defvar-local sml-prog-proc--buffer nil
   "The inferior-process buffer to which to send code.")
-(make-variable-buffer-local 'sml-prog-proc--buffer)
 
 (cl-defstruct (sml-prog-proc-descriptor
             (:constructor sml-prog-proc-make)
@@ -764,7 +779,7 @@ Assumes point is right before the | symbol."
             (buf (sml-prog-proc--call run)))
         (with-current-buffer buf
           (if (and ppd (null sml-prog-proc-descriptor))
-              (set (make-local-variable 'sml-prog-proc-descriptor) ppd)))
+              (setq-local sml-prog-proc-descriptor ppd)))
         (setq sml-prog-proc--buffer buf)
         (get-buffer-process sml-prog-proc--buffer))))
 
@@ -929,7 +944,7 @@ Prefix arg AND-GO also means to switch to the 
read-eval-loop buffer afterwards."
      ;;     (setq dir (unless (equal newdir dir) newdir))))
      ;; (setq dir (or dir default-directory))
      ;; (list cmd dir)))
-  (set (make-local-variable 'sml-prog-proc--compile-command) command)
+  (setq-local sml-prog-proc--compile-command command)
   (save-some-buffers (not compilation-ask-about-save) nil)
   (let ((dir default-directory))
     (when (string-match "^\\s-*cd\\s-+\"\\([^\"]+\\)\"\\s-*;" command)
@@ -1237,16 +1252,14 @@ TAB file name completion, as in shell-mode, etc.."
   (add-hook 'next-error-hook 'inferior-sml-next-error-hook)
 
   ;; Make TAB add a " rather than a space at the end of a file name.
-  (set (make-local-variable 'comint-completion-addsuffix) '("/" . "\""))
+  (setq-local comint-completion-addsuffix '("/" . "\""))
 
-  (set (make-local-variable 'font-lock-defaults)
-       inferior-sml-font-lock-defaults)
+  (setq-local font-lock-defaults inferior-sml-font-lock-defaults)
 
   ;; Compilation support (used for `next-error').
-  (set (make-local-variable 'compilation-error-regexp-alist)
-       sml-error-regexp-alist)
+  (setq-local compilation-error-regexp-alist sml-error-regexp-alist)
   ;; FIXME: move it to sml-mode?
-  (set (make-local-variable 'compilation-error-screen-columns) nil)
+  (setq-local compilation-error-screen-columns nil)
 
   (setq mode-line-process '(": %s")))
 
@@ -1273,52 +1286,48 @@ TAB file name completion, as in shell-mode, etc.."
 
 ;;;###autoload
 (define-derived-mode sml-mode sml-prog-proc-mode "SML"
-  "\\<sml-mode-map>Major mode for editing Standard ML code.
+  "Major mode for editing Standard ML code.
 This mode runs `sml-mode-hook' just before exiting.
-See also (info \"(sml-mode)Top\").
-\\{sml-mode-map}"
-  (set (make-local-variable 'font-lock-defaults) sml-font-lock-defaults)
-  (set (make-local-variable 'prettify-symbols-alist)
-       sml-font-lock-symbols-alist)
-  (set (make-local-variable 'outline-regexp) sml-outline-regexp)
-  (set (make-local-variable 'imenu-create-index-function)
-       'sml-imenu-create-index)
-  (set (make-local-variable 'add-log-current-defun-function)
-       'sml-current-fun-name)
+See also (info \"(sml-mode)Top\")."
+  (setq-local font-lock-defaults sml-font-lock-defaults)
+  (setq-local prettify-symbols-alist sml-font-lock-symbols-alist)
+  (setq-local outline-regexp sml-outline-regexp)
+  (setq-local imenu-create-index-function #'sml-imenu-create-index)
+  (setq-local add-log-current-defun-function #'sml-current-fun-name)
   ;; Treat paragraph-separators in comments as paragraph-separators.
-  (set (make-local-variable 'paragraph-separate)
-       (concat "\\([ \t]*\\*)?\\)?\\(" paragraph-separate "\\)"))
-  (set (make-local-variable 'require-final-newline) t)
-  (set (make-local-variable 'electric-indent-chars)
-       (cons ?\; (if (boundp 'electric-indent-chars)
-                     electric-indent-chars '(?\n))))
-  (set (make-local-variable 'electric-layout-rules)
-       `((?\; . ,(lambda ()
-                   (save-excursion
-                     (skip-chars-backward " \t;")
-                     (unless (or (bolp)
-                                 (progn (skip-chars-forward " \t;")
-                                        (eolp)))
-                       'after))))))
+  (setq-local paragraph-separate
+              (concat "\\([ \t]*\\*)?\\)?\\(" paragraph-separate "\\)"))
+  (setq-local require-final-newline t)
+  (setq-local electric-indent-chars
+              (cons ?\; (if (boundp 'electric-indent-chars)
+                            electric-indent-chars '(?\n))))
+  (setq-local electric-layout-rules
+              `((?\; . ,(lambda ()
+                          (save-excursion
+                            (skip-chars-backward " \t;")
+                            (unless (or (bolp)
+                                        (progn (skip-chars-forward " \t;")
+                                               (eolp)))
+                              'after))))))
   (when sml-electric-pipe-mode
     (add-hook 'post-self-insert-hook #'sml-post-self-insert-pipe nil t))
   (sml-mode-variables))
 
 (defun sml-mode-variables ()
-  (set (make-local-variable 'sml-prog-proc-descriptor) sml-pp-functions)
+  (setq-local sml-prog-proc-descriptor sml-pp-functions)
   (set-syntax-table sml-mode-syntax-table)
   (setq local-abbrev-table sml-mode-abbrev-table)
   ;; Setup indentation and sexp-navigation.
   (smie-setup sml-smie-grammar #'sml-smie-rules
               :backward-token #'sml-smie-backward-token
               :forward-token #'sml-smie-forward-token)
-  (set (make-local-variable 'parse-sexp-ignore-comments) t)
-  (set (make-local-variable 'comment-start) "(* ")
-  (set (make-local-variable 'comment-end) " *)")
-  (set (make-local-variable 'comment-start-skip) "(\\*+\\s-*")
-  (set (make-local-variable 'comment-end-skip) "\\s-*\\*+)")
+  (setq-local parse-sexp-ignore-comments t)
+  (setq-local comment-start "(* ")
+  (setq-local comment-end " *)")
+  (setq-local comment-start-skip "(\\*+\\s-*")
+  (setq-local comment-end-skip "\\s-*\\*+)")
   ;; No need to quote nested comments markers.
-  (set (make-local-variable 'comment-quote-nested) nil))
+  (setq-local comment-quote-nested nil))
 
 (defun sml-funname-of-and ()
   "Name of the function this `and' defines, or nil if not a function.
@@ -1734,9 +1743,8 @@ MAINFILE is the top level file of the project."
 ;;;###autoload
 (define-derived-mode sml-cm-mode fundamental-mode "SML-CM"
   "Major mode for SML/NJ's Compilation Manager configuration files."
-  (set (make-local-variable 'sml-prog-proc-descriptor) sml-pp-functions)
-  (set (make-local-variable 'font-lock-defaults)
-       '(sml-cm-font-lock-keywords nil t nil nil)))
+  (setq-local sml-prog-proc-descriptor sml-pp-functions)
+  (setq-local font-lock-defaults '(sml-cm-font-lock-keywords nil t nil nil)))
 
 ;;;
 ;;; ML-Lex support
@@ -1753,7 +1761,7 @@ MAINFILE is the top level file of the project."
 ;;;###autoload
 (define-derived-mode sml-lex-mode sml-mode "SML-Lex"
   "Major Mode for editing ML-Lex files."
-  (set (make-local-variable 'font-lock-defaults) sml-lex-font-lock-defaults))
+  (setq-local font-lock-defaults sml-lex-font-lock-defaults))
 
 ;;;
 ;;; ML-Yacc support
@@ -1841,8 +1849,8 @@ If nil, align it with previous cases."
 ;;;###autoload
 (define-derived-mode sml-yacc-mode sml-mode "SML-Yacc"
   "Major Mode for editing ML-Yacc files."
-  (set (make-local-variable 'indent-line-function) 'sml-yacc-indent-line)
-  (set (make-local-variable 'font-lock-defaults) sml-yacc-font-lock-defaults))
+  (setq-local indent-line-function 'sml-yacc-indent-line)
+  (setq-local font-lock-defaults sml-yacc-font-lock-defaults))
 
 
 (provide 'sml-mode)
diff --git a/packages/sml-mode/testcases.sml b/packages/sml-mode/testcases.sml
index 7ed53f7..671aa4c 100644
--- a/packages/sml-mode/testcases.sml
+++ b/packages/sml-mode/testcases.sml
@@ -1,4 +1,4 @@
-(* Copyright 1999,2004,2007,2010-2016 Stefan Monnier <address@hidden> *)
+(* Copyright 1999-2020  Stefan Monnier <address@hidden> *)
 
 (* sml-mode here treats the second `=' as an equal op because it
  * thinks it's seeing something like "... type t = (s.t = ...)".  FIXME!  *)
@@ -120,14 +120,14 @@ val tut = fn (x,y)
              body
 val tut =
     (let
-        local
+       local
             val x = 1 in val x = x end
-        val a = 1 val b = 2
-        local val x = 1 in val x = x end
-        local val x = 1 in val x = x end
-            local val x = 1 in val x = x end (* fixindent *)
-            local val x = 1 in val x = x end
-            val c = 3
+       val a = 1 val b = 2
+       local val x = 1 in val x = x end
+       local val x = 1 in val x = x end
+          local val x = 1 in val x = x end (* fixindent *)
+          local val x = 1 in val x = x end
+          val c = 3
     in
        let
             val x = 3