comparison lisp/emacs-lisp/smie.el @ 108649:c9e786f54683

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.

108648:6d142dd06f97

        (let ((rhvs (mapcar 'cdr csts))
              (progress nil))
          (dolist (cst csts)
            (unless (memq (car cst) rhvs)
              (setq progress t)
              (setcar (car cst) i)
              (setq csts (delq cst csts))))
          (unless progress
            (error "Can't resolve the precedence table to precedence levels")))
        (incf i))
      ;; Propagate equalities back to their source.
      (dolist (eq (nreverse eqs))
        (assert (null (caar eq)))
        (setcar (car eq) (cadr eq)))
      ;; Finally, fill in the remaining vars (which only appeared on the

(defvar smie-op-levels 'unset
  "List of token parsing info.
Each element is of the form (TOKEN LEFT-LEVEL RIGHT-LEVEL).
Parsing is done using an operator precedence parser.")

(defun smie-backward-token ()
  ;; FIXME: This may be an OK default but probably needs a hook.
  (buffer-substring (point)
                    (progn (if (zerop (skip-syntax-backward "."))
                               (skip-syntax-backward "w_'"))

  ;; FIXME: This may be an OK default but probably needs a hook.
  (buffer-substring (point)
                    (progn (if (zerop (skip-syntax-forward "."))
                               (skip-syntax-forward "w_'"))
                           (point))))

(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
first token we see is an operator, skip over its left-hand-side argument.

    POS is its start position in the buffer.
  (t POS TOKEN): same thing but for an open-paren or the beginning of buffer.
  (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))))))

;; Mirror image, not used for indentation.
(defun smie-forward-sexp (&optional halfsexp)
  "Skip over one sexp.
HALFSEXP if non-nil, means skip over a partial sexp if needed.  I.e. if the

    POS is its end position in the buffer.
  (t POS TOKEN): same thing but for an open-paren or the beginning of buffer.
  (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))))))

(defun smie-backward-sexp-command (&optional n)
  "Move backward through N logical elements."
  (interactive "p")
  (if (< n 0)

108649:c9e786f54683

        (let ((rhvs (mapcar 'cdr csts))
              (progress nil))
          (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 10))
      ;; Propagate equalities back to their source.
      (dolist (eq (nreverse eqs))
        (assert (null (caar eq)))
        (setcar (car eq) (cadr eq)))
      ;; Finally, fill in the remaining vars (which only appeared on the

(defvar smie-op-levels 'unset
  "List of token parsing info.
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)
                    (progn (if (zerop (skip-syntax-backward "."))
                               (skip-syntax-backward "w_'"))

  ;; FIXME: This may be an OK default but probably needs a hook.
  (buffer-substring (point)
                    (progn (if (zerop (skip-syntax-forward "."))
                               (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
first token we see is an operator, skip over its left-hand-side argument.

    POS is its start position in the buffer.
  (t POS TOKEN): same thing but for an open-paren or the beginning of buffer.
  (nil POS TOKEN): we skipped over a paren-like pair.
  nil: we skipped over an identifier, matched parentheses, ..."
  (if (bobp) (list t (point))
    (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)
  "Skip over one sexp.
HALFSEXP if non-nil, means skip over a partial sexp if needed.  I.e. if the

    POS is its end position in the buffer.
  (t POS TOKEN): same thing but for an open-paren or the beginning of buffer.
  (nil POS TOKEN): we skipped over a paren-like pair.
  nil: we skipped over an identifier, matched parentheses, ..."
  (if (eobp) (list t (point))
    (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."
  (interactive "p")
  (if (< n 0)