;;; wisi.el --- Utilities for implementing an indentation/navigation engine using a generalized LALR parser
;;
;; Copyright (C) 2012, 2013  Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <stephen_leake@member.fsf.org>
;; Version: 1.0
;; URL: http://stephe-leake.org/emacs/ada-mode/emacs-ada-mode.html
;; Package-Requires: ((cl-lib "0"))
;;
;; 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
;;

;;; Commentary:

;;;; History: first experimental version Oct 2012
;;
;;;; indentation algorithm overview
;;
;; This design is inspired in part by experience writing a SMIE
;; indentation engine for Ada, and the wisent parser.
;;
;; The general approach to indenting a given token is to find the
;; start of the statement it is part of, or some other relevant point
;; in the statement, and indent relative to that.  So we need a parser
;; that lets us find statement indent points from arbitrary places in
;; the code.
;;
;; For example, the grammar for Ada as represented by the EBNF in LRM
;; Annex P is not LALR(1), so we use a generalized LALR(1) parser (see
;; wisi-parse, wisi-compile).
;;
;; The parser actions cache indentation and other information as text
;; properties of tokens in statements.
;;
;; An indentation engine moves text in the buffer, as does user
;; editing, so we can't rely on character positions remaining
;; constant.  So the parser actions use markers to store
;; positions.  Text properties also move with the text.
;;
;; The stored information includes a marker at each statement indent
;; point.  Thus, the indentation algorithm is: find the previous token
;; with cached information, and either indent from it, or fetch from
;; it the marker for a previous statement indent point, and indent
;; relative to that.
;;
;; Since we have a cache (the text properties), we need to consider
;; when to invalidate it.  Ideally, we invalidate only when a change to
;; the buffer would change the result of a parse that crosses that
;; change, or starts after that change.  Changes in whitespace
;; (indentation and newlines) do not affect an Ada parse.  Other
;; languages are sensitive to newlines (Bash for example) or
;; indentation (Python).  Adding comments does not change a parse,
;; unless code is commented out.  For now we invalidate the cache after
;; the edit point if the change involves anything other than
;; whitespace.
;;
;;;; comparison to the SMIE parser
;;
;; The central problem to be solved in building the SMIE parser is
;; grammar precedence conflicts; the general solution is refining
;; keywords so that each new keyword can be assigned a unique
;; precedence.  This means ad hoc code must be written to determine the
;; correct refinement for each language keyword from the surrounding
;; tokens.  In effect, for a complex language like Ada, the knowledge
;; of the language grammar is mostly embedded in the refinement code;
;; only a small amount is in the refined grammar.  Implementing a SMIE
;; parser for a new language involves the same amount of work as the
;; first language.
;;
;; Using a generalized LALR parser avoids that particular problem;
;; assuming the language is already defined by a grammar, it is only a
;; matter of a format change to teach the wisi parser the
;; language.  The problem in a wisi indentation engine is caching the
;; output of the parser in a useful way, since we can't start the
;; parser from arbitrary places in the code (as we can with the SMIE
;; parser). A second problem is determining when to invalidate the
;; cache.  But these problems are independent of the language being
;; parsed, so once we have one wisi indentation engine working,
;; adapting it to new languages should be quite simple.
;;
;; The SMIE parser does not find the start of each statement, only the
;; first language keyword in each statement; additional code must be
;; written to find the statement start and indent points.  The wisi
;; parser finds the statement start and indent points directly.
;;
;; In SMIE, it is best if each grammar rule is a complete statement,
;; so forward-sexp will traverse the entire statement.  If nested
;; non-terminals are used, forward-sexp may stop inside one of the
;; nested non-terminals.  This problem does not occur with the wisi
;; parser.
;;
;; A downside of the wisi parser is conflicts in the grammar; they can
;; be much more difficult to resolve than in the SMIE parser.  The
;; generalized parser helps by handling conflicts, but it does so by
;; running multiple parsers in parallel, persuing each choice in the
;; conflict.  If the conflict is due to a genuine ambiguity, both paths
;; will succeed, which causes the parse to fail, since it is not clear
;; which set of text properties to store.  Even if one branch
;; ultimately fails, running parallel parsers over large sections of
;; code is slow.  Finally, this approach can lead to exponential growth
;; in the number of parsers.  So grammar conflicts must still be
;; analyzed and minimized.
;;
;; In addition, the complete grammar must be specified; in smie, it is
;; often possible to specify a subset of the grammar.
;;
;;;; grammar compiler and parser
;;
;; Since we are using a generalized LALR(1) parser, we cannot use any
;; of the wisent grammar functions.  We use OpenToken wisi-generate
;; to compile BNF to Elisp source (similar to
;; semantic-grammar-create-package), and wisi-compile-grammar to
;; compile that to the parser table.
;;
;; Semantic provides a complex lexer, more complicated than we need
;; for indentation.  So we use the elisp lexer, which consists of
;; `forward-comment', `skip-syntax-forward', and `scan-sexp'.  We wrap
;; that in functions that return tokens in the form wisi-parse
;; expects.
;;
;;;; code style
;;
;; 'wisi' was originally short for "wisent indentation engine", but
;; now is just a name.
;;
;; not using lexical-binding because we support Emacs 23
;;
;;;;;

