[Emacs-diffs] /srv/bzr/emacs/trunk r100350: Fix handling of non-associative equal levels.

[Stefan Monnier]

------------------------------------------------------------
revno: 100350
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2010-05-18 12:03:51 -0400
message:
  Fix handling of non-associative equal levels.
  * emacs-lisp/smie.el (smie-prec2-levels): Choose distinct levels even
  when it's not needed.
  (smie-op-left, smie-op-right): New functions.
  (smie-next-sexp): New function, extracted from smie-backward-sexp.
  Better handle equal levels to distinguish the associative case from
  the "multi-keyword construct" case.
  (smie-backward-sexp, smie-forward-sexp): Use it.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/smie.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-05-18 08:33:29 +0000
+++ b/lisp/ChangeLog    2010-05-18 16:03:51 +0000
@@ -1,3 +1,14 @@
+2010-05-18  Stefan Monnier  <address@hidden>
+
+       Fix handling of non-associative equal levels.
+       * emacs-lisp/smie.el (smie-prec2-levels): Choose distinct levels even
+       when it's not needed.
+       (smie-op-left, smie-op-right): New functions.
+       (smie-next-sexp): New function, extracted from smie-backward-sexp.
+       Better handle equal levels to distinguish the associative case from
+       the "multi-keyword construct" case.
+       (smie-backward-sexp, smie-forward-sexp): Use it.
+
 2010-05-18  Juanma Barranquero  <address@hidden>
 
        * progmodes/prolog.el (smie-indent-basic): Declare for byte-compiler.

=== modified file 'lisp/emacs-lisp/smie.el'
--- a/lisp/emacs-lisp/smie.el   2010-05-18 07:44:07 +0000
+++ b/lisp/emacs-lisp/smie.el   2010-05-18 16:03:51 +0000
@@ -252,11 +252,23 @@
           (dolist (cst csts)
             (unless (memq (car cst) rhvs)
               (setq progress t)
+              ;; We could give each var in a given iteration the same value,
+              ;; but we can also give them arbitrarily different values.
+              ;; Basically, these are vars between which there is no
+              ;; constraint (neither equality nor inequality), so
+              ;; anything will do.
+              ;; We give them arbitrary values, which means that we
+              ;; replace the "no constraint" case with either > or <
+              ;; but not =.  The reason we do that is so as to try and
+              ;; distinguish associative operators (which will have
+              ;; left = right).
+              (unless (caar cst)
               (setcar (car cst) i)
+                (incf i))
               (setq csts (delq cst csts))))
           (unless progress
             (error "Can't resolve the precedence table to precedence levels")))
-        (incf i))
+        (incf i 10))
       ;; Propagate equalities back to their source.
       (dolist (eq (nreverse eqs))
         (assert (null (caar eq)))
@@ -278,6 +290,9 @@
 Each element is of the form (TOKEN LEFT-LEVEL RIGHT-LEVEL).
 Parsing is done using an operator precedence parser.")
 
+(defalias 'smie-op-left 'car)
+(defalias 'smie-op-right 'cadr)
+
 (defun smie-backward-token ()
   ;; FIXME: This may be an OK default but probably needs a hook.
   (buffer-substring (point)
@@ -292,6 +307,89 @@
                                (skip-syntax-forward "w_'"))
                            (point))))
 
