procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix handling of non-associative equal levels.

Browse source 
* 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.
This commit is contained in:
Stefan Monnier 2010-05-18 12:03:51 -04:00
parent 1fc0ce04bc
commit 472e7ec1e1
2 changed files with 122 additions and 93 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
lisp/ChangeLog
View file

@ -1,3 +1,14 @@
2010-05-18 Stefan Monnier <monnier@iro.umontreal.ca>
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 <lekktu@gmail.com>
* progmodes/prolog.el (smie-indent-basic): Declare for byte-compiler.

204
lisp/emacs-lisp/smie.el
View file

@ -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,6 +307,89 @@ Parsing is done using an operator precedence parser.")
(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 @@ Possible return values:
(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 @@ 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."