From 472e7ec1e16f2f487e0e788f77fc9f3009b204b4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 18 May 2010 12:03:51 -0400 Subject: [PATCH] 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. --- lisp/ChangeLog | 11 +++ lisp/emacs-lisp/smie.el | 200 ++++++++++++++++++++++------------------ 2 files changed, 120 insertions(+), 91 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3cf8b43a796..91265a15bbf 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,14 @@ +2010-05-18 Stefan Monnier + + 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 * progmodes/prolog.el (smie-indent-basic): Declare for byte-compiler. diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 27ddeb762af..0e7b0dc19ca 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -252,11 +252,23 @@ PREC2 is a table as returned by `smie-precs-precedence-table' or (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 @@ PREC2 is a table as returned by `smie-precs-precedence-table' or 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,64 +307,107 @@ Parsing is done using an operator precedence parser.") (skip-syntax-forward "w_'")) (point)))) -(defun smie-backward-sexp (&optional halfsexp) +(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: - (LEFT-LEVEL POS TOKEN): we couldn't skip TOKEN because its right-level - is too high. LEFT-LEVEL is the left-level of TOKEN, + (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 but for an open-paren or the beginning of 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, ..." - (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)))) - + (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 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)) + ((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 - (while (and levels (< (nth 1 toklevels) (car levels))) - (setq levels (cdr levels))) + (if (and levels (= (funcall op-back toklevels) (car levels))) + (setq levels (cdr levels))) (cond ((null levels) - (if (and halfsexp (nth 0 toklevels)) - (push (nth 0 toklevels) 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))))) + (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 - (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)))))) + (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. +Possible return values: + (LEFT-LEVEL POS TOKEN): we couldn't skip TOKEN because its right-level + is too high. LEFT-LEVEL is the left-level of TOKEN, + 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) @@ -364,52 +422,12 @@ Possible return values: (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." -- 2.39.2