+(defun smie-associative-p (toklevels)
+  ;; in "a + b + c" we want to stop at each +, but in
+  ;; "if a then b else c" we don't want to stop at each keyword.
+  ;; To distinguish the two cases, we made smie-prec2-levels choose
+  ;; different levels for each part of "if a then b else c", so that
+  ;; by checking if the left-level is equal to the right level, we can
+  ;; figure out that it's an associative operator.
+  ;; This is not 100% foolproof, tho, since a grammar like
+  ;;   (exp ("A" exp "C") ("A" exp "B" exp "C"))
+  ;; will cause "B" to have equal left and right levels, even though
+  ;; it is not an associative operator.
+  ;; A better check would be the check the actual previous operator
+  ;; against this one to see if it's the same, but we'd have to change
+  ;; `levels' to keep a stack of operators rather than only levels.
+  (eq (smie-op-left toklevels) (smie-op-right toklevels)))
+
+(defun smie-next-sexp (next-token next-sexp op-forw op-back halfsexp)
+  "Skip over one sexp.
+NEXT-TOKEN is a function of no argument that moves forward by one
+token (after skipping comments if needed) and returns it.
+NEXT-SEXP is a lower-level function to skip one sexp.
+OP-FORW is the accessor to the forward level of the level data.
+OP-BACK is the accessor to the backward level of the level data.
+HALFSEXP if non-nil, means skip over a partial sexp if needed.  I.e. if the
+first token we see is an operator, skip over its left-hand-side argument.
+Possible return values:
+  (FORW-LEVEL POS TOKEN): we couldn't skip TOKEN because its back-level
+    is too high.  FORW-LEVEL is the forw-level of TOKEN,
+    POS is its start position in the buffer.
+  (t POS TOKEN): same thing when we bump on the wrong side of a paren.
+  (nil POS TOKEN): we skipped over a paren-like pair.
+  nil: we skipped over an identifier, matched parentheses, ..."
+  (catch 'return
+    (let ((levels ()))
+      (while
+          (let* ((pos (point))
+                 (token (funcall next-token))
+                 (toklevels (cdr (assoc token smie-op-levels))))
+
+            (cond
+             ((null toklevels)
+              (if (equal token "")
+                  (condition-case err
+                      (progn (goto-char pos) (funcall next-sexp 1) nil)
+                    (scan-error (throw 'return (list t (caddr err)))))))
+             ((null (funcall op-back toklevels))
+              ;; A token like a paren-close.
+              (assert (funcall op-forw toklevels)) ;Otherwise, why mention it?
+              (push (funcall op-forw toklevels) levels))
+             (t
+              (while (and levels (< (funcall op-back toklevels) (car levels)))
+                (setq levels (cdr levels)))
+              (cond
+               ((null levels)
+                (if (and halfsexp (funcall op-forw toklevels))
+                    (push (funcall op-forw toklevels) levels)
+                  (throw 'return
+                         (prog1 (list (or (car toklevels) t) (point) token)
+                           (goto-char pos)))))
+               (t
+                (if (and levels (= (funcall op-back toklevels) (car levels)))
+                    (setq levels (cdr levels)))
+                (cond
+                 ((null levels)
+                  (cond
+                   ((null (funcall op-forw toklevels))
+                    (throw 'return (list nil (point) token)))
+                   ((smie-associative-p toklevels)
+                    (throw 'return
+                           (prog1 (list (or (car toklevels) t) (point) token)
+                             (goto-char pos))))
+                   ;; We just found a match to the previously pending operator
+                   ;; but this new operator is still part of a larger RHS.
+                   ;; E.g. we're now looking at the "then" in
+                   ;; "if a then b else c".  So we have to keep parsing the
+                   ;; rest of the construct.
+                   (t (push (funcall op-forw toklevels) levels))))
+                 (t
+                  (if (funcall op-forw toklevels)
+                      (push (funcall op-forw toklevels) levels))))))))
+            levels)
+        (setq halfsexp nil)))))
+
 (defun smie-backward-sexp (&optional halfsexp)
   "Skip over one sexp.
 HALFSEXP if non-nil, means skip over a partial sexp if needed.  I.e. if the
@@ -304,52 +402,12 @@
   (nil POS TOKEN): we skipped over a paren-like pair.
   nil: we skipped over an identifier, matched parentheses, ..."
   (if (bobp) (list t (point))
-    (catch 'return
-      (let ((levels ()))
-        (while
-            (let* ((pos (point))
-                   (token (progn (forward-comment (- (point-max)))
-                                 (smie-backward-token)))
-                   (toklevels (cdr (assoc token smie-op-levels))))
-
-              (cond
-               ((null toklevels)
-                (if (equal token "")
-                    (condition-case err
-                        (progn (goto-char pos) (backward-sexp 1) nil)
-                      (scan-error (throw 'return (list t (caddr err)))))))
-               ((null (nth 1 toklevels))
-                ;; A token like a paren-close.
-                (assert (nth 0 toklevels)) ;Otherwise, why mention it?
-                (push (nth 0 toklevels) levels))
-               (t
-                (while (and levels (< (nth 1 toklevels) (car levels)))
-                  (setq levels (cdr levels)))
-                (cond
-                 ((null levels)
-                  (if (and halfsexp (nth 0 toklevels))
-                      (push (nth 0 toklevels) levels)
-                    (throw 'return
-                           (prog1 (list (or (car toklevels) t) (point) token)
-                             (goto-char pos)))))
-                 (t
-                  (while (and levels (= (nth 1 toklevels) (car levels)))
-                    (setq levels (cdr levels)))
-                  (cond
-                   ((null levels)
-                    (cond
-                     ((null (nth 0 toklevels))
-                      (throw 'return (list nil (point) token)))
-                     ((eq (nth 0 toklevels) (nth 1 toklevels))
-                      (throw 'return
-                             (prog1 (list (or (car toklevels) t) (point) token)
-                               (goto-char pos))))
-                     (t (debug))))      ;Not sure yet what to do here.
-                   (t
-                    (if (nth 0 toklevels)
-                        (push (nth 0 toklevels) levels))))))))
-              levels)
-          (setq halfsexp nil))))))
+    (smie-next-sexp
+     (lambda () (forward-comment (- (point-max))) (smie-backward-token))
+     (indirect-function 'backward-sexp)
+     (indirect-function 'smie-op-left)
+     (indirect-function 'smie-op-right)
+     halfsexp)))
 
 ;; Mirror image, not used for indentation.
 (defun smie-forward-sexp (&optional halfsexp)
@@ -364,52 +422,12 @@
   (nil POS TOKEN): we skipped over a paren-like pair.
   nil: we skipped over an identifier, matched parentheses, ..."
   (if (eobp) (list t (point))
-    (catch 'return
-      (let ((levels ()))
-        (while
-            (let* ((pos (point))
-                   (token (progn (forward-comment (point-max))
-                                 (smie-forward-token)))
-                   (toklevels (cdr (assoc token smie-op-levels))))
-
-              (cond
-               ((null toklevels)
-                (if (equal token "")
-                    (condition-case err
-                        (progn (goto-char pos) (forward-sexp 1) nil)
-                      (scan-error (throw 'return (list t (caddr err)))))))
-               ((null (nth 0 toklevels))
-                ;; A token like a paren-close.
-                (assert (nth 1 toklevels)) ;Otherwise, why mention it?
-                (push (nth 1 toklevels) levels))
-               (t
-                (while (and levels (< (nth 0 toklevels) (car levels)))
-                  (setq levels (cdr levels)))
-                (cond
-                 ((null levels)
-                  (if (and halfsexp (nth 1 toklevels))
-                      (push (nth 1 toklevels) levels)
-                    (throw 'return
-                           (prog1 (list (or (nth 1 toklevels) t) (point) token)
-                             (goto-char pos)))))
-                 (t
-                  (while (and levels (= (nth 0 toklevels) (car levels)))
-                    (setq levels (cdr levels)))
-                  (cond
-                   ((null levels)
-                    (cond
-                     ((null (nth 1 toklevels))
-                      (throw 'return (list nil (point) token)))
-                     ((eq (nth 1 toklevels) (nth 0 toklevels))
-                      (throw 'return
-                             (prog1 (list (or (nth 1 toklevels) t) (point) 
token)
-                               (goto-char pos))))
-                     (t (debug))))      ;Not sure yet what to do here.
-                   (t
-                    (if (nth 1 toklevels)
-                        (push (nth 1 toklevels) levels))))))))
-              levels)
-          (setq halfsexp nil))))))
+    (smie-next-sexp
+     (lambda () (forward-comment (point-max)) (smie-forward-token))
+     (indirect-function 'forward-sexp)
+     (indirect-function 'smie-op-right)
+     (indirect-function 'smie-op-left)
+     halfsexp)))
 
 (defun smie-backward-sexp-command (&optional n)
   "Move backward through N logical elements."