;;; Code:

(require 'wisi-parse)
(eval-when-compile (require 'cl-lib))

;;;; lexer

(defvar-local wisi-class-list nil)
(defvar-local wisi-keyword-table nil)
(defvar-local wisi-punctuation-table nil)
(defvar-local wisi-punctuation-table-max-length 0)
(defvar-local wisi-string-double-term nil) ;; string delimited by double quotes
(defvar-local wisi-string-quote-escape-doubled nil)
(defvar-local wisi-string-single-term nil) ;; string delimited by single quotes
(defvar-local wisi-symbol-term nil)

(defun wisi-forward-token (&optional text-only)
  "Move point forward across one token, skipping leading whitespace and comments.
Return the corresponding token, in a format determined by TEXT-ONLY:
TEXT-ONLY t:          text
TEXT-ONLY nil:        (token text start . end)
where:
`token' is a token symbol (not string) from `wisi-punctuation-table',
`wisi-keyword-table', `wisi-string-double-term', `wisi-string-double-term' or `wisi-symbol-term'.

`text' is the token text from the buffer

`start, end' are the character positions in the buffer of the start
and end of the token text.

If at end of buffer, returns `wisent-eoi-term'."
  (forward-comment (point-max))
  ;; skips leading whitespace, comment, trailing whitespace.

  (let ((start (point))
	;; (info "(elisp)Syntax Table Internals" "*info elisp syntax*")
	(syntax (syntax-class (syntax-after (point))))
	token-id token-text)
    (cond
     ((eobp)
      (setq token-text "")
      (setq token-id wisent-eoi-term))

     ((eq syntax 1)
      ;; punctuation. Find the longest matching string in wisi-punctuation-table
      (forward-char 1)
      (let ((next-point (point))
	    temp-text temp-id done)
	(while (not done)
	  (setq temp-text (buffer-substring-no-properties start (point)))
	  (setq temp-id (car (rassoc temp-text wisi-punctuation-table)))
	  (when temp-id
	    (setq token-text temp-text
		  token-id temp-id
		  next-point (point)))
	  (if (or
	       (eobp)
	       (= (- (point) start) wisi-punctuation-table-max-length))
	      (setq done t)
	    (forward-char 1))
	  )
	(goto-char next-point)))

     ((memq syntax '(4 5)) ;; open, close parenthesis
      (forward-char 1)
      (setq token-text (buffer-substring-no-properties start (point)))
      (setq token-id (symbol-value (intern-soft token-text wisi-keyword-table))))

     ((eq syntax 7)
      ;; string quote, either single or double. we assume point is before the start quote, not the end quote
      (let ((delim (char-after (point)))
	    (forward-sexp-function nil))
	(forward-sexp)
	;; point is now after the end quote; check for a doubled quote
	(while (and wisi-string-quote-escape-doubled
		    (eq (char-after (point)) delim))
	  (forward-sexp))
	(setq token-text (buffer-substring-no-properties start (point)))
	(setq token-id (if (= delim ?\") wisi-string-double-term wisi-string-single-term))))

     (t ;; assuming word syntax
      (skip-syntax-forward "w_'")
      (setq token-text (buffer-substring-no-properties start (point)))
      (setq token-id
	    (or (symbol-value (intern-soft (downcase token-text) wisi-keyword-table))
		wisi-symbol-term)))
     );; cond

    (unless token-id
      (error (wisi-error-msg "unrecognized token '%s'" (buffer-substring-no-properties start (point)))))

    (if text-only
	token-text
      (cons token-id (cons token-text (cons start (point)))))
    ))

(defun wisi-backward-token ()
  "Move point backward across one token, skipping whitespace and comments.
Return (nil text start . end) - same structure as
wisi-forward-token, but does not look up symbol."
  (forward-comment (- (point)))
  ;; skips leading whitespace, comment, trailing whitespace.

  ;; (info "(elisp)Syntax Table Internals" "*info elisp syntax*")
  (let ((end (point))
	(syntax (syntax-class (syntax-after (1- (point))))))
    (cond
     ((bobp) nil)

     ((memq syntax '(4 5)) ;; open, close parenthesis
      (backward-char 1))

     ((eq syntax 7)
      ;; a string quote. we assume we are after the end quote, not the start quote
      (let ((forward-sexp-function nil))
	(forward-sexp -1)))

     (t
      (if (zerop (skip-syntax-backward "."))
	  (skip-syntax-backward "w_'")))
     )
    (cons nil (cons (buffer-substring-no-properties (point) end) (cons (point) end)))
    ))

;;;; token info cache
;;
;; the cache stores the results of parsing as text properties on
;; keywords, for use by the indention and motion engines.

(cl-defstruct
  (wisi-cache
   (:constructor wisi-cache-create)
   (:copier nil))
  nonterm;; nonterminal from parse (set by wisi-statement-action)

  token
  ;; terminal symbol from wisi-keyword-table or
  ;; wisi-punctuation-table, or lower-level nonterminal from parse
  ;; (set by wisi-statement-action)

  last ;; pos of last char in token, relative to first (0 indexed)

  class
  ;; arbitrary lisp symbol, used for indentation and navigation.
  ;; some classes are defined by wisi:
  ;;
  ;; 'block-middle - a block keyword (ie: if then else end), not at the start of a statement
  ;;
  ;; 'block-start - a block keyword at the start of a statement
  ;;
  ;; 'statement-start - the start of a statement
  ;;
  ;; 'open-paren
  ;;
  ;; others are language-specific

  containing
  ;; Marker at the containing keyword for this token.
  ;; A containing keyword is an indent point; the start of a
  ;; statement, or 'begin', 'then' or 'else' for a block of
  ;; statements, etc.
  ;; nil only for first token in buffer

  prev ;; marker at previous motion token in statement; nil if none
  next ;; marker at next motion token in statement; nil if none
  end ;; marker at token at end of current statement
  )

(defvar-local wisi-cache-max 0
  "Maximimum position in buffer where wisi token cache is valid.")

(defvar-local wisi-parse-table nil)

(defvar-local wisi-parse-failed nil
  "Non-nil when a recent parse has failed - cleared when parse succeeds.")

(defvar-local wisi-parse-try nil
  "Non-nil when parse is needed - cleared when parse succeeds.")

(defvar-local wisi-change-need-invalidate nil)
(defvar-local wisi-change-jit-lock-mode nil)

(defun wisi-invalidate-cache()
  "Invalidate the wisi token cache for the current buffer.
Also invalidate the Emacs syntax cache."
  (interactive)
  (setq wisi-cache-max 0)
  (setq wisi-parse-try t)
  (syntax-ppss-flush-cache (point-min))
  (with-silent-modifications
    (remove-text-properties (point-min) (point-max) '(wisi-cache))))

(defun wisi-before-change (begin end)
  "For `before-change-functions'."
  ;; begin . end is range of text being deleted

  ;; If jit-lock-after-change is before wisi-after-change in
  ;; after-change-functions, it might use any invalid caches in the
  ;; inserted text.
  ;;
  ;; So we check for that here, and ensure it is after
  ;; wisi-after-change, which deletes the invalid caches
  (when (boundp 'jit-lock-mode)
    (when (memq 'wisi-after-change (memq 'jit-lock-after-change after-change-functions))
      (setq after-change-functions (delete 'wisi-after-change after-change-functions))
      (add-hook 'after-change-functions 'wisi-after-change nil t)
      (setq wisi-change-jit-lock-mode (1+ wisi-change-jit-lock-mode)))
    )

  (save-excursion
    ;; don't invalidate parse for whitespace, string, or comment changes
    (let (;; (info "(elisp)Parser State")
	  (state (syntax-ppss begin)))
      ;; syntax-ppss has moved point to "begin".
      (cond
       ((or
	 (nth 3 state); in string
	 (nth 4 state)); in comment
	;; FIXME: check that entire range is in comment or string
	(setq wisi-change-need-invalidate nil))

       ((progn
	  (skip-syntax-forward " " end);; does not skip newline
	  (eq (point) end))
	(setq wisi-change-need-invalidate nil))

       (t (setq wisi-change-need-invalidate t))
       ))))

(defun wisi-after-change (begin end length)
  "For `after-change-functions'."
  ;; begin . end is range of text being inserted (may be empty)
  ;; (syntax-ppss-flush-cache begin) is in before-change-functions

  (syntax-ppss-flush-cache begin) ;; IMPROVEME: could check for whitespace

  (cond
   (wisi-parse-failed
    ;; The parse was failing, probably due to bad syntax; this change
    ;; may have fixed it, so try reparse.
    (setq wisi-parse-try t)

    ;; remove 'wisi-cache on inserted text, which could have caches
    ;; from before the failed parse, and are in any case invalid.
    (with-silent-modifications
      (remove-text-properties begin end '(wisi-cache)))
    )

   ((>= wisi-cache-max begin)
    ;; The parse had succeeded paste the start of the inserted
    ;; text.
    (save-excursion
      (let ((need-invalidate t)
	    ;; (info "(elisp)Parser State")
	    (state (syntax-ppss begin)))
	;; syntax-ppss has moved point to "begin".
	(cond
	 (wisi-change-need-invalidate
	  ;; wisi-before change determined the removed text alters the
	  ;; parse
	  nil)

	 ((or
	   (nth 3 state); in string
	   (nth 4 state)); in comment
	  ;; FIXME: insert newline in comment to create non-comment!?
	  ;; or paste a chunk of code
	  ;; => check that all of change region is comment or string
	  (setq need-invalidate nil))

	 ((progn
	    (skip-syntax-forward " " end);; does not skip newlines
	    (eq (point) end))
	  (setq need-invalidate nil))

	 (t nil)
	 )

	(if need-invalidate
	    ;; The inserted or deleted text could alter the parse
	    (wisi-invalidate-cache)

	  ;; else move cache-max by the net change length. We don't
	  ;; need to delete 'wisi-cache in the inserted text, because
	  ;; if there were any it would not pass the above.
	  (setq wisi-cache-max
		(+ wisi-cache-max (- end begin length))))
	)
      ))

   (t
    ;; parse never attempted, or only done to before BEGIN. Just
    ;; remove 'wisi-cache
    (with-silent-modifications
      (remove-text-properties begin end '(wisi-cache)))
    )
  ))

(defun wisi-get-cache (pos)
  "Return `wisi-cache' struct from the `wisi-cache' text property at POS.
If accessing cache at a marker for a token as set by `wisi-cache-tokens', POS must be (1- mark)."
  (get-text-property pos 'wisi-cache))

(defvar-local wisi-parse-error-msg nil)

(defun wisi-goto-error ()
  "Move point to position in last error message (if any)."
  (when (string-match ":\\([0-9]+\\):\\([0-9]+\\):" wisi-parse-error-msg)
    (let ((line (string-to-number (match-string 1 wisi-parse-error-msg)))
	  (col (string-to-number (match-string 2 wisi-parse-error-msg))))
      (goto-char (point-min))
      (forward-line (1- line))
      (forward-char col))))

(defun wisi-show-parse-error ()
  "Show last wisi-parse error."
  (interactive)
  (if wisi-parse-failed
      (progn
	(message wisi-parse-error-msg)
	(wisi-goto-error))
    (message "parse succeeded")))

(defun wisi-validate-cache (pos)
  "Ensure cached data is valid at least up to POS in current buffer."
  (when (and wisi-parse-try
	    (< wisi-cache-max pos))
    (when (> wisi-debug 0)
      (message "wisi: parsing ..."))

    (setq wisi-parse-try nil)
    (setq wisi-parse-error-msg nil)
    (save-excursion
      (goto-char wisi-cache-max)
      (if (> wisi-debug 1)
	  ;; let debugger stop in wisi-parse
	  (progn
	    (wisi-parse wisi-parse-table 'wisi-forward-token)
	    (setq wisi-cache-max (point))
	    (setq wisi-parse-failed nil))
	;; else capture errors from bad syntax, so higher level functions can try to continue
	(condition-case err
	    (progn
	      (wisi-parse wisi-parse-table 'wisi-forward-token)
	      (setq wisi-cache-max (point))
	      (setq wisi-parse-failed nil))
	  (wisi-parse-error
	   (setq wisi-parse-failed t)
	   (setq wisi-parse-error-msg (cdr err)))
	  )))
    (if wisi-parse-error-msg
	;; error
	(when (> wisi-debug 0)
	  (message "wisi: parsing ... error")
	  (wisi-goto-error)
	  (error wisi-parse-error-msg))
      ;; no msg; success
      (when (> wisi-debug 0)
	(message "wisi: parsing ... done")))
    ))

(defun wisi-get-containing-cache (cache)
  "Return cache from (wisi-cache-containing CACHE)."
  (let ((containing (wisi-cache-containing cache)))
    (and containing
	 (wisi-get-cache (1- containing)))))

(defun wisi-cache-text (cache)
  "Return property-less buffer substring designated by cache.
Point must be at cache."
  (buffer-substring-no-properties (point) (+ (point) (wisi-cache-last cache))))

;;;; parse actions

(defun wisi-set-end (tokens end-mark)
  "Set END-MARK on all unset caches in TOKENS."
  (let ((tokens-t tokens))
    (while tokens-t
      (let* ((token (pop tokens-t))
	     (region (cddr token))
	     cache)
	(when region
	  (goto-char (car region))
	  (setq cache (wisi-get-cache (car region)))
	  (while (and cache
		      (< (point) (cdr region)))
	    (if (not (wisi-cache-end cache))
		(setf (wisi-cache-end cache) end-mark)
	      (goto-char (wisi-cache-end cache))
	      )
	    (setq cache (wisi-forward-cache))
	    ))
	))
    ))

(defvar wisi-tokens nil);; keep byte-compiler happy; `wisi-tokens' is bound in action created by wisi-semantic-action
(defun wisi-statement-action (&rest pairs)
  "Cache information in text properties of tokens.
Intended as a grammar non-terminal action.

PAIRS is of the form [TOKEN-NUMBER CLASS] ...  where TOKEN-NUMBER
is the (1 indexed) token number in the production, CLASS is the wisi class of
that token. Use in a grammar action as:
  (wisi-statement-action 1 'statement-start 7 'statement-end)"
  (save-excursion
    (let ((first-item t)
	  first-keyword-mark
	  (override-start nil))
      (while pairs
	(let* ((number (1- (pop pairs)))
	       (region (cddr (nth number wisi-tokens)));; wisi-tokens is let-bound in wisi-parse-reduce
	       (token (car (nth number wisi-tokens)))
	       (class (pop pairs))
	       (mark
		;; Marker one char into token, so indent-line-to
		;; inserts space before the mark, not after
		(when region (copy-marker (1+ (car region)))))
	       cache)

	  (unless (memq class wisi-class-list)
	    (error "%s not in wisi-class-list" class))

	  (if region
	      (progn
		(if (setq cache (wisi-get-cache (car region)))
		    ;; We are processing a previously set non-terminal; ie generic_formal_part in
		    ;;
		    ;; generic_package_declaration : generic_formal_part package_specification SEMICOLON
		    ;;    (wisi-statement-action 1 'block-start 2 'block-middle 3 'statement-end)
		    ;;
		    ;; or simple_statement in
		    ;;
		    ;; statement : label_opt simple_statement
		    ;;
		    ;; override nonterm, class and containing
		    (progn
		      (cl-case (wisi-cache-class cache)
			(block-start
			 (setf (wisi-cache-class cache)
			       (cond
				 ((eq override-start nil)
				  (cond
				   ((memq class '(block-start statement-start)) 'block-start)
				   (t 'block-middle)))

				 ((memq override-start '(block-start statement-start)) 'block-start)

				 (t (error "unexpected override-start"))
				 )))
			(t
			 (setf (wisi-cache-class cache) (or override-start class)))
			)
		      (setf (wisi-cache-nonterm cache) $nterm)
		      (setf (wisi-cache-containing cache) first-keyword-mark))

		  ;; else create new cache
		  (with-silent-modifications
		    (put-text-property
		     (car region)
		     (1+ (car region))
		     'wisi-cache
		     (wisi-cache-create
		      :nonterm $nterm;; $nterm defined in wisi-semantic-action
		      :token   token
		      :last  (- (cdr region) (car region))
		      :class   (or override-start class)
		      :containing   first-keyword-mark)
		     )))

		(when first-item
		  (setq first-item nil)
		  (when (or override-start
			    (memq class '(block-middle block-start statement-start)))
		    (setq override-start nil)
		    (setq first-keyword-mark mark)))

		(when (eq class 'statement-end)
		  (wisi-set-end wisi-tokens (copy-marker (1+ (car region)))))
		)

	    ;; region is nil when a production is empty; if the first
	    ;; token is a start, override the class on the next token.
	    (when (and first-item
		       (memq class '(block-middle block-start statement-start)))
	      (setq override-start class)))
	))
      )))

(defun wisi-containing-action (containing-token contained-token)
  "Set containing marks in all tokens in CONTAINED-TOKEN with null containing mark to marker pointing to CONTAINING-TOKEN.
If CONTAINING-TOKEN is empty, the next token number is used."
  ;; wisi-tokens is is bound in action created by wisi-semantic-action
  (let* ((containing-region (cddr (nth (1- containing-token) wisi-tokens)))
	 (contained-region (cddr (nth (1- contained-token) wisi-tokens))))
    (while (not containing-region)
      ;; containing-token is empty; use next
      (setq containing-region (cddr (nth containing-token wisi-tokens))))

    (when contained-region
      ;; nil when empty production, may not contain any caches
      (save-excursion
	(goto-char (cdr contained-region))
	(let ((cache (wisi-backward-cache))
	      (mark (copy-marker (1+ (car containing-region)))))
	  (while cache

	    ;; skip blocks that are already marked
	    (while (and (>= (point) (car contained-region))
			(markerp (wisi-cache-containing cache)))
	      (goto-char (1- (wisi-cache-containing cache)))
	      (setq cache (wisi-get-cache (point))))

	    (if (or (and (= (car containing-region) (car contained-region))
			 (<= (point) (car contained-region)))
		    (< (point) (car contained-region)))
		;; done
		(setq cache nil)

	      ;; else set mark, loop
	      (setf (wisi-cache-containing cache) mark)
	      (setq cache (wisi-backward-cache)))
	    ))))))

(defun wisi-motion-action (&rest token-numbers)
  "Set prev/next marks in all tokens given by TOKEN-NUMBERS.
Each TOKEN-NUMBERS is one of:

number: the token number; mark that token

list (number token_id):
list (number (token_id token_id)):
   mark all tokens with token_id in the nonterminal given by the number."
  (save-excursion
    (let (prev-keyword-mark
	  prev-cache
	  cache
	  mark)
      (while token-numbers
	(let ((token-number (pop token-numbers))
	      target-token
	      region)
	  (cond
	   ((numberp token-number)
	    (setq target-token nil)
	    (setq region (cddr (nth (1- token-number) wisi-tokens)))
	    (when region
	      (setq cache (wisi-get-cache (car region)))
	      (setq mark (copy-marker (1+ (car region))))

	      (when (and prev-keyword-mark
			 cache
			 (null (wisi-cache-prev cache)))
		(setf (wisi-cache-prev cache) prev-keyword-mark)
		(setf (wisi-cache-next prev-cache) mark))

	      (setq prev-keyword-mark mark)
	      (setq prev-cache cache)
	      ))

	   ((listp token-number)
	    ;; token-number may contain 0, 1, or more token_id; token_id may be a list
	    ;; the corresponding region may be empty
	    ;; there must have been a prev keyword
	    (setq target-token (cadr token-number))
	    (when (not (listp target-token))
	      (setq target-token (list target-token)))
	    (setq token-number (car token-number))
	    (setq region (cddr (nth (1- token-number) wisi-tokens)))
	    (when region ;; not an empty token
	      (goto-char (car region))
	      (while (wisi-forward-find-token target-token (cdr region) t)
		(setq cache (wisi-get-cache (point)))
		(setq mark (copy-marker (1+ (point))))

		(when (null (wisi-cache-prev cache))
		  (setf (wisi-cache-prev cache) prev-keyword-mark)
		  (setf (wisi-cache-next prev-cache) mark)
		  (setq prev-keyword-mark mark)
		  (setq prev-cache cache))

		(wisi-forward-token);; don't find same token again
		))
	      )

	   (t
	    (error "unexpected token-number %s" token-number))
	   )

	  ))
      )))

;;;; motion
(defun wisi-backward-cache ()
  "Move point backward to the beginning of the first token preceding point that has a cache.
Returns cache, or nil if at beginning of buffer."
  (let (cache pos)
    (setq pos (previous-single-property-change (point) 'wisi-cache))
    ;; There are three cases:
    ;;
    ;; 1) caches separated by non-cache chars: 'if ... then'
    ;;    pos is before 'f', cache is on 'i'
    ;;
    ;; 2) caches not separated: ');'
    ;;    pos is before ';', cache is on ';'
    ;;
    ;; 3) at bob; pos is nil
    ;;
    (if pos
	(progn
	  (setq cache (get-text-property pos 'wisi-cache))
	  (if cache
	      ;; case 2
	      (goto-char pos)
	    ;; case 1
	    (setq cache (get-text-property (1- pos) 'wisi-cache))
	    (goto-char (1- pos))))
      ;; at bob
      (goto-char (point-min))
      (setq cache nil))
    cache
    ))

(defun wisi-forward-cache ()
  "Move point forward to the beginning of the first token after point that has a cache.
Returns cache, or nil if at end of buffer."
  (let (cache pos)
    (when (get-text-property (point) 'wisi-cache)
      ;; on a cache; get past it
      (goto-char (1+ (point))))

    (setq cache (get-text-property (point) 'wisi-cache))
    (if cache
	nil

      (setq pos (next-single-property-change (point) 'wisi-cache))
      (if pos
	  (progn
	    (goto-char pos)
	    (setq cache (get-text-property pos 'wisi-cache)))
	;; at eob
	(goto-char (point-max))
	(setq cache nil))
      )
    cache
    ))

(defun wisi-forward-find-class (class limit)
  "Search forward for a token that has a cache with CLASS.
Return cache, or nil if at end of buffer.
If LIMIT (a buffer position) is reached, throw an error."
  (let ((cache (wisi-forward-cache)))
    (while (not (eq class (wisi-cache-class cache)))
      (setq cache (wisi-forward-cache))
      (when (>= (point) limit)
	(error "cache with class %s not found" class)))
    cache))

(defun wisi-forward-find-token (token limit &optional noerror)
  "Search forward for a token that has a cache with TOKEN.
If point is at a matching token, return that token.
TOKEN may be a list; stop on any cache that has a member of the list.
Return cache, or nil if at end of buffer.
If LIMIT (a buffer position) is reached, then if NOERROR is nil, throw an
error, if non-nil, return nil."
  (let ((token-list (cond
		     ((listp token) token)
		     (t (list token))))
	(cache (wisi-get-cache (point)))
	(done nil))
    (while (not (or done
		    (and cache
			 (memq (wisi-cache-token cache) token-list))))
      (setq cache (wisi-forward-cache))
      (when (>= (point) limit)
	(if noerror
	    (progn
	      (setq done t)
	      (setq cache nil))
	  (error "cache with token %s not found" token))))
    cache))

(defun wisi-forward-find-nonterm (nonterm limit)
  "Search forward for a token that has a cache with NONTERM.
NONTERM may be a list; stop on any cache that has a member of the list.
Return cache, or nil if at end of buffer.
If LIMIT (a buffer position) is reached, throw an error."
  (let ((nonterm-list (cond
		       ((listp nonterm) nonterm)
		       (t (list nonterm))))
	(cache (wisi-forward-cache)))
    (while (not (memq (wisi-cache-nonterm cache) nonterm-list))
      (setq cache (wisi-forward-cache))
      (when (>= (point) limit)
	(error "cache with nonterm %s not found" nonterm)))
    cache))

(defun wisi-goto-cache-next (cache)
  (goto-char (1- (wisi-cache-next cache)))
  (wisi-get-cache (point))
  )

(defun wisi-forward-statement-keyword ()
  "If not at a cached token, move forward to next
cache. Otherwise move to cache-next, or next cache if nil.
Return cache found."
  (wisi-validate-cache (point-max))
  (let ((cache (wisi-get-cache (point))))
    (if cache
	(let ((next (wisi-cache-next cache)))
	  (if next
	      (goto-char (1- next))
	    (wisi-forward-token)
	    (wisi-forward-cache)))
      (wisi-forward-cache))
    )
  (wisi-get-cache (point))
  )

(defun wisi-backward-statement-keyword ()
  "If not at a cached token, move backward to prev
cache. Otherwise move to cache-prev, or prev cache if nil."
  (wisi-validate-cache (point-max))
  (let ((cache (wisi-get-cache (point))))
    (if cache
	(let ((prev (wisi-cache-prev cache)))
	  (if prev
	      (goto-char (1- prev))
	    (wisi-backward-cache)))
      (wisi-backward-cache))
  ))

(defun wisi-goto-containing (cache &optional error)
  "Move point to containing token for CACHE, return cache at that point."
  (cond
   ((markerp (wisi-cache-containing cache))
    (goto-char (1- (wisi-cache-containing cache)))
    (wisi-get-cache (point)))
   (t
    (when error
      (error "already at outermost containing token")))
   ))

(defun wisi-goto-containing-paren (cache)
  "Move point to just after the open-paren containing CACHE.
Return cache for paren, or nil if no containing paren."
  (while (and cache
	      (not (eq (wisi-cache-class cache) 'open-paren)))
    (setq cache (wisi-goto-containing cache)))
  (when cache
    (forward-char 1))
  cache)

(defun wisi-goto-start (cache)
  "Move point to containing ancestor of CACHE that has class block-start or statement-start.
Return start cache."
  (when
    ;; cache nil at bob
    (while (and cache
		(not (memq (wisi-cache-class cache) '(block-start statement-start))))
      (setq cache (wisi-goto-containing cache)))
    )
  cache)

(defun wisi-goto-end ()
  "Move point to token at end of statement point is in or before."
  (interactive)
  (wisi-validate-cache (point-max))
  (let ((cache (or (wisi-get-cache (point))
		   (wisi-forward-cache))))
    (when (wisi-cache-end cache)
      ;; nil when cache is statement-end
      (goto-char (1- (wisi-cache-end cache))))
    ))

(defun wisi-next-statement-cache (cache)
  "Move point to CACHE-next, return cache; error if nil."
  (when (not (markerp (wisi-cache-next cache)))
    (error "no next statement cache"))
  (goto-char (1- (wisi-cache-next cache)))
  (wisi-get-cache (point)))

(defun wisi-prev-statement-cache (cache)
  "Move point to CACHE-next, return cache; error if nil."
  (when (not (markerp (wisi-cache-prev cache)))
    (error "no prev statement cache"))
  (goto-char (1- (wisi-cache-prev cache)))
  (wisi-get-cache (point)))

;;;; indentation

(defun wisi-comment-indent ()
  "For `comment-indent-function'. Indent single line comment to
the comment on the previous line."
  ;; This should only be called by comment-indent-new-line or
  ;; fill-comment-paragraph, so there will be a preceding comment line
  ;; that we can trust.
  (save-excursion
    (forward-comment -1)
    (if (looking-at comment-start)
	(current-column)
      (error "wisi-comment-indent called after non-comment"))))

(defun wisi-indent-current (offset)
  "Return indentation OFFSET relative to indentation of current line."
  (+ (current-indentation) offset)
  )

(defun wisi-indent-paren (offset)
  "Return indentation OFFSET relative to preceding open paren."
  (save-excursion
    (goto-char (nth 1 (syntax-ppss)))
    (+ (current-column) offset)))

(defun wisi-indent-start (offset cache)
  "Return indentation of OFFSET relative to containing ancestor
of CACHE with class statement-start or block-start."
  (wisi-goto-start cache)
  (+ (current-indentation) offset))

(defun wisi-indent-statement ()
  "Indent region given by `wisi-goto-start' on cache at or before point, then wisi-cache-end."
  ;; force reparse, in case parser got confused
  (let ((wisi-parse-try t))
    (wisi-validate-cache (point)))

  (save-excursion
    (let ((cache (or (wisi-get-cache (point))
		     (wisi-backward-cache))))
      (when cache
	;; can be nil if in header comment
	(let ((start (progn (wisi-goto-start cache) (point)))
	      (end (progn
		     (when (wisi-cache-end cache)
		       ;; nil when cache is statement-end
		       (goto-char (1- (wisi-cache-end cache))))
		     (point))))
	  (indent-region start end)
	  ))
      )))

(defvar-local wisi-indent-calculate-functions nil
  "Functions to calculate indentation. Each called with point
  before a token at the beginning of a line (at current
  indentation); return indentation column for that token, or
  nil. May move point. Calling stops when first function returns
  non-nil.")

(defvar-local wisi-post-parse-fail-hook
  "Function to reindent portion of buffer.
Called from `wisi-indent-line' when a parse succeeds after
failing; assumes user was editing code that is now syntactically
correct. Must leave point at indentation of current line.")

(defvar-local wisi-indent-failed nil
  "Non-nil when wisi-indent-line fails due to parse failing; cleared when indent succeeds.")

(defun wisi-indent-line ()
  "Indent current line using the wisi indentation engine."
  (interactive)

  (let* ((savep (point))
	 (indent
	  (or (save-excursion
		(wisi-validate-cache (point))
		(back-to-indentation)
		(when (>= (point) savep) (setq savep nil))
		(if wisi-parse-failed
		    (progn
		      ;; parse failed. Assume user is editing; indent to previous line, fix it after parse succeeds
		      (setq wisi-indent-failed t)
		      (forward-line -1);; safe at bob
		      (back-to-indentation)
		      (current-column))

		  ;; else parse succeeded
		  (when wisi-indent-failed
		    (setq wisi-indent-failed nil)
		    (run-hooks 'wisi-post-parse-fail-hook))
		  (with-demoted-errors
		    (or (run-hook-with-args-until-success 'wisi-indent-calculate-functions) 0))
		  )))))
    (if savep
	;; point was inside line text; leave it there
	(save-excursion (indent-line-to indent))
      ;; point was before line text; move to start of text
      (indent-line-to indent))
    ))

;;;; debug
(defun wisi-parse-buffer ()
  (interactive)
  (syntax-propertize (point-max))
  (wisi-invalidate-cache)
  (wisi-validate-cache (point-max)))

(defun wisi-show-cache ()
  "Show cache at point."
  (interactive)
  (message "%s" (wisi-get-cache (point))))

(defun wisi-show-token ()
  "Move forward across one keyword, show token_id."
  (interactive)
  (let ((token (wisi-forward-token)))
    (message "%s" (car token))))

(defun wisi-show-containing-or-previous-cache ()
  (interactive)
  (let ((cache (wisi-get-cache (point))))
    (if cache
	(message "containing %s" (wisi-goto-containing cache t))
      (message "previous %s" (wisi-backward-cache)))
    ))

;;;;; setup

(defun wisi-setup (indent-calculate post-parse-fail class-list keyword-table token-table parse-table)
  "Set up a buffer for parsing files with wisi."
  (setq wisi-class-list class-list)
  (setq wisi-string-double-term (car (symbol-value (intern-soft "string-double" token-table))))
  (setq wisi-string-single-term (car (symbol-value (intern-soft "string-single" token-table))))
  (setq wisi-symbol-term (car (symbol-value (intern-soft "symbol" token-table))))

  (setq wisi-punctuation-table (symbol-value (intern-soft "punctuation" token-table)))
  (setq wisi-punctuation-table-max-length 0)
  (let (fail)
    (dolist (item wisi-punctuation-table)
      (when item ;; default matcher can be nil

	;; check that all chars used in punctuation tokens have punctuation syntax
	(mapc (lambda (char)
		(when (not (= ?. (char-syntax char)))
		  (setq fail t)
		  (message "in %s, %c does not have punctuation syntax"
			   (car item) char)))
	      (cdr item))

	(when (< wisi-punctuation-table-max-length (length (cdr item)))
	  (setq wisi-punctuation-table-max-length (length (cdr item)))))
      )
    (when fail
      (error "aborting due to punctuation errors")))

  (setq wisi-keyword-table keyword-table)
  (setq wisi-parse-table parse-table)

  (setq wisi-indent-calculate-functions indent-calculate)
  (set (make-local-variable 'indent-line-function) 'wisi-indent-line)

  (setq wisi-post-parse-fail-hook post-parse-fail)
  (setq wisi-indent-failed nil)

  (add-hook 'before-change-functions 'wisi-before-change nil t)
  (add-hook 'after-change-functions 'wisi-after-change nil t)

  ;; WORKAROUND: sometimes the first time font-lock is run,
  ;; syntax-propertize is not run properly, so we run it here
  (syntax-propertize (point-max))

  (wisi-invalidate-cache)

  ;; FIXME: debug counter
  (setq wisi-change-jit-lock-mode 0)
  )

(provide 'wisi)
;;; wisi.el ends here