[Emacs-diffs] /srv/bzr/emacs/trunk r101491: * lisp/emacs-lisp/smie.el (smie-bnf-precedence-table): Improve error message.

[Stefan Monnier]

------------------------------------------------------------
revno: 101491
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Sun 2010-09-19 16:52:37 +0200
message:
  * lisp/emacs-lisp/smie.el (smie-bnf-precedence-table): Improve error message.
  (smie-debug--prec2-cycle, smie-debug--describe-cycle): New functions.
  (smie-prec2-levels): Use them to better diagnose precedence cycles.
  (smie-blink-matching-check): Don't signal a mismatch if car is t.
  (smie-blink-matching-open): Rewrite to remove assumptions, so that
  something like "." can also be a closer.
  (smie--associative-p, smie-indent--hanging-p, smie-indent--bolp)
  (smie-indent--offset, smie-indent--offset-rule, smie-indent--column):
  Rename internal functions to use "--".  Update callers.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/smie.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-09-19 09:53:28 +0000
+++ b/lisp/ChangeLog    2010-09-19 14:52:37 +0000
@@ -1,5 +1,15 @@
 2010-09-19  Stefan Monnier  <address@hidden>
 
+       * emacs-lisp/smie.el (smie-bnf-precedence-table): Improve error message.
+       (smie-debug--prec2-cycle, smie-debug--describe-cycle): New functions.
+       (smie-prec2-levels): Use them to better diagnose precedence cycles.
+       (smie-blink-matching-check): Don't signal a mismatch if car is t.
+       (smie-blink-matching-open): Rewrite to remove assumptions, so that
+       something like "." can also be a closer.
+       (smie--associative-p, smie-indent--hanging-p, smie-indent--bolp)
+       (smie-indent--offset, smie-indent--offset-rule, smie-indent--column):
+       Rename internal functions to use "--".  Update callers.
+
        * frame.el (make-frame-names-alist): Don't list frames on other 
displays.
 
        * fringe.el (fringe-styles): New var.

=== modified file 'lisp/emacs-lisp/smie.el'
--- a/lisp/emacs-lisp/smie.el   2010-09-03 11:18:45 +0000
+++ b/lisp/emacs-lisp/smie.el   2010-09-19 14:52:37 +0000
@@ -159,7 +159,8 @@
             (last-nts ())
             (first-nts ()))
         (dolist (rhs (cdr rules))
-          (assert (consp rhs))
+          (unless (consp rhs)
+            (signal 'wrong-type-argument `(consp ,rhs)))
           (if (not (member (car rhs) nts))
               (pushnew (car rhs) first-ops)
             (pushnew (car rhs) first-nts)
@@ -307,6 +308,40 @@
     (nreverse alist)))
     
 
+(defun smie-debug--prec2-cycle (csts)
+  "Return a cycle in CSTS, assuming there's one.
+CSTS is a list of pairs representing arcs in a graph."
+  ;; A PATH is of the form (START . REST) where REST is a reverse
+  ;; list of nodes through which the path goes.
+  (let ((paths (mapcar (lambda (pair) (list (car pair) (cdr pair))) csts))
+        (cycle nil))
+    (while (null cycle)
+      (dolist (path (prog1 paths (setq paths nil)))
+        (dolist (cst csts)
+          (when (eq (car cst) (nth 1 path))
+            (if (eq (cdr cst) (car path))
+                (setq cycle path)
+              (push (cons (car path) (cons (cdr cst) (cdr path)))
+                    paths))))))
+    (cons (car cycle) (nreverse (cdr cycle)))))
+            
+(defun smie-debug--describe-cycle (table cycle)
+  (let ((names
+         (mapcar (lambda (val)
+                   (let ((res nil))
+                     (dolist (elem table)
+                       (if (eq (cdr elem) val)
+                           (push (concat "." (car elem)) res))
+                       (if (eq (cddr elem) val)
+                           (push (concat (car elem) ".") res)))
+                     (assert res)
+                     res))
+                 cycle)))
+    (mapconcat
+     (lambda (elems) (mapconcat 'indentity elems "="))
+     (append names (list (car names)))
+     " < ")))
+
 (defun smie-prec2-levels (prec2)
   ;; FIXME: Rather than only return an alist of precedence levels, we should
   ;; also extract other useful data from it:
@@ -387,7 +422,9 @@
                 (incf i))
               (setq csts (delq cst csts))))
           (unless progress
-            (error "Can't resolve the precedence table to precedence levels")))
+            (error "Can't resolve the precedence cycle: %s"
+                   (smie-debug--describe-cycle
+                    table (smie-debug--prec2-cycle csts)))))
         (incf i 10))
       ;; Propagate equalities back to their source.
       (dolist (eq (nreverse eqs))
@@ -450,7 +487,7 @@
               (skip-syntax-forward "w_'"))
           (point))))
 
