* lisp/emacs-lisp/smie.el: New package.

1 files changed, 1462 insertions, 0 deletions

diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
new file mode 100644
index 00000000000..03c03126d2f
--- /dev/null
+++ b/lisp/emacs-lisp/smie.el
@@ -0,0 +1,1462 @@
+;;; smie.el --- Simple Minded Indentation Engine
+
+;; Copyright (C) 2010  Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Keywords: languages, lisp, internal, parsing, indentation
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; While working on the SML indentation code, the idea grew that maybe
+;; I could write something generic to do the same thing, and at the
+;; end of working on the SML code, I had a pretty good idea of what it
+;; could look like.  That idea grew stronger after working on
+;; LaTeX indentation.
+;;
+;; So at some point I decided to try it out, by writing a new
+;; indentation code for Coq while trying to keep most of the code
+;; "table driven", where only the tables are Coq-specific.  The result
+;; (which was used for Beluga-mode as well) turned out to be based on
+;; something pretty close to an operator precedence parser.
+
+;; So here is another rewrite, this time following the actual principles of
+;; operator precedence grammars.  Why OPG?  Even though they're among the
+;; weakest kinds of parsers, these parsers have some very desirable properties
+;; for Emacs:
+;; - most importantly for indentation, they work equally well in either
+;;   direction, so you can use them to parse backward from the indentation
+;;   point to learn the syntactic context;
+;; - they work locally, so there's no need to keep a cache of
+;;   the parser's state;
+;; - because of that locality, indentation also works just fine when earlier
+;;   parts of the buffer are syntactically incorrect since the indentation
+;;   looks at "as little as possible" of the buffer to make an indentation
+;;   decision.
+;; - they typically have no error handling and can't even detect a parsing
+;;   error, so we don't have to worry about what to do in case of a syntax
+;;   error because the parser just automatically does something.  Better yet,
+;;   we can afford to use a sloppy grammar.
+
+;; A good background to understand the development (especially the parts
+;; building the 2D precedence tables and then computing the precedence levels
+;; from it) can be found in pages 187-194 of "Parsing techniques" by Dick Grune
+;; and Ceriel Jacobs (BookBody.pdf available at
+;; http://www.cs.vu.nl/~dick/PTAPG.html).
+;;
+;; OTOH we had to kill many chickens, read many coffee grounds, and practice
+;; untold numbers of black magic spells, to come up with the indentation code.
+;; Since then, some of that code has been beaten into submission, but the
+;; smie-indent-keyword is still pretty obscure.
+
+;;; Code:
+
+;; FIXME: I think the behavior on empty lines is wrong.  It shouldn't
+;; look at the next token on subsequent lines.
+
+(eval-when-compile (require 'cl))
+
+(defgroup smie nil
+  "Simple Minded Indentation Engine."
+  :group 'languages)
+
+(defvar comment-continue)
+(declare-function comment-string-strip "newcomment" (str beforep afterp))
+
+;;; Building precedence level tables from BNF specs.
+
+;; We have 4 different representations of a "grammar":
+;; - a BNF table, which is a list of BNF rules of the form
+;;   (NONTERM RHS1 ... RHSn) where each RHS is a list of terminals (tokens)
+;;   or nonterminals.  Any element in these lists which does not appear as
+;;   the `car' of a BNF rule is taken to be a terminal.
+;; - A list of precedences (key word "precs"), is a list, sorted
+;;   from lowest to highest precedence, of precedence classes that
+;;   have the form (ASSOCIATIVITY TERMINAL1 .. TERMINALn), where
+;;   ASSOCIATIVITY can be `assoc', `left', `right' or `nonassoc'.
+;; - a 2 dimensional precedence table (key word "prec2"), is a 2D
+;;   table recording the precedence relation (can be `<', `=', `>', or
+;;   nil) between each pair of tokens.
+;; - a precedence-level table (key word "grammar"), which is a alist
+;;   giving for each token its left and right precedence level (a
+;;   number or nil).  This is used in `smie-grammar'.
+;; The prec2 tables are only intermediate data structures: the source
+;; code normally provides a mix of BNF and precs tables, and then
+;; turns them into a levels table, which is what's used by the rest of
+;; the SMIE code.
+
+(defun smie-set-prec2tab (table x y val &optional override)
+  (assert (and x y))
+  (let* ((key (cons x y))
+         (old (gethash key table)))
+    (if (and old (not (eq old val)))
+        (if (and override (gethash key override))
+            ;; FIXME: The override is meant to resolve ambiguities,
+            ;; but it also hides real conflicts.  It would be great to
+            ;; be able to distinguish the two cases so that overrides
+            ;; don't hide real conflicts.
+            (puthash key (gethash key override) table)
+          (display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y)))
+      (puthash key val table))))
+
+(put 'smie-precs->prec2 'pure t)
+(defun smie-precs->prec2 (precs)
+  "Compute a 2D precedence table from a list of precedences.
+PRECS should be a list, sorted by precedence (e.g. \"+\" will
+come before \"*\"), of elements of the form \(left OP ...)
+or (right OP ...) or (nonassoc OP ...) or (assoc OP ...).  All operators in
+one of those elements share the same precedence level and associativity."
+  (let ((prec2-table (make-hash-table :test 'equal)))
+    (dolist (prec precs)
+      (dolist (op (cdr prec))
+        (let ((selfrule (cdr (assq (car prec)
+                                   '((left . >) (right . <) (assoc . =))))))
+          (when selfrule
+            (dolist (other-op (cdr prec))
+              (smie-set-prec2tab prec2-table op other-op selfrule))))
+        (let ((op1 '<) (op2 '>))
+          (dolist (other-prec precs)
+            (if (eq prec other-prec)
+                (setq op1 '> op2 '<)
+              (dolist (other-op (cdr other-prec))
+                (smie-set-prec2tab prec2-table op other-op op2)
+                (smie-set-prec2tab prec2-table other-op op op1)))))))
+    prec2-table))
+
+(put 'smie-merge-prec2s 'pure t)
+(defun smie-merge-prec2s (&rest tables)
+  (if (null (cdr tables))
+      (car tables)
+    (let ((prec2 (make-hash-table :test 'equal)))
+      (dolist (table tables)
+        (maphash (lambda (k v)
+                   (if (consp k)
+                       (smie-set-prec2tab prec2 (car k) (cdr k) v)
+                     (if (and (gethash k prec2)
+                              (not (equal (gethash k prec2) v)))
+                         (error "Conflicting values for %s property" k)
+                       (puthash k v prec2))))
+                 table))
+      prec2)))
+
+(put 'smie-bnf->prec2 'pure t)
+(defun smie-bnf->prec2 (bnf &rest precs)
+  (let ((nts (mapcar 'car bnf))         ;Non-terminals
+        (first-ops-table ())
+        (last-ops-table ())
+        (first-nts-table ())
+        (last-nts-table ())
+        (prec2 (make-hash-table :test 'equal))
+        (override (apply 'smie-merge-prec2s
+                         (mapcar 'smie-precs->prec2 precs)))
+        again)
+    (dolist (rules bnf)
+      (let ((nt (car rules))
+            (last-ops ())
+            (first-ops ())
+            (last-nts ())
+            (first-nts ()))
+        (dolist (rhs (cdr rules))
+          (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
+              ;; should be an OP if BNF is an "operator grammar").
+              ;; Strictly speaking, this should only be done if the
+              ;; first is a non-terminal which can expand to a phrase
+              ;; without any OP in it, but checking doesn't seem worth
+              ;; the trouble, and it lets the writer of the BNF
+              ;; be a bit more sloppy by skipping uninteresting base
+              ;; cases which are terminals but not OPs.
+              (assert (not (member (cadr rhs) nts)))
+              (pushnew (cadr rhs) first-ops)))
+          (let ((shr (reverse rhs)))
+            (if (not (member (car shr) nts))
+                (pushnew (car shr) last-ops)
+              (pushnew (car shr) last-nts)
+              (when (consp (cdr shr))
+                (assert (not (member (cadr shr) nts)))
+                (pushnew (cadr shr) last-ops)))))
+        (push (cons nt first-ops) first-ops-table)
+        (push (cons nt last-ops) last-ops-table)
+        (push (cons nt first-nts) first-nts-table)
+        (push (cons nt last-nts) last-nts-table)))
+    ;; Compute all first-ops by propagating the initial ones we have
+    ;; now, according to first-nts.
+    (setq again t)
+    (while (prog1 again (setq again nil))
+      (dolist (first-nts first-nts-table)
+        (let* ((nt (pop first-nts))
+               (first-ops (assoc nt first-ops-table)))
+          (dolist (first-nt first-nts)
+            (dolist (op (cdr (assoc first-nt first-ops-table)))
+              (unless (member op first-ops)
+                (setq again t)
+                (push op (cdr first-ops))))))))
+    ;; Same thing for last-ops.
+    (setq again t)
+    (while (prog1 again (setq again nil))
+      (dolist (last-nts last-nts-table)
+        (let* ((nt (pop last-nts))
+               (last-ops (assoc nt last-ops-table)))
+          (dolist (last-nt last-nts)
+            (dolist (op (cdr (assoc last-nt last-ops-table)))
+              (unless (member op last-ops)
+                (setq again t)
+                (push op (cdr last-ops))))))))
+    ;; Now generate the 2D precedence table.
+    (dolist (rules bnf)
+      (dolist (rhs (cdr rules))
+        (while (cdr rhs)
+          (cond
+           ((member (car rhs) nts)
+            (dolist (last (cdr (assoc (car rhs) last-ops-table)))
+              (smie-set-prec2tab prec2 last (cadr rhs) '> override)))
+           ((member (cadr rhs) nts)
+            (dolist (first (cdr (assoc (cadr rhs) first-ops-table)))
+              (smie-set-prec2tab prec2 (car rhs) first '< override))
+            (if (and (cddr rhs) (not (member (car (cddr rhs)) nts)))
+                (smie-set-prec2tab prec2 (car rhs) (car (cddr rhs))
+                                   '= override)))
+           (t (smie-set-prec2tab prec2 (car rhs) (cadr rhs) '= override)))
+          (setq rhs (cdr rhs)))))
+    ;; Keep track of which tokens are openers/closer, so they can get a nil
+    ;; precedence in smie-prec2->grammar.
+    (puthash :smie-open/close-alist (smie-bnf-classify bnf) prec2)
+    (puthash :smie-closer-alist (smie-bnf-closer-alist bnf) prec2)
+    prec2))
+
+;; (defun smie-prec2-closer-alist (prec2 include-inners)
+;;   "Build a closer-alist from a PREC2 table.
+;; The return value is in the same form as `smie-closer-alist'.
+;; INCLUDE-INNERS if non-nil means that inner keywords will be included
+;; in the table, e.g. the table will include things like (\"if\" . \"else\")."
+;;   (let* ((non-openers '())
+;;          (non-closers '())
+;;          ;; For each keyword, this gives the matching openers, if any.
+;;          (openers (make-hash-table :test 'equal))
+;;          (closers '())
+;;          (done nil))
+;;     ;; First, find the non-openers and non-closers.
+;;     (maphash (lambda (k v)
+;;                (unless (or (eq v '<) (member (cdr k) non-openers))
+;;                  (push (cdr k) non-openers))
+;;                (unless (or (eq v '>) (member (car k) non-closers))
+;;                  (push (car k) non-closers)))
+;;              prec2)
+;;     ;; Then find the openers and closers.
+;;     (maphash (lambda (k _)
+;;                (unless (member (car k) non-openers)
+;;                  (puthash (car k) (list (car k)) openers))
+;;                (unless (or (member (cdr k) non-closers)
+;;                            (member (cdr k) closers))
+;;                  (push (cdr k) closers)))
+;;              prec2)
+;;     ;; Then collect the matching elements.
+;;     (while (not done)
+;;       (setq done t)
+;;       (maphash (lambda (k v)
+;;                  (when (eq v '=)
+;;                    (let ((aopeners (gethash (car k) openers))
+;;                          (dopeners (gethash (cdr k) openers))
+;;                          (new nil))
+;;                      (dolist (o aopeners)
+;;                        (unless (member o dopeners)
+;;                          (setq new t)
+;;                          (push o dopeners)))
+;;                      (when new
+;;                        (setq done nil)
+;;                        (puthash (cdr k) dopeners openers)))))
+;;                prec2))
+;;     ;; Finally, dump the resulting table.
+;;     (let ((alist '()))
+;;       (maphash (lambda (k v)
+;;                  (when (or include-inners (member k closers))
+;;                    (dolist (opener v)
+;;                      (unless (equal opener k)
+;;                        (push (cons opener k) alist)))))
+;;                openers)
+;;       alist)))
+
+(defun smie-bnf-closer-alist (bnf &optional no-inners)
+  ;; We can also build this closer-alist table from a prec2 table,
+  ;; but it takes more work, and the order is unpredictable, which
+  ;; is a problem for smie-close-block.
+  ;; More convenient would be to build it from a levels table since we
+  ;; always have this table (contrary to the BNF), but it has all the
+  ;; disadvantages of the prec2 case plus the disadvantage that the levels
+  ;; table has lost some info which would result in extra invalid pairs.
+  "Build a closer-alist from a BNF table.
+The return value is in the same form as `smie-closer-alist'.
+NO-INNERS if non-nil means that inner keywords will be excluded
+from the table, e.g. the table will not include things like (\"if\" . \"else\")."
+  (let ((nts (mapcar #'car bnf))        ;non terminals.
+        (alist '()))
+    (dolist (nt bnf)
+      (dolist (rhs (cdr nt))
+        (unless (or (< (length rhs) 2) (member (car rhs) nts))
+          (if no-inners
+              (let ((last (car (last rhs))))
+                (unless (member last nts)
+                  (pushnew (cons (car rhs) last) alist :test #'equal)))
+            ;; Reverse so that the "real" closer gets there first,
+            ;; which is important for smie-close-block.
+            (dolist (term (reverse (cdr rhs)))
+              (unless (member term nts)
+                (pushnew (cons (car rhs) term) alist :test #'equal)))))))
+    (nreverse alist)))
+
+(defun smie-bnf-classify (bnf)
+  "Return a table classifying terminals.
+Each terminal can either be an `opener', a `closer', or neither."
+  (let ((table (make-hash-table :test #'equal))
+        (alist '()))
+    (dolist (category bnf)
+      (puthash (car category) 'neither table) ;Remove non-terminals.
+      (dolist (rhs (cdr category))
+        (if (null (cdr rhs))
+            (puthash (pop rhs) 'neither table)
+          (let ((first (pop rhs)))
+            (puthash first
+                     (if (memq (gethash first table) '(nil opener))
+                         'opener 'neither)
+                     table))
+          (while (cdr rhs)
+            (puthash (pop rhs) 'neither table)) ;Remove internals.
+          (let ((last (pop rhs)))
+            (puthash last
+                     (if (memq (gethash last table) '(nil closer))
+                         'closer 'neither)
+                     table)))))
+    (maphash (lambda (tok v)
+               (when (memq v '(closer opener))
+                 (push (cons tok v) alist)))
+             table)
+    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 'identity elems "="))
+     (append names (list (car names)))
+     " < ")))
+
+(put 'smie-prec2->grammar 'pure t)
+(defun smie-prec2->grammar (prec2)
+  "Take a 2D precedence table and turn it into an alist of precedence levels.
+PREC2 is a table as returned by `smie-precs->prec2' or
+`smie-bnf->prec2'."
+  ;; For each operator, we create two "variables" (corresponding to
+  ;; the left and right precedence level), which are represented by
+  ;; cons cells.  Those are the very cons cells that appear in the
+  ;; final `table'.  The value of each "variable" is kept in the `car'.
+  (let ((table ())
+        (csts ())
+        (eqs ())
+        tmp x y)
+    ;; From `prec2' we construct a list of constraints between
+    ;; variables (aka "precedence levels").  These can be either
+    ;; equality constraints (in `eqs') or `<' constraints (in `csts').
+    (maphash (lambda (k v)
+               (when (consp k)
+                 (if (setq tmp (assoc (car k) table))
+                     (setq x (cddr tmp))
+                   (setq x (cons nil nil))
+                   (push (cons (car k) (cons nil x)) table))
+                 (if (setq tmp (assoc (cdr k) table))
+                     (setq y (cdr tmp))
+                   (setq y (cons nil (cons nil nil)))
+                   (push (cons (cdr k) y) table))
+                 (ecase v
+                   (= (push (cons x y) eqs))
+                   (< (push (cons x y) csts))
+                   (> (push (cons y x) csts)))))
+             prec2)
+    ;; First process the equality constraints.
+    (let ((eqs eqs))
+      (while eqs
+        (let ((from (caar eqs))
+              (to (cdar eqs)))
+          (setq eqs (cdr eqs))
+          (if (eq to from)
+              nil                   ;Nothing to do.
+            (dolist (other-eq eqs)
+              (if (eq from (cdr other-eq)) (setcdr other-eq to))
+              (when (eq from (car other-eq))
+                ;; This can happen because of `assoc' settings in precs
+                ;; or because of a rhs like ("op" foo "op").
+                (setcar other-eq to)))
+            (dolist (cst csts)
+              (if (eq from (cdr cst)) (setcdr cst to))
+              (if (eq from (car cst)) (setcar cst to)))))))
+    ;; Then eliminate trivial constraints iteratively.
+    (let ((i 0))
+      (while csts
+        (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 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)))
+      ;; Finally, fill in the remaining vars (which only appeared on the
+      ;; right side of the < constraints).
+      (let ((classification-table (gethash :smie-open/close-alist prec2)))
+        (dolist (x table)
+          ;; When both sides are nil, it means this operator binds very
+          ;; very tight, but it's still just an operator, so we give it
+          ;; the highest precedence.
+          ;; OTOH if only one side is nil, it usually means it's like an
+          ;; open-paren, which is very important for indentation purposes,
+          ;; so we keep it nil if so, to make it easier to recognize.
+          (unless (or (nth 1 x)
+                      (eq 'opener (cdr (assoc (car x) classification-table))))
+            (setf (nth 1 x) i)
+            (incf i))                   ;See other (incf i) above.
+          (unless (or (nth 2 x)
+                      (eq 'closer (cdr (assoc (car x) classification-table))))
+            (setf (nth 2 x) i)
+            (incf i)))))                ;See other (incf i) above.
+    (let ((ca (gethash :smie-closer-alist prec2)))
+      (when ca (push (cons :smie-closer-alist ca) table)))
+    table))
+
+;;; Parsing using a precedence level table.
+
+(defvar smie-grammar 'unset
+  "List of token parsing info.
+This list is normally built by `smie-prec2->grammar'.
+Each element is of the form (TOKEN LEFT-LEVEL RIGHT-LEVEL).
+Parsing is done using an operator precedence parser.
+LEFT-LEVEL and RIGHT-LEVEL can be either numbers or nil, where nil
+means that this operator does not bind on the corresponding side,
+i.e. a LEFT-LEVEL of nil means this is a token that behaves somewhat like
+an open-paren, whereas a RIGHT-LEVEL of nil would correspond to something
+like a close-paren.")
+
+(defvar smie-forward-token-function 'smie-default-forward-token
+  "Function to scan forward for the next token.
+Called with no argument should return a token and move to its end.
+If no token is found, return nil or the empty string.
+It can return nil when bumping into a parenthesis, which lets SMIE
+use syntax-tables to handle them in efficient C code.")
+
+(defvar smie-backward-token-function 'smie-default-backward-token
+  "Function to scan backward the previous token.
+Same calling convention as `smie-forward-token-function' except
+it should move backward to the beginning of the previous token.")
+
+(defalias 'smie-op-left 'car)
+(defalias 'smie-op-right 'cadr)
+
+(defun smie-default-backward-token ()
+  (forward-comment (- (point)))
+  (buffer-substring-no-properties
+   (point)
+   (progn (if (zerop (skip-syntax-backward "."))
+              (skip-syntax-backward "w_'"))
+          (point))))
+
+(defun smie-default-forward-token ()
+  (forward-comment (point-max))
+  (buffer-substring-no-properties
+   (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 elsif c then d else c" we don't want to stop at each keyword.
+  ;; To distinguish the two cases, we made smie-prec2->grammar 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 the "elsif" will have to have
+  ;; equal left and right levels (since it's optional), so smie-next-sexp
+  ;; has to be careful to distinguish those different cases.
+  (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-grammar))))
+            (cond
+             ((null toklevels)
+              (when (zerop (length token))
+                (condition-case err
+                    (progn (goto-char pos) (funcall next-sexp 1) nil)
+                  (scan-error (throw 'return
+                                     (list t (caddr err)
+                                           (buffer-substring-no-properties
+                                            (caddr err)
+                                            (+ (caddr err)
+                                               (if (< (point) (caddr err))
+                                                   -1 1)))))))
+                (if (eq pos (point))
+                    ;; We did not move, so let's abort the loop.
+                    (throw 'return (list t (point))))))
+             ((null (funcall op-back toklevels))
+              ;; A token like a paren-close.
+              (assert (funcall op-forw toklevels)) ;Otherwise, why mention it?
+              (push toklevels levels))
+             (t
+              (while (and levels (< (funcall op-back toklevels)
+                                    (funcall op-forw (car levels))))
+                (setq levels (cdr levels)))
+              (cond
+               ((null levels)
+                (if (and halfsexp (funcall op-forw toklevels))
+                    (push toklevels levels)
+                  (throw 'return
+                         (prog1 (list (or (car toklevels) t) (point) token)
+                           (goto-char pos)))))
+               (t
+                (let ((lastlevels levels))
+                  (if (and levels (= (funcall op-back toklevels)
+                                     (funcall op-forw (car levels))))
+                      (setq levels (cdr levels)))
+                  ;; We may have found a match for the previously pending
+                  ;; operator.  Is this the end?
+                  (cond
+                   ;; Keep looking as long as we haven't matched the
+                   ;; topmost operator.
+                   (levels
+                    (if (funcall op-forw toklevels)
+                        (push toklevels levels)))
+                   ;; We matched the topmost operator.  If the new operator
+                   ;; is the last in the corresponding BNF rule, we're done.
+                   ((null (funcall op-forw toklevels))
+                    ;; 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))
+                    (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)))
+                    (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
+                   ;;   looking for the closing element.
+                   (t (setq levels lastlevels))))))))
+            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, ..."
+  (smie-next-sexp
+   (indirect-function smie-backward-token-function)
+   (indirect-function 'backward-sexp)
+   (indirect-function 'smie-op-left)
+   (indirect-function 'smie-op-right)
+   halfsexp))
+
+(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
+first token we see is an operator, skip over its left-hand-side argument.
+Possible return values:
+  (RIGHT-LEVEL POS TOKEN): we couldn't skip TOKEN because its left-level
+    is too high.  RIGHT-LEVEL is the right-level of TOKEN,
+    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, ..."
+  (smie-next-sexp
+   (indirect-function smie-forward-token-function)
+   (indirect-function 'forward-sexp)
+   (indirect-function 'smie-op-right)
+   (indirect-function 'smie-op-left)
+   halfsexp))
+
+;;; Miscellanous commands using the precedence parser.
+
+(defun smie-backward-sexp-command (&optional n)
+  "Move backward through N logical elements."
+  (interactive "^p")
+  (smie-forward-sexp-command (- n)))
+
+(defun smie-forward-sexp-command (&optional n)
+  "Move forward through N logical elements."
+  (interactive "^p")
+  (let ((forw (> n 0))
+        (forward-sexp-function nil))
+    (while (/= n 0)
+      (setq n (- n (if forw 1 -1)))
+      (let ((pos (point))
+            (res (if forw
+                     (smie-forward-sexp 'halfsexp)
+                   (smie-backward-sexp 'halfsexp))))
+        (if (and (car res) (= pos (point)) (not (if forw (eobp) (bobp))))
+            (signal 'scan-error
+                    (list "Containing expression ends prematurely"
+                          (cadr res) (cadr res)))
+          nil)))))
+
+(defvar smie-closer-alist nil
+  "Alist giving the closer corresponding to an opener.")
+
+(defun smie-close-block ()
+  "Close the closest surrounding block."
+  (interactive)
+  (let ((closer
+         (save-excursion
+           (backward-up-list 1)
+           (if (looking-at "\\s(")
+               (string (cdr (syntax-after (point))))
+             (let* ((open (funcall smie-forward-token-function))
+                    (closer (cdr (assoc open smie-closer-alist)))
+                    (levels (list (assoc open smie-grammar)))
+                    (seen '())
+                    (found '()))
+               (cond
+                ;; Even if we improve the auto-computation of closers,
+                ;; there are still cases where we need manual
+                ;; intervention, e.g. for Octave's use of `until'
+                ;; as a pseudo-closer of `do'.
+                (closer)
+                ((or (equal levels '(nil)) (nth 1 (car levels)))
+                 (error "Doesn't look like a block"))
+                (t
+                 ;; Now that smie-setup automatically sets smie-closer-alist
+                 ;; from the BNF, this is not really needed any more.
+                 (while levels
+                   (let ((level (pop levels)))
+                     (dolist (other smie-grammar)
+                       (when (and (eq (nth 2 level) (nth 1 other))
+                                  (not (memq other seen)))
+                         (push other seen)
+                         (if (nth 2 other)
+                             (push other levels)
+                           (push (car other) found))))))
+                 (cond
+                  ((null found) (error "No known closer for opener %s" open))
+                  ;; FIXME: what should we do if there are various closers?
+                  (t (car found))))))))))
+    (unless (save-excursion (skip-chars-backward " \t") (bolp))
+      (newline))
+    (insert closer)
+    (if (save-excursion (skip-chars-forward " \t") (eolp))
+        (indent-according-to-mode)
+      (reindent-then-newline-and-indent))))
+
+(defun smie-down-list (&optional arg)
+  "Move forward down one level paren-like blocks.  Like `down-list'.
+With argument ARG, do this that many times.
+A negative argument means move backward but still go down a level.
+This command assumes point is not in a string or comment."
+  (interactive "p")
+  (let ((start (point))
+        (inc (if (< arg 0) -1 1))
+        (offset (if (< arg 0) 1 0))
+        (next-token (if (< arg 0)
+                        smie-backward-token-function
+                      smie-forward-token-function)))
+    (while (/= arg 0)
+      (setq arg (- arg inc))
+      (while
+          (let* ((pos (point))
+                 (token (funcall next-token))
+                 (levels (assoc token smie-grammar)))
+            (cond
+             ((zerop (length token))
+              (if (if (< inc 0) (looking-back "\\s(\\|\\s)" (1- (point)))
+                    (looking-at "\\s(\\|\\s)"))
+                  ;; Go back to `start' in case of an error.  This presumes
+                  ;; none of the token we've found until now include a ( or ).
+                  (progn (goto-char start) (down-list inc) nil)
+                (forward-sexp inc)
+                (/= (point) pos)))
+             ((and levels (null (nth (+ 1 offset) levels))) nil)
+             ((and levels (null (nth (- 2 offset) levels)))
+              (let ((end (point)))
+                (goto-char start)
+                (signal 'scan-error
+                        (list "Containing expression ends prematurely"
+                              pos end))))
+             (t)))))))
+
+(defvar smie-blink-matching-triggers '(?\s ?\n)
+  "Chars which might trigger `blink-matching-open'.
+These can include the final chars of end-tokens, or chars that are
+typically inserted right after an end token.
+I.e. a good choice can be:
+    (delete-dups
+     (mapcar (lambda (kw) (aref (cdr kw) (1- (length (cdr kw)))))
+             smie-closer-alist))")
+
+(defcustom smie-blink-matching-inners t
+  "Whether SMIE should blink to matching opener for inner keywords.
+If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"."
+  :type 'boolean
+  :group 'smie)
+
+(defun smie-blink-matching-check (start end)
+  (save-excursion
+    (goto-char end)
+    (let ((ender (funcall smie-backward-token-function)))
+      (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))))))))
+
+(defun smie-blink-matching-open ()
+  "Blink the matching opener when applicable.
+This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'."
+  (let ((pos (point))                   ;Position after the close token.
+        token)
+    (when (and blink-matching-paren
+               smie-closer-alist                     ; Optimization.
+               (or (eq (char-before) last-command-event) ;; Sanity check.
+                   (save-excursion
+                     (or (progn (skip-chars-backward " \t")
+                                (setq pos (point))
+                                (eq (char-before) last-command-event))
+                         (progn (skip-chars-backward " \n\t")
+                                (setq pos (point))
+                                (eq (char-before) last-command-event)))))
+               (memq last-command-event smie-blink-matching-triggers)
+               (not (nth 8 (syntax-ppss))))
+      (save-excursion
+        (setq token (funcall smie-backward-token-function))
+        (when (and (eq (point) (1- pos))
+                   (= 1 (length token))
+                   (not (rassoc token smie-closer-alist)))
+          ;; The trigger char is itself a token but is not one of the
+          ;; closers (e.g. ?\; in Octave mode), so go back to the
+          ;; previous token.
+          (setq pos (point))
+          (setq token (funcall smie-backward-token-function)))
+        (when (rassoc token smie-closer-alist)
+          ;; We're after a close token.  Let's still make sure we
+          ;; didn't skip a comment to find that token.
+          (funcall smie-forward-token-function)
+          (when (and (save-excursion
+                       ;; Skip the trigger char, if applicable.
+                       (if (eq (char-after) last-command-event)
+                           (forward-char 1))
+                       (if (eq ?\n last-command-event)
+                           ;; Skip any auto-indentation, if applicable.
+                           (skip-chars-forward " \t"))
+                       (>= (point) pos))
+                     ;; If token ends with a trigger char, don't blink for
+                     ;; anything else than this trigger char, lest we'd blink
+                     ;; both when inserting the trigger char and when
+                     ;; inserting a subsequent trigger char like SPC.
+                     (or (eq (point) pos)
+                         (not (memq (char-before)
+                                    smie-blink-matching-triggers)))
+                     (or smie-blink-matching-inners
+                         (null (nth 2 (assoc token smie-grammar)))))
+            ;; The major mode might set blink-matching-check-function
+            ;; buffer-locally so that interactive calls to
+            ;; 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."
+  :type 'integer
+  :group 'smie)
+
+(defvar smie-rules-function 'ignore
+  "Function providing the indentation rules.
+It takes two arguments METHOD and ARG where the meaning of ARG
+and the expected return value depends on METHOD.
+METHOD can be:
+- :after, in which case ARG is a token and the function should return the
+  OFFSET to use for indentation after ARG.
+- :before, in which case ARG is a token and the function should return the
+  OFFSET to use to indent ARG itself.
+- :elem, in which case the function should return either:
+  - the offset to use to indent function arguments (ARG = `arg')
+  - the basic indentation step (ARG = `basic').
+- :list-intro, in which case ARG is a token and the function should return
+  non-nil if TOKEN is followed by a list of expressions (not separated by any
+  token) rather than an expression.
+
+When ARG is a token, the function is called with point just before that token.
+A return value of nil always means to fallback on the default behavior, so the
+function should return nil for arguments it does not expect.
+
+OFFSET can be:
+nil				use the default indentation rule.
+`(column . COLUMN)		indent to column COLUMN.
+NUMBER				offset by NUMBER, relative to a base token
+				which is the current token for :after and
+				its parent for :before.
+
+The functions whose name starts with \"smie-rule-\" are helper functions
+designed specifically for use in this function.")
+
+(defalias 'smie-rule-hanging-p 'smie-indent--hanging-p)
+(defun smie-indent--hanging-p ()
+  "Return non-nil if the current token is \"hanging\".
+A hanging keyword is one that's at the end of a line except it's not at
+the beginning of a line."
+  (and (not (smie-indent--bolp))
+       (save-excursion
+         (<= (line-end-position)
+             (progn
+               (when (zerop (length (funcall smie-forward-token-function)))
+                 ;; Could be an open-paren.
+                 (forward-char 1))
+               (skip-chars-forward " \t")
+               (or (eolp)
+                   (and (looking-at comment-start-skip)
+                        (forward-comment (point-max))))
+               (point))))))
+
+(defalias 'smie-rule-bolp 'smie-indent--bolp)
+(defun smie-indent--bolp ()
+  "Return non-nil if the current token is the first on the line."
+  (save-excursion (skip-chars-backward " \t") (bolp)))
+
+;; Dynamically scoped.
+(defvar smie--parent) (defvar smie--after) (defvar smie--token)
+
+(defun smie-indent--parent ()
+  (or smie--parent
+      (save-excursion
+        (let* ((pos (point))
+               (tok (funcall smie-forward-token-function)))
+          (unless (cadr (assoc tok smie-grammar))
+            (goto-char pos))
+          (setq smie--parent
+                (smie-backward-sexp 'halfsexp))))))
+
+(defun smie-rule-parent-p (&rest parents)
+  "Return non-nil if the current token's parent is among PARENTS.
+Only meaningful when called from within `smie-rules-function'."
+  (member (nth 2 (smie-indent--parent)) parents))
+
+(defun smie-rule-next-p (&rest tokens)
+  "Return non-nil if the next token is among TOKENS.
+Only meaningful when called from within `smie-rules-function'."
+  (let ((next
+         (save-excursion
+           (unless smie--after
+             (smie-indent-forward-token) (setq smie--after (point)))
+           (goto-char smie--after)
+           (smie-indent-forward-token))))
+    (member (car next) tokens)))
+
+(defun smie-rule-prev-p (&rest tokens)
+  "Return non-nil if the previous token is among TOKENS."
+  (let ((prev (save-excursion
+                (smie-indent-backward-token))))
+    (member (car prev) tokens)))
+
+(defun smie-rule-sibling-p ()
+  "Return non-nil if the parent is actually a sibling.
+Only meaningful when called from within `smie-rules-function'."
+  (eq (car (smie-indent--parent))
+      (cadr (assoc smie--token smie-grammar))))
+
+(defun smie-rule-parent (&optional offset)
+  "Align with parent.
+If non-nil, OFFSET should be an integer giving an additional offset to apply.
+Only meaningful when called from within `smie-rules-function'."
+  (save-excursion
+    (goto-char (cadr (smie-indent--parent)))
+    (cons 'column
+          (+ (or offset 0)
+             (if (smie-indent--hanging-p)
+                 (smie-indent-virtual) (current-column))))))  
+
+(defvar smie-rule-separator-outdent 2)
+
+(defun smie-indent--separator-outdent ()
+  ;; FIXME: Here we actually have several reasonable behaviors.
+  ;; E.g. for a parent token of "FOO" and a separator ";" we may want to:
+  ;; 1- left-align ; with FOO.
+  ;; 2- right-align ; with FOO.
+  ;; 3- align content after ; with content after FOO.
+  ;; 4- align content plus add/remove spaces so as to align ; with FOO.
+  ;; Currently, we try to align the contents (option 3) which actually behaves
+  ;; just like option 2 (if the number of spaces after FOO and ; is equal).
+  (let ((afterpos (save-excursion
+                    (let ((tok (funcall smie-forward-token-function)))
+                      (unless tok
+                        (with-demoted-errors
+                          (error "smie-rule-separator: can't skip token %s"
+                                 smie--token))))
+                    (skip-chars-forward " ")
+                    (unless (eolp) (point)))))
+    (or (and afterpos
+             ;; This should always be true, unless
+             ;; smie-forward-token-function skipped a \n.
+             (< afterpos (line-end-position))
+             (- afterpos (point)))
+        smie-rule-separator-outdent)))
+
+(defun smie-rule-separator (method)
+  "Indent current token as a \"separator\".
+By \"separator\", we mean here a token whose sole purpose is to separate
+various elements within some enclosing syntactic construct, and which does
+not have any semantic significance in itself (i.e. it would typically no exist
+as a node in an abstract syntax tree).
+Such a token is expected to have an associative syntax and be closely tied
+to its syntactic parent.  Typical examples are \",\" in lists of arguments
+\(enclosed inside parentheses), or \";\" in sequences of instructions (enclosed
+in a {..} or begin..end block).
+METHOD should be the method name that was passed to `smie-rules-function'.
+Only meaningful when called from within `smie-rules-function'."
+  ;; FIXME: The code below works OK for cases where the separators
+  ;; are placed consistently always at beginning or always at the end,
+  ;; but not if some are at the beginning and others are at the end.
+  ;; I.e. it gets confused in cases such as:
+  ;;     (  a
+  ;;     ,  a,
+  ;;        b
+  ;;     ,  c,
+  ;;        d
+  ;;     )
+  ;;
+  ;; Assuming token is associative, the default rule for associative
+  ;; tokens (which assumes an infix operator) works fine for many cases.
+  ;; We mostly need to take care of the case where token is at beginning of
+  ;; line, in which case we want to align it with its enclosing parent.
+  (cond
+   ((and (eq method :before) (smie-rule-bolp) (not (smie-rule-sibling-p)))
+    ;; FIXME: Rather than consult the number of spaces, we could *set* the
+    ;; number of spaces so as to align the separator with the close-paren
+    ;; while aligning the content with the rest.
+    (let ((parent-col
+           (save-excursion
+             (goto-char (cadr smie--parent))
+             (if (smie-indent--hanging-p)
+                 (smie-indent-virtual) (current-column))))
+          (parent-pos-col     ;FIXME: we knew this when computing smie--parent.
+           (save-excursion
+             (goto-char (cadr smie--parent))
+             (smie-indent-forward-token)
+             (forward-comment (point-max))
+             (current-column))))
+      (cons 'column
+            (max parent-col
+                 (min parent-pos-col
+                      (- parent-pos-col (smie-indent--separator-outdent)))))))
+   ((and (eq method :after) (smie-indent--bolp))
+    (smie-indent--separator-outdent))))
+
+(defun smie-indent--offset (elem)
+  (or (funcall smie-rules-function :elem elem)
+      (if (not (eq elem 'basic))
+          (funcall smie-rules-function :elem 'basic))
+      smie-indent-basic))
+
+(defun smie-indent--rule (method token
+                          ;; FIXME: Too many parameters.
+                          &optional after parent base-pos)
+  "Compute indentation column according to `indent-rule-functions'.
+METHOD and TOKEN are passed to `indent-rule-functions'.
+AFTER is the position after TOKEN, if known.
+PARENT is the parent info returned by `smie-backward-sexp', if known.
+BASE-POS is the position relative to which offsets should be applied."
+  ;; This is currently called in 3 cases:
+  ;; - :before opener, where rest=nil but base-pos could as well be parent.
+  ;; - :before other, where
+  ;;                  ; after=nil
+  ;;                  ; parent is set
+  ;;                  ; base-pos=parent
+  ;; - :after tok, where
+  ;;                  ; after is set; parent=nil; base-pos=point;
+  (save-excursion
+    (let ((offset
+           (let ((smie--parent parent)
+                 (smie--token token)
+                 (smie--after after))
+             (funcall smie-rules-function method token))))
+      (cond
+       ((not offset) nil)
+       ((eq (car-safe offset) 'column) (cdr offset))
+       ((integerp offset)
+        (+ offset
+           (if (null base-pos) 0
+             (goto-char base-pos)
+             (if (smie-indent--hanging-p)
+                 (smie-indent-virtual) (current-column)))))
+       (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)))
+    (cond
+     ((< 0 (length tok)) (assoc tok smie-grammar))
+     ((looking-at "\\s(\\|\\s)\\(\\)")
+      (forward-char 1)
+      (cons (buffer-substring (1- (point)) (point))
+            (if (match-end 1) '(0 nil) '(nil 0)))))))
+
+(defun smie-indent-backward-token ()
+  "Skip token backward and return it, along with its levels."
+  (let ((tok (funcall smie-backward-token-function))
+        class)
+    (cond
+     ((< 0 (length tok)) (assoc tok smie-grammar))
+     ;; 4 == open paren syntax, 5 == close.
+     ((memq (setq class (syntax-class (syntax-after (1- (point))))) '(4 5))
+      (forward-char -1)
+      (cons (buffer-substring (point) (1+ (point)))
+            (if (eq class 4) '(nil 0) '(0 nil)))))))
+
+(defun smie-indent-virtual ()
+  ;; We used to take an optional arg (with value :not-hanging) to specify that
+  ;; we should only use (smie-indent-calculate) if we're looking at a hanging
+  ;; keyword.  This was a bad idea, because the virtual indent of a position
+  ;; should not depend on the caller, since it leads to situations where two
+  ;; dependent indentations get indented differently.
+  "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-indent--bolp) (current-column) (smie-indent-calculate)))
+
+(defun smie-indent-fixindent ()
+  ;; Obey the `fixindent' special comment.
+  (and (smie-indent--bolp)
+       (save-excursion
+         (comment-normalize-vars)
+         (re-search-forward (concat comment-start-skip
+                                    "fixindent"
+                                    comment-end-skip)
+                            ;; 1+ to account for the \n comment termination.
+                            (1+ (line-end-position)) t))
+       (current-column)))
+
+(defun smie-indent-bob ()
+  ;; Start the file at column 0.
+  (save-excursion
+    (forward-comment (- (point)))
+    (if (bobp) 0)))
+
+(defun smie-indent-close ()
+  ;; Align close paren with opening paren.
+  (save-excursion
+    ;; (forward-comment (point-max))
+    (when (looking-at "\\s)")
+      (while (not (zerop (skip-syntax-forward ")")))
+        (skip-chars-forward " \t"))
+      (condition-case nil
+          (progn
+            (backward-sexp 1)
+            (smie-indent-virtual))      ;:not-hanging
+        (scan-error nil)))))
+
+(defun smie-indent-keyword ()
+  ;; Align closing token with the corresponding opening one.
+  ;; (e.g. "of" with "case", or "in" with "let").
+  (save-excursion
+    (let* ((pos (point))
+           (toklevels (smie-indent-forward-token))
+           (token (pop toklevels)))
+      (if (null (car toklevels))
+          (save-excursion
+            (goto-char pos)
+            ;; Different cases:
+            ;; - 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-indent--bolp)
+              ;; For an open-paren-like thingy at BOL, always indent only
+              ;; based on other rules (typically smie-indent-after-keyword).
+              nil)
+             ;; We're only ever here for virtual-indent.
+             ((smie-indent--rule :before token))
+             (t
+              ;; By default use point unless we're hanging.
+              (unless (smie-indent--hanging-p) (current-column)))))
+
+        ;; FIXME: This still looks too much like black magic!!
+        (let* ((parent (smie-backward-sexp 'halfsexp)))
+          ;; Different behaviors:
+          ;; - align with parent.
+          ;; - parent + offset.
+          ;; - after parent's column + offset (actually, after or before
+          ;;   depending on where backward-sexp stopped).
+          ;; ? let it drop to some other indentation function (almost never).
+          ;; ? parent + offset + parent's own offset.
+          ;; Different cases:
+          ;; - bump into a same-level operator.
+          ;; - bump into a specific known parent.
+          ;; - find a matching open-paren thingy.
+          ;; - bump into some random parent.
+          ;; ? borderline case (almost never).
+          ;; ? bump immediately into a parent.
+          (cond
+           ((not (or (< (point) pos)
+                     (and (cadr parent) (< (cadr parent) pos))))
+            ;; If we didn't move at all, that means we didn't really skip
+            ;; what we wanted.  Should almost never happen, other than
+            ;; maybe when an infix or close-paren is at the beginning
+            ;; of a buffer.
+            nil)
+           ((save-excursion
+              (goto-char pos)
+              (smie-indent--rule :before token nil parent (cadr parent))))
+           ((eq (car parent) (car toklevels))
+            ;; We bumped into a same-level operator; align with it.
+            (if (and (smie-indent--bolp) (/= (point) pos)
+                     (save-excursion
+                       (goto-char (goto-char (cadr parent)))
+                       (not (smie-indent--bolp))))
+                ;; If the parent is at EOL and its children are indented like
+                ;; itself, then we can just obey the indentation chosen for the
+                ;; child.
+                ;; This is important for operators like ";" which
+                ;; are usually at EOL (and have an offset of 0): otherwise we'd
+                ;; always go back over all the statements, which is
+                ;; a performance problem and would also mean that fixindents
+                ;; in the middle of such a sequence would be ignored.
+                ;;
+                ;; This is a delicate point!
+                ;; Even if the offset is not 0, we could follow the same logic
+                ;; and subtract the offset from the child's indentation.
+                ;; But that would more often be a bad idea: OT1H we generally
+                ;; want to reuse the closest similar indentation point, so that
+                ;; the user's choice (or the fixindents) are obeyed.  But OTOH
+                ;; we don't want this to affect "unrelated" parts of the code.
+                ;; E.g. a fixindent in the body of a "begin..end" should not
+                ;; affect the indentation of the "end".
+                (current-column)
+              (goto-char (cadr parent))
+              ;; Don't use (smie-indent-virtual :not-hanging) here, because we
+              ;; want to jump back over a sequence of same-level ops such as
+              ;;    a -> b -> c
+              ;;    -> d
+              ;; So as to align with the earliest appropriate place.
+              (smie-indent-virtual)))
+           (t
+            (if (and (= (point) pos) (smie-indent--bolp))
+                ;; 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 and we can't use
+                ;; smie-indent-virtual since that would be an inf-loop.
+                nil
+              ;; In indent-keyword, if we're indenting `then' wrt `if', we
+              ;; want to use indent-virtual rather than use just
+              ;; current-column, so that we can apply the (:before . "if")
+              ;; rule which does the "else if" dance in SML.  But in other
+              ;; cases, we do not want to use indent-virtual (e.g. indentation
+              ;; of "*" w.r.t "+", or ";" wrt "(").  We could just always use
+              ;; indent-virtual and then have indent-rules say explicitly to
+              ;; use `point' after things like "(" or "+" when they're not at
+              ;; EOL, but you'd end up with lots of those rules.
+              ;; So we use a heuristic here, which is that we only use virtual
+              ;; if the parent is tightly linked to the child token (they're
+              ;; part of the same BNF rule).
+              (if (car parent) (current-column) (smie-indent-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-indent--bolp)
+       (let ((pos (point)))
+         (save-excursion
+           (beginning-of-line)
+           (and (re-search-forward comment-start-skip (line-end-position) t)
+                (eq pos (or (match-end 1) (match-beginning 0))))))
+       (save-excursion
+         (forward-comment (point-max))
+         (skip-chars-forward " \t\r\n")
+         (smie-indent-calculate))))
+
+(defun smie-indent-comment-continue ()
+  ;; indentation of comment-continue lines.
+  (let ((continue (and comment-continue
+                       (comment-string-strip comment-continue t t))))
+    (and (< 0 (length continue))
+         (looking-at (regexp-quote continue)) (nth 4 (syntax-ppss))
+         (let ((ppss (syntax-ppss)))
+           (save-excursion
+             (forward-line -1)
+             (if (<= (point) (nth 8 ppss))
+                 (progn (goto-char (1+ (nth 8 ppss))) (current-column))
+               (skip-chars-forward " \t")
+               (if (looking-at (regexp-quote continue))
+                   (current-column))))))))
+
+(defun smie-indent-comment-close ()
+  (and (boundp 'comment-end-skip)
+       comment-end-skip
+       (not (looking-at " \t*$"))       ;Not just a \n comment-closer.
+       (looking-at comment-end-skip)
+       (nth 4 (syntax-ppss))
+       (save-excursion
+         (goto-char (nth 8 (syntax-ppss)))
+         (current-column))))
+
+(defun smie-indent-comment-inside ()
+  (and (nth 4 (syntax-ppss))
+       'noindent))
+
+(defun smie-indent-after-keyword ()
+  ;; Indentation right after a special keyword.
+  (save-excursion
+    (let* ((pos (point))
+           (toklevel (smie-indent-backward-token))
+           (tok (car toklevel)))
+      (cond
+       ((null toklevel) nil)
+       ((smie-indent--rule :after tok pos nil (point)))
+       ;; The default indentation after a keyword/operator is
+       ;; 0 for infix, t for prefix, and use another rule
+       ;; for postfix.
+       ((null (nth 2 toklevel)) nil)        ;A closer.
+       ((or (null (nth 1 toklevel))         ;An opener.
+            (rassoc tok smie-closer-alist)) ;An inner.
+        (+ (smie-indent-virtual) (smie-indent--offset 'basic))) ;
+       (t (smie-indent-virtual))))))    ;An infix.
+
+(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.
+  ;; If it's a function call, the first element is special (it's the
+  ;; function).  We distinguish function calls from mere lists of
+  ;; expressions based on whether the preceding token is listed in
+  ;; the `list-intro' entry of smie-indent-rules.
+  ;;
+  ;; TODO: to indent Lisp code, we should add a way to specify
+  ;; particular indentation for particular args depending on the
+  ;; function (which would require always skipping back until the
+  ;; function).
+  ;; TODO: to indent C code, such as "if (...) {...}" we might need
+  ;; to add similar indentation hooks for particular positions, but
+  ;; based on the preceding token rather than based on the first exp.
+  (save-excursion
+    (let ((positions nil)
+          arg)
+      (while (and (null (car (smie-backward-sexp)))
+                  (push (point) positions)
+                  (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)))
+                  (funcall smie-rules-function :list-intro
+                           (funcall smie-backward-token-function)))))
+      (cond
+       ((null positions)
+        ;; We're the first expression of the list.  In that case, the
+        ;; indentation should be (have been) determined by its context.
+        nil)
+       (arg
+        ;; There's a previous element, and it's not special (it's not
+        ;; the function), so let's just align with that one.
+        (goto-char (car positions))
+        (current-column))
+       ((cdr positions)
+        ;; We skipped some args plus the function and bumped into something.
+        ;; Align with the first arg.
+        (goto-char (cadr positions))
+        (current-column))
+       (positions
+        ;; We're the first arg.
+        (goto-char (car positions))
+        (+ (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)))))))
+
+(defvar smie-indent-functions
+  '(smie-indent-fixindent smie-indent-bob smie-indent-close
+                          smie-indent-comment smie-indent-comment-continue smie-indent-comment-close
+                          smie-indent-comment-inside smie-indent-keyword smie-indent-after-keyword
+                          smie-indent-exps)
+  "Functions to compute the indentation.
+Each function is called with no argument, shouldn't move point, and should
+return either nil if it has no opinion, or an integer representing the column
+to which that point should be aligned, if we were to reindent it.")
+
+(defun smie-indent-calculate ()
+  "Compute the indentation to use for point."
+  (run-hook-with-args-until-success 'smie-indent-functions))
+
+(defun smie-indent-line ()
+  "Indent current line using the SMIE indentation engine."
+  (interactive)
+  (let* ((savep (point))
+	 (indent (or (with-demoted-errors
+                       (save-excursion
+                         (forward-line 0)
+                         (skip-chars-forward " \t")
+                         (if (>= (point) savep) (setq savep nil))
+                         (or (smie-indent-calculate) 0)))
+                     0)))
+    (if (not (numberp indent))
+        ;; If something funny is used (e.g. `noindent'), return it.
+        indent
+      (if (< indent 0) (setq indent 0)) ;Just in case.
+      (if savep
+          (save-excursion (indent-line-to indent))
+        (indent-line-to indent)))))
+
+(defun smie-setup (grammar rules-function &rest keywords)
+  "Setup SMIE navigation and indentation.
+GRAMMAR is a grammar table generated by `smie-prec2->grammar'.
+RULES-FUNCTION is a set of indentation rules for use on `smie-rules-function'.
+KEYWORDS are additional arguments, which can use the following keywords:
+- :forward-token FUN
+- :backward-token FUN"
+  (set (make-local-variable 'smie-rules-function) rules-function)
+  (set (make-local-variable 'smie-grammar) grammar)
+  (set (make-local-variable 'indent-line-function) 'smie-indent-line)
+  (set (make-local-variable 'forward-sexp-function)
+       'smie-forward-sexp-command)
+  (while keywords
+    (let ((k (pop keywords))
+          (v (pop keywords)))
+      (case k
+        (:forward-token
+         (set (make-local-variable 'smie-forward-token-function) v))
+        (:backward-token
+         (set (make-local-variable 'smie-backward-token-function) v))
+        (t (message "smie-setup: ignoring unknown keyword %s" k)))))
+  (let ((ca (cdr (assq :smie-closer-alist grammar))))
+    (when ca
+      (set (make-local-variable 'smie-closer-alist) ca)
+      ;; Only needed for interactive calls to blink-matching-open.
+      (set (make-local-variable 'blink-matching-check-function)
+           #'smie-blink-matching-check)
+      (add-hook 'post-self-insert-hook
+                #'smie-blink-matching-open 'append 'local)
+      (set (make-local-variable 'smie-blink-matching-triggers)
+           (append smie-blink-matching-triggers
+                   ;; Rather than wait for SPC to blink, try to blink as
+                   ;; soon as we type the last char of a block ender.
+                   (let ((closers (sort (mapcar #'cdr smie-closer-alist)
+                                        #'string-lessp))
+                         (triggers ())
+                         closer)
+                     (while (setq closer (pop closers))
+                       (unless (and closers
+                                    ;; FIXME: this eliminates prefixes of other
+                                    ;; closers, but we should probably elimnate
+                                    ;; prefixes of other keywords as well.
+                                    (string-prefix-p closer (car closers)))
+                         (push (aref closer (1- (length closer))) triggers)))
+                     (delete-dups triggers)))))))
+
+
+(provide 'smie)
+;;; smie.el ends here