[Emacs-diffs] /srv/bzr/emacs/trunk r101830: SMIE: Reliably distinguish openers/closers in smie-prec2-levels

[Stefan Monnier]

------------------------------------------------------------
revno: 101830
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Thu 2010-10-07 13:27:19 +0200
message:
  SMIE: Reliably distinguish openers/closers in smie-prec2-levels
  * lisp/emacs-lisp/smie.el (smie-bnf-classify): New function.
  (smie-bnf-precedence-table): Use it to remember the closers/openers.
  (smie-merge-prec2s): Handle those new entries.
  (smie-prec2-levels): Only set precedence to nil for actual
  openers/closers.
  * lisp/progmodes/octave-mod.el (octave-smie-op-levels): Remove dummy entry
  that is now unnecessary.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/smie.el
  lisp/progmodes/octave-mod.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-10-07 07:24:21 +0000
+++ b/lisp/ChangeLog    2010-10-07 11:27:19 +0000
@@ -1,3 +1,13 @@
+2010-10-07  Stefan Monnier  <address@hidden>
+
+       * emacs-lisp/smie.el (smie-bnf-classify): New function.
+       (smie-bnf-precedence-table): Use it to remember the closers/openers.
+       (smie-merge-prec2s): Handle those new entries.
+       (smie-prec2-levels): Only set precedence to nil for actual
+       openers/closers.
+       * progmodes/octave-mod.el (octave-smie-op-levels): Remove dummy entry
+       that is now unnecessary.
+
 2010-10-07  Miles Bader  <Miles Bader <address@hidden>>
 
        * emacs-lisp/regexp-opt.el (regexp-opt): Add `symbols' mode.
@@ -25,8 +35,8 @@
 
 2010-10-06  Michael Albinus  <address@hidden>
 
-       * net/tramp-sh.el (tramp-sh-file-name-handler-alist): Use
-       `tramp-handle-find-backup-file-name'.
+       * net/tramp-sh.el (tramp-sh-file-name-handler-alist):
+       Use `tramp-handle-find-backup-file-name'.
 
 2010-10-06  Glenn Morris  <address@hidden>
 

=== modified file 'lisp/emacs-lisp/smie.el'
--- a/lisp/emacs-lisp/smie.el   2010-09-21 21:18:08 +0000
+++ b/lisp/emacs-lisp/smie.el   2010-10-07 11:27:19 +0000
@@ -138,7 +138,12 @@
     (let ((prec2 (make-hash-table :test 'equal)))
       (dolist (table tables)
         (maphash (lambda (k v)
-                   (smie-set-prec2tab prec2 (car k) (cdr 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)))
 
@@ -225,6 +230,9 @@
                                    '= 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-levels.
+    (puthash :smie-open/close-alist (smie-bnf-classify bnf) prec2)
     prec2))
 
 ;; (defun smie-prec2-closer-alist (prec2 include-inners)
@@ -307,6 +315,33 @@
                 (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.
@@ -345,11 +380,6 @@
 (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
-  ;;   collapsed into a single equivalence class in smie-op-levels) for
-  ;;   smie-close-block as well as to detect mismatches in smie-next-sexp
-  ;;   or in blink-paren (as well as to do the blink-paren for inner
-  ;;   keywords like the "in" of "let..in..end").
   ;; - better default indentation rules (i.e. non-zero indentation after inner
   ;;   keywords like the "in" of "let..in..end") for smie-indent-after-keyword.
   ;; Of course, maybe those things would be even better handled in the
@@ -369,18 +399,19 @@
     ;; variables (aka "precedence levels").  These can be either
     ;; equality constraints (in `eqs') or `<' constraints (in `csts').
     (maphash (lambda (k v)
-               (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))))
+               (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))
@@ -432,16 +463,22 @@
         (setcar (car eq) (cadr eq)))
       ;; Finally, fill in the remaining vars (which only appeared on the
       ;; right side of the < constraints).
-      (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, to make it easier to recognize.
-        (unless (or (nth 1 x) (nth 2 x))
-          (setf (nth 1 x) i)
-          (setf (nth 2 x) i))))
+      (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.
     table))
 
 ;;; Parsing using a precedence level table.

=== modified file 'lisp/progmodes/octave-mod.el'
--- a/lisp/progmodes/octave-mod.el      2010-09-10 23:13:42 +0000
+++ b/lisp/progmodes/octave-mod.el      2010-10-07 11:27:19 +0000
@@ -456,10 +456,7 @@
      octave-smie-bnf-table
      '((assoc "\n" ";")))
 
-    (smie-precs-precedence-table
-     (append octave-operator-table
-             '((nonassoc " -dummy- "))) ;Bogus anchor at the end.
-     ))))
+    (smie-precs-precedence-table octave-operator-table))))
 
 ;; Tokenizing needs to be refined so that ";;" is treated as two
 ;; tokens and also so as to recognize the \n separator (and