-(defun smie-associative-p (toklevels)
+(defun smie--associative-p (toklevels)
   ;; in "a + b + c" we want to stop at each +, but in
   ;; "if a then b elsif c then d else c" we don't want to stop at each keyword.
   ;; To distinguish the two cases, we made smie-prec2-levels choose
@@ -535,13 +572,13 @@
                    ;; If the new operator is not the last in the BNF rule,
                    ;; ans is not associative, it's one of the inner operators
                    ;; (like the "in" in "let .. in .. end"), so keep looking.
-                   ((not (smie-associative-p toklevels))
+                   ((not (smie--associative-p toklevels))
                     (push toklevels levels))
                    ;; The new operator is associative.  Two cases:
                    ;; - it's really just an associative operator (like + or ;)
                    ;;   in which case we should have stopped right before.
                    ((and lastlevels
-                         (smie-associative-p (car lastlevels)))
+                         (smie--associative-p (car lastlevels)))
                     (throw 'return
                            (prog1 (list (or (car toklevels) t) (point) token)
                              (goto-char pos))))
@@ -720,6 +757,7 @@
         ;; This not is one of the begin..end we know how to check.
         (blink-matching-check-mismatch start end))
        ((not start) t)
+       ((eq t (car (rassoc ender smie-closer-alist))) nil)
        (t
         (goto-char start)
         (let ((starter (funcall smie-forward-token-function)))
@@ -732,45 +770,42 @@
              smie-closer-alist                     ; Optimization.
              (eq (char-before) last-command-event) ; Sanity check.
              (memq last-command-event smie-blink-matching-triggers)
-             (save-excursion
-               ;; FIXME: Here we assume that closers all end
-               ;; with a word-syntax char.
-               (unless (eq ?\w (char-syntax last-command-event))
-                (forward-char -1))
-               (and (looking-at "\\>")
-                    (not (nth 8 (syntax-ppss))))))
+             (not (nth 8 (syntax-ppss))))
     (save-excursion
       (let ((pos (point))
             (token (funcall smie-backward-token-function)))
-        (if (= 1 (length token))
-            ;; The trigger char is itself a token but is not
-            ;; one of the closers (e.g. ?\; in Octave mode),
-            ;; so go back to the previous token
-           (setq token (save-excursion
-                         (funcall smie-backward-token-function)))
-         (goto-char pos))
-       ;; Here we assume that smie-backward-token-function
-       ;; returns a token that is a string and whose content
-       ;; match the buffer's representation of this token.
-       (when (and (> (length token) 1) (stringp token)
-                  (memq (aref token (1- (length token)))
-                        smie-blink-matching-triggers)
-                  (not (eq (aref token (1- (length token)))
-                           last-command-event)))
-         ;; Token ends with a trigger char, so don't blink for
-         ;; anything else than this trigger char, lest we'd blink
-         ;; both when inserting the trigger char and when inserting a
-         ;; subsequent SPC.
-         (setq token nil))
-        (when (and (rassoc token smie-closer-alist)
-                   (or smie-blink-matching-inners
-                       (null (nth 2 (assoc token smie-op-levels)))))
-          ;; The major mode might set blink-matching-check-function
-          ;; buffer-locally so that interactive calls to
-          ;; blink-matching-open work right, but let's not presume
-          ;; that's the case.
-          (let ((blink-matching-check-function #'smie-blink-matching-check))
-            (blink-matching-open)))))))
+        (when (and (eq (point) (1- pos))
+                   (= 1 (length token))
+                   (not (rassoc token smie-closer-alist)))
+          ;; The trigger char is itself a token but is not one of the
+          ;; closers (e.g. ?\; in Octave mode), so go back to the
+          ;; previous token.
+          (setq pos (point))
+          (setq token (save-excursion
+                        (funcall smie-backward-token-function))))
+        (when (rassoc token smie-closer-alist)
+          ;; We're after a close token.  Let's still make sure we
+          ;; didn't skip a comment to find that token.
+          (funcall smie-forward-token-function)
+          (when (and (save-excursion
+                       ;; Trigger can be SPC, or reindent.
+                       (skip-chars-forward " \n\t")
+                       (>= (point) pos))
+                     ;; If token ends with a trigger char, so don't blink for
+                     ;; anything else than this trigger char, lest we'd blink
+                     ;; both when inserting the trigger char and when
+                     ;; inserting a subsequent trigger char like SPC.
+                     (or (eq (point) pos)
+                         (not (memq (char-before)
+                                    smie-blink-matching-triggers)))
+                     (or smie-blink-matching-inners
+                         (null (nth 2 (assoc token smie-op-levels)))))
+            ;; The major mode might set blink-matching-check-function
+            ;; buffer-locally so that interactive calls to
+            ;; blink-matching-open work right, but let's not presume
+            ;; that's the case.
+            (let ((blink-matching-check-function #'smie-blink-matching-check))
+              (blink-matching-open))))))))
 
 ;;; The indentation engine.
 
