emacs: lisp/emacs-lisp/smie.el comparison

comparison lisp/emacs-lisp/smie.el @ 110429:06323f4d421b

* 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.

author	Stefan Monnier <monnier@iro.umontreal.ca>
date	Sun, 19 Sep 2010 16:52:37 +0200
parents	eb977e012180
children	6b2714f6bd1f

comparison

equal deleted inserted replaced

-:6060b86fc551
+:06323f4d421b
 (last-ops ())
 (first-ops ())
 (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)
 (when (consp (cdr rhs))
 ;; If the first is not an OP we add the second (which
 (dolist (term (reverse (cdr rhs)))
 (unless (member term nts)
 (pushnew (cons (car rhs) term) alist :test #'equal)))))))
 (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:
 ;; - matching sets of block openers&closers (which can otherwise become
 (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")))
+(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))
 (assert (or (null (caar eq)) (eq (car eq) (cdr eq))))
 (setcar (car eq) (cadr eq)))
 (point)
 (progn (if (zerop (skip-syntax-forward "."))
 (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
 ;; 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
 ;; It is the last element, let's stop here.
 (throw 'return (list nil (point) token)))
 ;; 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))))
 ;; - it's an associative operator within a larger construct
 ;;   (e.g. an "elsif"), so we should just ignore it and keep
 (cond
 ((not (and ender (rassoc ender smie-closer-alist)))
 ;; 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)))
 (not (member (cons starter ender) smie-closer-alist))))))))
 This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'."
 (when (and blink-matching-paren
 smie-closer-alist                     ; Optimization.
 (eq (char-before) last-command-event) ; Sanity check.
 (memq last-command-event smie-blink-matching-triggers)
-(save-excursion
+(not (nth 8 (syntax-ppss))))
-;; 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))))))
 (save-excursion
 (let ((pos (point))
 (token (funcall smie-backward-token-function)))
-(if (= 1 (length token))
+(when (and (eq (point) (1- pos))
-;; The trigger char is itself a token but is not
+(= 1 (length token))
-;; one of the closers (e.g. ?\; in Octave mode),
+(not (rassoc token smie-closer-alist)))
-;; so go back to the previous token
+;; The trigger char is itself a token but is not one of the
-	    (setq token (save-excursion
+;; closers (e.g. ?\; in Octave mode), so go back to the
-			  (funcall smie-backward-token-function)))
+;; previous token.
-	  (goto-char pos))
+(setq pos (point))
-	;; Here we assume that smie-backward-token-function
+(setq token (save-excursion
-	;; returns a token that is a string and whose content
+(funcall smie-backward-token-function))))
-	;; match the buffer's representation of this token.
+(when (rassoc token smie-closer-alist)
-	(when (and (> (length token) 1) (stringp token)
+;; We're after a close token.  Let's still make sure we
-		   (memq (aref token (1- (length token)))
+;; didn't skip a comment to find that token.
-			 smie-blink-matching-triggers)
+(funcall smie-forward-token-function)
-		   (not (eq (aref token (1- (length token)))
+(when (and (save-excursion
-			    last-command-event)))
+;; Trigger can be SPC, or reindent.
-	  ;; Token ends with a trigger char, so don't blink for
+(skip-chars-forward " \n\t")
-	  ;; anything else than this trigger char, lest we'd blink
+(>= (point) pos))
-	  ;; both when inserting the trigger char and when inserting a
+;; If token ends with a trigger char, so don't blink for
-	  ;; subsequent SPC.
+;; anything else than this trigger char, lest we'd blink
-	  (setq token nil))
+;; both when inserting the trigger char and when
-(when (and (rassoc token smie-closer-alist)
+;; inserting a subsequent trigger char like SPC.
-(or smie-blink-matching-inners
+(or (eq (point) pos)
-(null (nth 2 (assoc token smie-op-levels)))))
+(not (memq (char-before)
-;; The major mode might set blink-matching-check-function
+smie-blink-matching-triggers)))
-;; buffer-locally so that interactive calls to
+(or smie-blink-matching-inners
-;; blink-matching-open work right, but let's not presume
+(null (nth 2 (assoc token smie-op-levels)))))
-;; that's the case.
+;; The major mode might set blink-matching-check-function
-(let ((blink-matching-check-function #'smie-blink-matching-check))
+;; buffer-locally so that interactive calls to
-(blink-matching-open)))))))
+;; 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.
 (defcustom smie-indent-basic 4
 "Basic amount of indentation."
 position of its parent, or the position right after its parent.
 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
 (when (zerop (length (funcall smie-forward-token-function)))
 ;; Could be an open-paren.
 (forward-char 1))
 (skip-chars-forward " \t")
 (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
 after the token, otherwise it should be nil.
 PARENT if non-nil should be the parent info returned by `smie-backward-sexp'."
 (let ((rule (pop rules)))
 (cond
 ((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
 (error "Can't use :eolp in :before indentation rules"))
 (when (> after (line-end-position))
 (unless offset (setq offset rules))
 (when (boundp 'smie-indent-debug-log)
 (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
 (case base
 ((nil) 0)
 (setq parent (or (smie-backward-sexp 'halfsexp) :notfound)))
 (if (consp parent) (goto-char (cadr parent)))
 (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 ()
 "Skip token forward and return it, along with its levels."
 (let ((tok (funcall smie-forward-token-function)))
 "Compute the virtual indentation to use for point.
 This is used when we're not trying to indent point but just
 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
 "fixindent"
 comment-end-skip)
 (token (pop toklevels)))
 (if (null (car toklevels))
 (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)
 (t
 ;; We're only ever here for virtual-indent, which is why
 (let* ((tokinfo (or (assoc (cons :before token)
 smie-indent-rules)
 ;; 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)))
+(offset (smie-indent--offset-rule tokinfo)))
-(smie-indent-column offset)))))
+(smie-indent--column offset)))))
 ;; FIXME: This still looks too much like black magic!!
 ;; FIXME: Rather than a bunch of rules like (PARENT . TOKEN), we
 ;; want a single rule for TOKEN with different cases for each PARENT.
 (let* ((parent (smie-backward-sexp 'halfsexp))
 `((:before . ,token)
 ;; (:parent open 0)
 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.
 ;; - after parent's column + offset (actually, after or before
 ;;   depending on where backward-sexp stopped).
 ;; maybe when an infix or close-paren is at the beginning
 ;; of a buffer.
 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;
 ;;      line2;
 ;;      line3;
 ;;    a -> b -> c
 ;;    -> d
 ;; 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
 ;; indentation, and we're still at the starting point, so
 ;; 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))))))))))
 (defun smie-indent-comment ()
 "Compute indentation of a comment."
 ;; 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))
 (skip-chars-forward " \t\r\n")
 (smie-indent-calculate))))
 ;; The default indentation after a keyword/operator is 0 for
 ;; infix and t for prefix.
 ;; 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)
+(or (smie-indent--offset-rule tokinfo pos)
-(smie-indent-offset t))))
+(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
 ;; intervening keywords or operators.  E.g. "a b c" or "g (balbla) f".
 ;; Can be a list of expressions or a function call.
 (save-excursion
 (let ((positions nil)
 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.
 (setq arg (or (null (car (smie-backward-sexp)))
 (member (funcall smie-backward-token-function)
 (goto-char (cadr positions))
 (current-column))
 (positions
 ;; We're the first arg.
 (goto-char (car positions))
-;; FIXME: Use smie-indent-column.
+;; FIXME: Use smie-indent--column.
-(+ (smie-indent-offset 'args)
+(+ (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.
 (current-column)))))))

Mercurial > emacs

comparison lisp/emacs-lisp/smie.el @ 110429:06323f4d421b