@@ -821,7 +856,7 @@
 A nil offset for indentation after an opening token defaults
 to `smie-indent-basic'.")
 
-(defun smie-indent-hanging-p ()
+(defun smie-indent--hanging-p ()
   ;; A hanging keyword is one that's at the end of a line except it's not at
   ;; the beginning of a line.
   (and (save-excursion
@@ -832,17 +867,17 @@
          (eolp))
        (not (smie-bolp))))
 
-(defun smie-bolp ()
+(defun smie-indent--bolp ()
   (save-excursion (skip-chars-backward " \t") (bolp)))
 
-(defun smie-indent-offset (elem)
+(defun smie-indent--offset (elem)
   (or (cdr (assq elem smie-indent-rules))
       (cdr (assq t smie-indent-rules))
       smie-indent-basic))
 
 (defvar smie-indent-debug-log)
 
-(defun smie-indent-offset-rule (tokinfo &optional after parent)
+(defun smie-indent--offset-rule (tokinfo &optional after parent)
   "Apply the OFFSET-RULES in TOKINFO.
 Point is expected to be right in front of the token corresponding to TOKINFO.
 If computing the indentation after the token, then AFTER is the position
@@ -857,10 +892,10 @@
          ((not (consp rule)) (setq offset rule))
          ((eq (car rule) '+) (setq offset rule))
          ((eq (car rule) :hanging)
-          (when (smie-indent-hanging-p)
+          (when (smie-indent--hanging-p)
             (setq rules (cdr rule))))
          ((eq (car rule) :bolp)
-          (when (smie-bolp)
+          (when (smie-indent--bolp)
             (setq rules (cdr rule))))
          ((eq (car rule) :eolp)
           (unless after
@@ -900,13 +935,13 @@
       (push (list (point) offset tokinfo) smie-indent-debug-log))
     offset))
 
-(defun smie-indent-column (offset &optional base parent virtual-point)
+(defun smie-indent--column (offset &optional base parent virtual-point)
   "Compute the actual column to use for a given OFFSET.
 BASE is the base position to use, and PARENT is the parent info, if any.
 If VIRTUAL-POINT is non-nil, then `point' is virtual."
   (cond
    ((eq (car-safe offset) '+)
-    (apply '+ (mapcar (lambda (offset) (smie-indent-column offset nil parent))
+    (apply '+ (mapcar (lambda (offset) (smie-indent--column offset nil parent))
                       (cdr offset))))
    ((integerp offset)
     (+ offset
@@ -941,7 +976,7 @@
     (smie-indent-virtual))
    ((eq offset nil) nil)
    ((and (symbolp offset) (boundp 'offset))
-    (smie-indent-column (symbol-value offset) base parent virtual-point))
+    (smie-indent--column (symbol-value offset) base parent virtual-point))
    (t (error "Unknown indentation offset %s" offset))))
 
 (defun smie-indent-forward-token ()
@@ -974,11 +1009,11 @@
 need to compute the column at which point should be indented
 in order to figure out the indentation of some other (further down) point."
   ;; Trust pre-existing indentation on other lines.
-  (if (smie-bolp) (current-column) (smie-indent-calculate)))
+  (if (smie-indent--bolp) (current-column) (smie-indent-calculate)))
 
 (defun smie-indent-fixindent ()
   ;; Obey the `fixindent' special comment.
-  (and (smie-bolp)
+  (and (smie-indent--bolp)
        (save-excursion
          (comment-normalize-vars)
          (re-search-forward (concat comment-start-skip
@@ -1018,14 +1053,14 @@
           (save-excursion
             (goto-char pos)
             ;; Different cases:
-            ;; - smie-bolp: "indent according to others".
+            ;; - smie-indent--bolp: "indent according to others".
             ;; - common hanging: "indent according to others".
             ;; - SML-let hanging: "indent like parent".
             ;; - if-after-else: "indent-like parent".
             ;; - middle-of-line: "trust current position".
             (cond
              ((null (cdr toklevels)) nil) ;Not a keyword.
-             ((smie-bolp)
+             ((smie-indent--bolp)
               ;; For an open-paren-like thingy at BOL, always indent only
               ;; based on other rules (typically smie-indent-after-keyword).
               nil)
@@ -1037,8 +1072,8 @@
                                   ;; By default use point unless we're hanging.
                                   `((:before . ,token) (:hanging nil) point)))
                      ;; (after (prog1 (point) (goto-char pos)))
-                     (offset (smie-indent-offset-rule tokinfo)))
-                (smie-indent-column offset)))))
+                     (offset (smie-indent--offset-rule tokinfo)))
+                (smie-indent--column offset)))))
 
         ;; FIXME: This still looks too much like black magic!!
         ;; FIXME: Rather than a bunch of rules like (PARENT . TOKEN), we
@@ -1054,7 +1089,7 @@
                       point)))
                (offset (save-excursion
                          (goto-char pos)
-                         (smie-indent-offset-rule tokinfo nil parent))))
+                         (smie-indent--offset-rule tokinfo nil parent))))
           ;; Different behaviors:
           ;; - align with parent.
           ;; - parent + offset.
@@ -1079,10 +1114,10 @@
             nil)
            ((eq (car parent) (car toklevels))
             ;; We bumped into a same-level operator. align with it.
-            (if (and (smie-bolp) (/= (point) pos)
+            (if (and (smie-indent--bolp) (/= (point) pos)
                      (save-excursion
                        (goto-char (goto-char (cadr parent)))
-                       (not (smie-bolp)))
+                       (not (smie-indent--bolp)))
                      ;; Check the offset of `token' rather then its parent
                      ;; because its parent may have used a special rule.  E.g.
                      ;;    function foo;
@@ -1119,7 +1154,7 @@
               ;; So as to align with the earliest appropriate place.
               (smie-indent-virtual)))
            (tokinfo
-            (if (and (= (point) pos) (smie-bolp)
+            (if (and (= (point) pos) (smie-indent--bolp)
                      (or (eq offset 'point)
                          (and (consp offset) (memq 'point offset))))
                 ;; Since we started at BOL, we're not computing a virtual
@@ -1127,7 +1162,7 @@
                 ;; we can't use `current-column' which would cause
                 ;; indentation to depend on itself.
                 nil
-              (smie-indent-column offset 'parent parent
+              (smie-indent--column offset 'parent parent
                                   ;; If we're still at pos, indent-virtual
                                   ;; will inf-loop.
                                   (unless (= (point) pos) 'virtual))))))))))
@@ -1137,7 +1172,7 @@
   ;; Don't do it for virtual indentations.  We should normally never be "in
   ;; front of a comment" when doing virtual-indentation anyway.  And if we are
   ;; (as can happen in octave-mode), moving forward can lead to inf-loops.
-  (and (smie-bolp)
+  (and (smie-indent--bolp)
        (looking-at comment-start-skip)
        (save-excursion
          (forward-comment (point-max))
@@ -1178,13 +1213,13 @@
           ;; Using the BNF syntax, we could come up with better
           ;; defaults, but we only have the precedence levels here.
           (setq tokinfo (list tok 'default-rule
-                              (if (cadr toklevel) 0 (smie-indent-offset t)))))
+                              (if (cadr toklevel) 0 (smie-indent--offset t)))))
         (let ((offset
-               (or (smie-indent-offset-rule tokinfo pos)
-                   (smie-indent-offset t))))
+               (or (smie-indent--offset-rule tokinfo pos)
+                   (smie-indent--offset t))))
           (let ((before (point)))
             (goto-char pos)
-            (smie-indent-column offset before)))))))
+            (smie-indent--column offset before)))))))
 
 (defun smie-indent-exps ()
   ;; Indentation of sequences of simple expressions without
@@ -1207,7 +1242,7 @@
           arg)
       (while (and (null (car (smie-backward-sexp)))
                   (push (point) positions)
-                  (not (smie-bolp))))
+                  (not (smie-indent--bolp))))
       (save-excursion
         ;; Figure out if the atom we just skipped is an argument rather
         ;; than a function.
@@ -1232,8 +1267,8 @@
        (positions
         ;; We're the first arg.
         (goto-char (car positions))
-        ;; FIXME: Use smie-indent-column.
-        (+ (smie-indent-offset 'args)
+        ;; FIXME: Use smie-indent--column.
+        (+ (smie-indent--offset 'args)
            ;; We used to use (smie-indent-virtual), but that
            ;; doesn't seem right since it might then indent args less than
            ;; the function itself.