;; wisi-elisp-parse.el --- Wisi parser  -*- lexical-binding:t -*-

;; Copyright (C) 2013-2015, 2017 - 2018  Free Software Foundation, Inc.

;; 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:

;; An extended LALR parser, that handles shift/reduce and
;; reduce/reduce conflicts by spawning parallel parsers to follow each
;; path.

;;; Code:

(require 'cl-lib)
(require 'wisi-elisp-lexer)
(require 'wisi-parse-common)

(defvar wisi-elisp-parse-max-parallel-current (cons 0 0)
  "Cons (count . point); Maximum number of parallel parsers used in most recent parse,
point at which that max was spawned.")

(defvar wisi-debug-identical 0
  "Debug terminating identical parsers.
0 - keep lower-numbered parser.
1 - keep higher-numbered parser.
2 - error.")

(cl-defstruct (wisi-elisp-parser-state
	    (:copier nil))
  label ;; integer identifying parser for debug

  active
  ;; 'shift  - need new token
  ;; 'reduce - need reduce
  ;; 'accept - parsing completed
  ;; 'error  - failed, error not reported yet
  ;; nil     - terminated
  ;;
  ;; 'pending-shift, 'pending-reduce - newly created parser

  stack
  ;; Each stack item takes two slots: wisi-tok, state

  sp ;; stack pointer

  pending
  ;; list of (action-symbol stack-fragment)
  )

(cl-defstruct (wisi-elisp-parser (:include wisi-parser))
  actions
  gotos
  next-token
  )

;;;###autoload
(defun wisi-make-elisp-parser (automaton next-token)
  "Return ‘wisi-parser’ object.

- AUTOMATON is the parse table generated by `wisi-compile-grammar'.

- NEXT-TOKEN is a function with no argument called by the parser to
  obtain the next token from the current buffer after point, as a
  ’wisi-tok’ object (normally ‘wisi-forward-token’)."
  (make-wisi-elisp-parser
   :actions (aref automaton 0)
   :gotos (aref automaton 1)
   :next-token next-token))

(cl-defmethod wisi-parse-kill ((_parser wisi-elisp-parser))
  nil)

(defvar wisi-elisp-parse--indent
  ;; not buffer-local; only let-bound in wisi-parse-current (elisp)
  "A vector of indentation for all lines in buffer.
Each element can be one of:
- integer : indent

- list ('anchor (start-id ...) indent)  :
  indent for current line, base indent for following 'anchored
  lines. Start-id is list of ids anchored at this line. For parens
  and other uses.

- list ('anchored id delta) :
  indent = delta + 'anchor id line indent; for lines indented
  relative to anchor.

- list ('anchor (start-id ...) ('anchored id delta))
  for nested anchors.")

(cl-defmethod wisi-parse-current ((parser wisi-elisp-parser))
  "Parse current buffer from beginning."

  (let* ((actions (wisi-elisp-parser-actions parser))
	 (gotos   (wisi-elisp-parser-gotos parser))
	 (parser-states ;; vector of parallel parser states
	  (vector
	   (make-wisi-elisp-parser-state
	    :label 0
	    :active  'shift
	    :stack   (make-vector wisi-parse-max-stack-size nil)
	    :sp      0
	    :pending nil)))
	 (active-parser-count 1)
	 active-parser-count-prev
	 (active 'shift)
	 (token nil)
	 some-pending
	 wisi-elisp-parse--indent)

    (cl-case wisi--parse-action
      (indent
       (let ((line-count (1+ (count-lines (point-min) (point-max)))))
	 (setq wisi-elisp-parse--indent (make-vector line-count 0))
	 (wisi-elisp-lexer-reset line-count wisi--lexer)))

      (navigate
       (setq wisi-end-caches nil))

      (t nil))

    (setf (wisi-parser-lexer-errors parser) nil)
    (setf (wisi-parser-parse-errors parser) nil)

    ;; We assume the lexer relies on syntax properties
    (when (< emacs-major-version 25) (syntax-propertize (point-max)))

    (goto-char (point-min))
    (forward-comment (point-max))
    (aset (wisi-elisp-parser-state-stack (aref parser-states 0)) 0 0)

    (setq token (funcall (wisi-elisp-parser-next-token parser)))
    (setq wisi-elisp-parse-max-parallel-current (cons 0 0))

    (while (not (eq active 'accept))
      (setq active-parser-count-prev active-parser-count)
      (setq some-pending nil)
      (dotimes (parser-index (length parser-states))
	(when (eq active (wisi-elisp-parser-state-active (aref parser-states parser-index)))
	  (let* ((parser-state (aref parser-states parser-index))
		 (result (wisi-elisp-parse-1 token parser-state (> active-parser-count 1) actions gotos)))
	    (when result
	      ;; spawn a new parser
	      (when (= active-parser-count wisi-parse-max-parallel)
		(let* ((state (aref (wisi-elisp-parser-state-stack parser-state)
				    (wisi-elisp-parser-state-sp parser-state)))
		       (msg (wisi-error-msg (concat "too many parallel parsers required in grammar state %d;"
						    " simplify grammar, or increase `wisi-elisp-parse-max-parallel'")
					    state)))
		  (push (make-wisi--parse-error :pos (point) :message msg) (wisi-parser-parse-errors parser))
		  (signal 'wisi-parse-error msg)))

	      (let ((j (wisi-elisp-parse-free-parser parser-states)))
		(cond
		 ((= j -1)
		  ;; Add to parser-states; the new parser won't be executed
		  ;; again in this parser-index loop.
		  (setq parser-states (vconcat parser-states (vector nil)))
		  (setq j (1- (length parser-states))))
		 ((< j parser-index)
		  ;; The new parser won't be executed again in this
		  ;; parser-index loop; nothing to do.
		  )
		 (t
		  ;; Don't let the new parser execute again in this
		  ;; parser-index loop.
		  (setq some-pending t)
		  (setf (wisi-elisp-parser-state-active result)
			(cl-case (wisi-elisp-parser-state-active result)
			  (shift 'pending-shift)
			  (reduce 'pending-reduce)
			 )))
		  )
		(setq active-parser-count (1+ active-parser-count))
		(when (> active-parser-count (car wisi-elisp-parse-max-parallel-current))
		  (setq wisi-elisp-parse-max-parallel-current (cons active-parser-count (point))))
		(setf (wisi-elisp-parser-state-label result) j)
		(aset parser-states j result))
	      (when (> wisi-debug 1)
                (message "spawn parser (%d active)" active-parser-count)))

	    (when (eq 'error (wisi-elisp-parser-state-active parser-state))
	      (setq active-parser-count (1- active-parser-count))
	      (when (> wisi-debug 1)
                (message "terminate parser (%d active)" active-parser-count))
	      (cl-case active-parser-count
		(0
		 (cond
		  ((= active-parser-count-prev 1)
		   ;; We were not in a parallel parse; abandon parsing, report the error.
		   (let* ((state (aref (wisi-elisp-parser-state-stack parser-state)
				       (wisi-elisp-parser-state-sp parser-state)))
			  (msg (wisi-error-msg "syntax error in grammar state %d; unexpected %s, expecting one of %s"
					       state
					       (wisi-token-text token)
					       (mapcar 'car (aref actions state)))))
		     (push (make-wisi--parse-error :pos (point) :message msg) (wisi-parser-parse-errors parser))
		     (signal 'wisi-parse-error msg)))
		  (t
		   ;; Report errors from all parsers that failed on this token.
		   (let ((msg))
		     (dotimes (_ (length parser-states))
		       (let* ((parser-state (aref parser-states parser-index))
			      (state (aref (wisi-elisp-parser-state-stack parser-state)
					   (wisi-elisp-parser-state-sp parser-state))))
			 (when (eq 'error (wisi-elisp-parser-state-active parser-state))
			   (setq msg
				 (concat msg
					 (when msg "\n")
					 (wisi-error-msg
					  "syntax error in grammar state %d; unexpected %s, expecting one of %s"
					  state
					  (wisi-token-text token)
					  (mapcar 'car (aref actions state)))))
			   )))
		     (push (make-wisi--parse-error :pos (point) :message msg) (wisi-parser-parse-errors parser))
		     (signal 'wisi-parse-error msg)))
		  ))

		(1
		 (setf (wisi-elisp-parser-state-active parser-state) nil); Don't save error for later.
		 (wisi-elisp-parse-execute-pending (aref parser-states (wisi-elisp-parse-active-parser parser-states))))

		(t
		 ;; We were in a parallel parse, and this parser
		 ;; failed; mark it inactive, don't save error for
		 ;; later.
		 (setf (wisi-elisp-parser-state-active parser-state) nil)
		 )))
	    )));; end dotimes

      (when some-pending
	;; Change pending-* parsers to *.
	(dotimes (parser-index (length parser-states))
	  (cond
	   ((eq (wisi-elisp-parser-state-active (aref parser-states parser-index)) 'pending-shift)
	    (setf (wisi-elisp-parser-state-active (aref parser-states parser-index)) 'shift))
	   ((eq (wisi-elisp-parser-state-active (aref parser-states parser-index)) 'pending-reduce)
	    (setf (wisi-elisp-parser-state-active (aref parser-states parser-index)) 'reduce))
	   )))

      (setq active (wisi-elisp-parsers-active parser-states active-parser-count))
      (when (eq active 'shift)
	(when (> active-parser-count 1)
	  (setq active-parser-count (wisi-elisp-parse-elim-identical parser parser-states active-parser-count)))

	(setq token (funcall (wisi-elisp-parser-next-token parser))))
    )
    (when (> active-parser-count 1)
      (error "ambiguous parse result"))

    (cl-case wisi--parse-action
      (indent
       (wisi-elisp-parse--indent-leading-comments)
       (wisi-elisp-parse--resolve-anchors))

      (t nil))
    ))

(defun wisi-elisp-parsers-active-index (parser-states)
  ;; only called when active-parser-count = 1
  (let ((result nil)
	(i 0))
    (while (and (not result)
		(< i (length parser-states)))
      (when (wisi-elisp-parser-state-active (aref parser-states i))
	(setq result i))
      (setq i (1+ i)))
    result))

(defun wisi-elisp-parsers-active (parser-states active-count)
  "Return the type of parser cycle to execute.
PARSER-STATES[*].active is the last action a parser took. If it
was `shift', that parser used the input token, and should not be
executed again until another input token is available, after all
parsers have shifted the current token or terminated.

Returns one of:

`accept' : all PARSER-STATES have active set to nil or `accept' -
done parsing

`shift' : all PARSER-STATES have active set to nil, `accept', or
`shift' - get a new token, execute `shift' parsers.

`reduce' : some PARSER-STATES have active set to `reduce' - no new
token, execute `reduce' parsers."
  (let ((result nil)
	(i 0)
	(shift-count 0)
	(accept-count 0)
	active)
    (while (and (not result)
		(< i (length parser-states)))
      (setq active (wisi-elisp-parser-state-active (aref parser-states i)))
      (cond
	((eq active 'shift) (setq shift-count (1+ shift-count)))
	((eq active 'reduce) (setq result 'reduce))
	((eq active 'accept) (setq accept-count (1+ accept-count)))
	)
      (setq i (1+ i)))

    (cond
     (result )
     ((= accept-count active-count)
      'accept)
     ((= (+ shift-count accept-count) active-count)
      'shift)
     (t
      ;; all parsers in error state; should not get here
      (error "all parsers in error state; programmer error"))
     )))

(defun wisi-elisp-parse-free-parser (parser-states)
  "Return index to a non-active parser in PARSER-STATES, -1 if there is none."
  (let ((result nil)
	(i 0))
    (while (and (not result)
		(< i (length parser-states)))
      (when (not (wisi-elisp-parser-state-active (aref parser-states i)))
	(setq result i))
      (setq i (1+ i)))
    (if result result -1)))

(defun wisi-elisp-parse-active-parser (parser-states)
  "Return index to the first active parser in PARSER-STATES."
  (let ((result nil)
	(i 0))
    (while (and (not result)
		(< i (length parser-states)))
      (when (wisi-elisp-parser-state-active (aref parser-states i))
	(setq result i))
      (setq i (1+ i)))
    (unless result
      (error "no active parsers"))
    result))

(defun wisi-elisp-parse-elim-identical (parser parser-states active-parser-count)
  "Check for parsers in PARSER-STATES that have reached identical states eliminate one.
Return new ACTIVE-PARSER-COUNT. Assumes all parsers have active
nil, `shift', or `accept'."
  ;; parser-states passed by reference; active-parser-count by copy
  ;; see test/ada_mode-slices.adb for example
  (dotimes (parser-i (1- (length parser-states)))
    (when (wisi-elisp-parser-state-active (aref parser-states parser-i))
      (dotimes (parser-j (- (length parser-states) parser-i 1))
	(when (wisi-elisp-parser-state-active (aref parser-states (+ parser-i parser-j 1)))
	  (when (eq (wisi-elisp-parser-state-sp (aref parser-states parser-i))
		     (wisi-elisp-parser-state-sp (aref parser-states (+ parser-i parser-j 1))))
	    (let ((compare t)
		  exec)
	      (dotimes (stack-i (wisi-elisp-parser-state-sp (aref parser-states parser-i)))
		(setq
		 compare
		 (and compare ;; bypass expensive 'arefs' after first stack item compare fail
		      (equal (aref (wisi-elisp-parser-state-stack (aref parser-states parser-i)) stack-i)
			     (aref (wisi-elisp-parser-state-stack (aref parser-states (+ parser-i parser-j 1)))
				   stack-i)))))
	      (when compare
		;; parser stacks are identical
		(setq active-parser-count (1- active-parser-count))
		(when (> wisi-debug 1)
		  (message "terminate identical parser %d (%d active)"
			   (+ parser-i parser-j 1) active-parser-count)
		  (let ((state-i (aref parser-states parser-i))
			(state-j (aref parser-states (+ parser-i parser-j 1))))
		    (message "%d actions:" (wisi-elisp-parser-state-label state-i))
		    (mapc #'wisi-elisp-parse-debug-put-action (wisi-elisp-parser-state-pending state-i))

		    (message "%d actions:" (wisi-elisp-parser-state-label state-j))
		    (mapc #'wisi-elisp-parse-debug-put-action (wisi-elisp-parser-state-pending state-j))
		    ))
		(cl-ecase wisi-debug-identical
		  (0
		   (setq exec parser-i)
		   (setf (wisi-elisp-parser-state-active (aref parser-states (+ parser-i parser-j 1))) nil))

		  (1
		   (setq exec (+ parser-i parser-j 1))
		   (setf (wisi-elisp-parser-state-active (aref parser-states parser-i)) nil))

		  (2
		   (let ((msg "identical parser stacks"))
		     (push (make-wisi--parse-error :pos (point) :message msg) (wisi-parser-parse-errors parser))
		     (signal 'wisi-parse-error msg)))
		  )
		(when (= active-parser-count 1)
		  ;; The actions for the two parsers are not
		  ;; identical, but most of the time either is good
		  ;; enough for indentation and navigation, so we just
		  ;; do the actions for the one that is not
		  ;; terminating. Some times, a significant action is
		  ;; lost. In that case, turn on
		  ;; ‘wisi-debug-identical’ to investigate fixing it.
		  (wisi-elisp-parse-execute-pending (aref parser-states exec)))
		))))
	)))
  active-parser-count)

(defun wisi-elisp-parse-exec-action (func nonterm tokens)
  "Execute action if TOKENS not null."
  ;; `tokens' is null when all tokens in a grammar statement are
  ;; optional and not present.
  (unless wisi-action-disable
    (if (< 0 (length tokens))
	(when wisi--parse-action
	  (funcall func nonterm tokens))

      (when (> wisi-debug 1)
	(message "... action skipped; no tokens"))
      )))

(defvar wisi-elisp-parser-state nil
  "Let-bound in `wisi-elisp-parse-reduce', used in `wisi-parse-find-token'.")

(defun wisi-elisp-parse-debug-put-action (action)
  ;; Action is (semantic-function nonterm [tokens])
  (message "%s [%s]"
	   (nth 0 action)
	   (mapcar #'wisi-tok-debug-image (nth 2 action))))

(defun wisi-elisp-parse-execute-pending (parser-state)
  (let ((wisi-elisp-parser-state parser-state);; reference, for wisi-parse-find-token
	(pending (wisi-elisp-parser-state-pending parser-state)))

    (when (> wisi-debug 1)
      (message "%d: pending actions:" (wisi-elisp-parser-state-label parser-state)))

    (while pending
      (when (> wisi-debug 1) (wisi-elisp-parse-debug-put-action (car pending)))

      (let ((func-args (pop pending)))
	(wisi-elisp-parse-exec-action (nth 0 func-args) (nth 1 func-args) (cl-caddr func-args)))
      )
    (setf (wisi-elisp-parser-state-pending parser-state) nil)
    ))

(defmacro wisi-elisp-parse-action (i al)
  "Return the parser action.
I is a token item number and AL is the list of (item . action)
available at current state.  The first element of AL contains the
default action for this state."
  `(cdr (or (assq ,i ,al) (car ,al))))

(defun wisi-elisp-parse-1 (token parser-state pendingp actions gotos)
  "Perform one shift or reduce on PARSER-STATE.
If PENDINGP, push actions onto PARSER-STATE.pending; otherwise execute them.
See `wisi-elisp-parse' for full details.
Return nil or new parser (a wisi-elisp-parser-state struct)."
  (let* ((state (aref (wisi-elisp-parser-state-stack parser-state)
		(wisi-elisp-parser-state-sp parser-state)))
	 (parse-action (wisi-elisp-parse-action (wisi-tok-token token) (aref actions state)))
	 new-parser-state)

    (when (> wisi-debug 1)
      ;; output trace info
      (if (> wisi-debug 2)
	  (progn
	    ;; put top 10 stack items
	    (let* ((count (min 20 (wisi-elisp-parser-state-sp parser-state)))
		   (msg (make-vector (+ 1 count) nil)))
	      (dotimes (i count)
		(aset msg (- count i)
		      (aref (wisi-elisp-parser-state-stack parser-state)
			    (- (wisi-elisp-parser-state-sp parser-state) i)))
		)
	      (message "%d: %s: %d: %s"
		       (wisi-elisp-parser-state-label parser-state)
		       (wisi-elisp-parser-state-active parser-state)
		       (wisi-elisp-parser-state-sp parser-state)
		       msg))
	    (message "   %d: %s: %s" state (wisi-tok-debug-image token) parse-action))
	(message "%d: %d: %s: %s" (wisi-elisp-parser-state-label parser-state) state token parse-action)))

    (when (and (listp parse-action)
	       (not (symbolp (car parse-action))))
      ;; Conflict; spawn a new parser.
      (setq new-parser-state
	    (make-wisi-elisp-parser-state
	     :active  nil
	     :stack   (vconcat (wisi-elisp-parser-state-stack parser-state))
	     :sp      (wisi-elisp-parser-state-sp parser-state)
	     :pending (wisi-elisp-parser-state-pending parser-state)))

      (wisi-elisp-parse-2 (cadr parse-action) token new-parser-state t gotos)
      (setq pendingp t)
      (setq parse-action (car parse-action))
      );; when

    ;; current parser
    (wisi-elisp-parse-2 parse-action token parser-state pendingp gotos)

    new-parser-state))

(defun wisi-elisp-parse-2 (action token parser-state pendingp gotos)
  "Execute parser ACTION (must not be a conflict).
Return nil."
  (cond
   ((eq action 'accept)
    (setf (wisi-elisp-parser-state-active parser-state) 'accept))

   ((eq action 'error)
    (setf (wisi-elisp-parser-state-active parser-state) 'error))

   ((natnump action)
    ;; Shift token and new state (= action) onto stack
    (let ((stack (wisi-elisp-parser-state-stack parser-state)); reference
	  (sp (wisi-elisp-parser-state-sp parser-state))); copy
      (setq sp (+ sp 2))
      (aset stack (1- sp) token)
      (aset stack sp action)
      (setf (wisi-elisp-parser-state-sp parser-state) sp))
    (setf (wisi-elisp-parser-state-active parser-state) 'shift))

   (t
    (wisi-elisp-parse-reduce action parser-state pendingp gotos)
    (setf (wisi-elisp-parser-state-active parser-state) 'reduce))
   ))

(defun wisi-elisp-parse-first-last (stack i j)
  "Return a pair (FIRST . LAST), indices for the first and last
non-empty tokens for a nonterminal; or nil if all tokens are
empty. STACK is the parser stack.  I and J are the indices in
STACK of the first and last tokens of the nonterminal."
  (let ((start (car (wisi-tok-region (aref stack i))))
        (end   (cdr (wisi-tok-region (aref stack j)))))
    (while (and (or (not start) (not end))
		(/= i j))
      (cond
       ((not start)
	;; item i is an empty production
	(setq start (car (wisi-tok-region (aref stack (setq i (+ i 2)))))))

       ((not end)
	;; item j is an empty production
	(setq end (cdr (wisi-tok-region (aref stack (setq j (- j 2)))))))

       (t (setq i j))))

    (when (and start end)
      (cons i j))
    ))

(cl-defmethod wisi-parse-find-token ((_parser wisi-elisp-parser) token-symbol)
  "Find token with TOKEN-SYMBOL on current parser stack, return token struct.
For use in grammar actions."
  ;; Called from wisi-parse-exec-action in wisi-parse-reduce
  (let* ((stack (wisi-elisp-parser-state-stack wisi-elisp-parser-state))
	 (sp (1- (wisi-elisp-parser-state-sp wisi-elisp-parser-state)))
	 (tok (aref stack sp)))
    (while (and (> sp 0)
		(not (eq token-symbol (wisi-tok-token tok))))
      (setq sp (- sp 2))
      (setq tok (aref stack sp)))
    (if (= sp 0)
	(error "token %s not found on parse stack" token-symbol)
      tok)
    ))

(cl-defmethod wisi-parse-stack-peek ((_parser wisi-elisp-parser) n)
  ;; IMPROVEME: store stack in parser
  (let* ((stack (wisi-elisp-parser-state-stack wisi-elisp-parser-state))
	 (sp (1- (wisi-elisp-parser-state-sp wisi-elisp-parser-state)))
	 (i (- sp (* 2 n))))
    (when (> i 0)
      (aref stack i))))

(defun wisi-elisp-parse-reduce (action parser-state pendingp gotos)
  "Reduce PARSER-STATE.stack, and execute or pend ACTION."
  (let* ((wisi-elisp-parser-state parser-state);; reference, for wisi-parse-find-token
	 (stack (wisi-elisp-parser-state-stack parser-state)); reference
	 (sp (wisi-elisp-parser-state-sp parser-state)); copy
	 (token-count (nth 2 action))
	 (nonterm (nth 0 action))
	 (first-last (when (> token-count 0)
		       (wisi-elisp-parse-first-last stack (- sp (* 2 (1- token-count)) 1) (1- sp))))
	 (nonterm-region (when first-last
			   (cons
			    (car (wisi-tok-region (aref stack (car first-last))))
			    (cdr (wisi-tok-region (aref stack (cdr first-last)))))))
	 (post-reduce-state (aref stack (- sp (* 2 token-count))))
	 (new-state (cdr (assoc nonterm (aref gotos post-reduce-state))))
	 (tokens (make-vector token-count nil))
	 line first comment-line comment-end)

    (when (not new-state)
      (error "no goto for %s %d" nonterm post-reduce-state))

    (dotimes (i token-count) ;;  i = 0 .. (1- token-count); last token = 0, first token = (1- token-count)
      (let ((tok (aref stack (- sp (* 2 i) 1))))
	(when (nth 1 action)
	  ;; don't need wisi-tokens for a null user action
	  (aset tokens (- token-count i 1) tok))

	(when (eq wisi--parse-action 'indent)
	  (setq line (or (wisi-tok-line tok) line))
	  (cond
	   ((numberp (wisi-tok-first tok))
	    (setq first (wisi-tok-first tok)))

	   ((wisi-tok-first tok)
	    (setq first (wisi-tok-line tok)))

	   ((and (not (= i 0))
		       (wisi-tok-comment-line tok))
	    ;; comment lines following last token are not included in nonterm
	    ;; test/ada_mode-nominal.ads Object_Access_Type_5a
	    ;; test/ada_mode-parens.adb
	    (setq first (wisi-tok-comment-line tok)))
	   )
	  (when (and (= i 0)
		     (wisi-tok-comment-line tok))
	    (setq comment-line (wisi-tok-comment-line tok))
	    (setq comment-end (wisi-tok-comment-end tok)))
	)))

    (setq sp (+ 2 (- sp (* 2 token-count))))
    (aset stack (1- sp)
	  (make-wisi-tok
	   :token nonterm
	   :region nonterm-region
	   :nonterminal t
	   :line line
	   :first first
	   :comment-line comment-line
	   :comment-end comment-end))
    (aset stack sp new-state)
    (setf (wisi-elisp-parser-state-sp parser-state) sp)

    (when (nth 1 action)
      ;; nothing to do for a null user action
      (if pendingp
	  (if (wisi-elisp-parser-state-pending parser-state)
	      (setf (wisi-elisp-parser-state-pending parser-state)
		    (append (wisi-elisp-parser-state-pending parser-state)
			    (list (list (nth 1 action) nonterm tokens))))
	    (setf (wisi-elisp-parser-state-pending parser-state)
		  (list (list (nth 1 action) nonterm tokens))))

	;; Not pending.
	(wisi-elisp-parse-exec-action (nth 1 action) nonterm tokens)
	))
    ))

;;;; navigate grammar actions

(defun wisi-elisp-parse--set-end (start-mark end-mark)
  "Set END-MARK on all caches in `wisi-end-caches' in range START-MARK END-MARK,
delete from `wisi-end-caches'."
  (let ((i 0)
	pos cache)
    (while (< i (length wisi-end-caches))
      (setq pos (nth i wisi-end-caches))
      (setq cache (wisi-get-cache pos))

      (if (and (>= pos start-mark)
	       (<  pos end-mark))
	  (progn
	    (setf (wisi-cache-end cache) end-mark)
	    (setq wisi-end-caches (delq pos wisi-end-caches)))

	;; else not in range
	(setq i (1+ i)))
      )))

(defvar wisi-tokens nil
  ;; Not wisi-elisp-parse--tokens for ease in debugging actions, and
  ;; to match lots of doc strings.
  "Array of ‘wisi-tok’ structures for the right hand side of the current production.
Let-bound in parser semantic actions.")

(defvar wisi-nterm nil
  ;; Not wisi-elisp-parse--nterm for ease in debugging actions
  "The token id for the left hand side of the current production.
Let-bound in parser semantic actions.")

(defun wisi-statement-action (pairs)
  ;; Not wisi-elisp-parse--statement-action to match existing grammar files
  "Cache navigation information in text properties of tokens.
Intended as a grammar non-terminal action.

PAIRS is a vector of the form [TOKEN-NUMBER CLASS 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])"
  (when (eq wisi--parse-action 'navigate)
    (save-excursion
      (let ((first-item t)
	    first-keyword-mark
	    (override-start nil)
	    (i 0))
	(while (< i (length pairs))
	  (let* ((number (1- (aref pairs i)))
		 (region (wisi-tok-region (aref wisi-tokens number)))
		 (token (wisi-tok-token (aref wisi-tokens number)))
		 (class (aref pairs (setq i (1+ i))))
		 (mark (when region (copy-marker (car region) t)))
		 cache)

	    (setq i (1+ i))

	    (unless (seq-contains wisi-class-list class)
	      (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 simple_statement in
		      ;;
		      ;; statement : label_opt simple_statement
		      ;;
		      ;; override nonterm, class, containing
		      (progn
			(setf (wisi-cache-class cache) (or override-start class))
			(setf (wisi-cache-nonterm cache) wisi-nterm)
			(setf (wisi-cache-containing cache) first-keyword-mark)
			(if wisi-end-caches
			    (push (car region) wisi-end-caches)
			  (setq wisi-end-caches (list (car region)))
			  ))

		    ;; else create new cache
		    (with-silent-modifications
		      (put-text-property
		       (car region)
		       (1+ (car region))
		       'wisi-cache
		       (wisi-cache-create
			:nonterm    wisi-nterm
			:token      token
			:last       (- (cdr region) (car region))
			:class      (or override-start class)
			:containing first-keyword-mark)
		       ))
		    (if wisi-end-caches
			(push (car region) wisi-end-caches)
		      (setq wisi-end-caches (list (car region)))
		      ))

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

		  (when (eq class 'statement-end)
		    (wisi-elisp-parse--set-end first-keyword-mark (copy-marker (car region) t)))
		  )

	      ;; 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
			 (eq class 'statement-start))
		(setq override-start class)))
	    ))
	))))

(defun wisi-containing-action (containing-token contained-token)
  ;; Not wisi-elisp-parse--containing-action to match existing grammar files
  "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."
  (when (eq wisi--parse-action 'navigate)
    (let* ((containing-tok (aref wisi-tokens (1- containing-token)))
	   (containing-region (wisi-tok-region containing-tok))
	   (contained-tok (aref wisi-tokens (1- contained-token)))
	   (contained-region (wisi-tok-region contained-tok)))

      (unless containing-region
	(signal 'wisi-parse-error
		(wisi-error-msg
		 "wisi-containing-action: containing-region '%s' is empty. grammar error; bad action"
		 (wisi-tok-token containing-tok))))

      (unless (or (not contained-region) ;; contained-token is empty
		  (wisi-get-cache (car containing-region)))
	(signal 'wisi-parse-error
		(wisi-error-msg
		 "wisi-containing-action: containing-token '%s' has no cache. grammar error; missing action"
		 (wisi-token-text (aref wisi-tokens (1- containing-token))))))

      (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 (car containing-region) t)))
	      (while cache

		;; skip blocks that are already marked
		(while (and (>= (point) (car contained-region))
			    (markerp (wisi-cache-containing cache)))
		  (goto-char (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-elisp-parse--match-token (cache tokens start)
  "Return t if CACHE has id from TOKENS and is at START or has containing equal to START.
point must be at cache token start.
TOKENS is a vector [number token_id token_id ...].
number is ignored."
  (let ((i 1)
	(done nil)
	(result nil)
	token)
    (when (or (= start (point))
	      (and (wisi-cache-containing cache)
		   (= start (wisi-cache-containing cache))))
      (while (and (not done)
		  (< i (length tokens)))
	(setq token (aref tokens i))
	(if (eq token (wisi-cache-token cache))
	    (setq result t
		  done t)
	  (setq i (1+ i)))
	))
    result))

(defun wisi-motion-action (token-numbers)
  ;; Not wisi-elisp-parse--motion-action to match existing grammar files
  "Set prev/next marks in all tokens given by TOKEN-NUMBERS.
TOKEN-NUMBERS is a vector with each element one of:

number: the token number; mark that token

vector [number token_id]:
vector [number token_id token_id ...]:
   mark all tokens in number nonterminal matching token_id with nil prev/next."
  (when (eq wisi--parse-action 'navigate)
    (save-excursion
      (let (prev-keyword-mark
	    prev-cache
	    token
	    start
	    cache
	    mark
	    (i 0))
	(while (< i (length token-numbers))
	  (let ((token-number (aref token-numbers i))
		region)
	    (setq i (1+ i))
	    (cond
	     ((numberp token-number)
	      (setq token (aref wisi-tokens (1- token-number)))
	      (setq region (wisi-tok-region token))
	      (when region
		(unless start (setq start (car region)))
		(setq cache (wisi-get-cache (car region)))
		(unless cache (error "no cache on token %d; add to statement-action" token-number))
		(setq mark (copy-marker (car region) t))

		(if prev-keyword-mark
		    (progn
		      (setf (wisi-cache-prev cache) prev-keyword-mark)
		      (setf (wisi-cache-next prev-cache) mark)
		      (setq prev-keyword-mark mark)
		      (setq prev-cache cache))

		  ;; else first token; save as prev
		  (setq prev-keyword-mark mark)
		  (setq prev-cache cache))
		))

	     ((vectorp token-number)
	      ;; token-number may contain 1 or more token_ids
	      ;; the corresponding region may be empty
	      ;; there may not have been a prev keyword
	      (setq region (wisi-tok-region (aref wisi-tokens (1- (aref token-number 0)))))
	      (when region ;; not an empty token
		;; We must search for all targets at the same time, to
		;; get the motion order right.
		(unless start (setq start (car region)))
		(goto-char (car region))
		(setq cache (wisi-get-cache (point)))
		(unless cache (error "no cache at %d; add to statement-action" (car region)))
		(while (< (point) (cdr region))
		  (when (wisi-elisp-parse--match-token cache token-number start)
		    (setq mark (copy-marker (point) t))

		    (if prev-keyword-mark
			;; Don't include this token if prev/next
			;; already set by a lower level statement,
			;; such as a nested if/then/elsif/end if.
			(when (and (null (wisi-cache-prev cache))
				   (null (wisi-cache-next 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))

		      ;; else first token; save as prev
		      (setq prev-keyword-mark mark)
		      (setq prev-cache cache)))

		  (setq cache (wisi-forward-cache))
		  )))

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

	    ))
	))))

;;;; Face grammar actions

(defun wisi-elisp-parse--face-put-cache (region class)
  "Put a ’wisi-face’ cache with class CLASS on REGION."
  (when (> wisi-debug 1)
    (message "face: put cache %s:%s" region class))
  (with-silent-modifications
    (put-text-property
     (car region)
     (1+ (car region))
     'wisi-face
     (wisi-cache-create
      :last (- (cdr region) (car region))
      :class class)
     )))

(defun wisi-face-mark-action (pairs)
  ;; Not wisi-elisp-parse--face-mark-action to match existing grammar files
  "PAIRS is a vector of TOKEN CLASS pairs; mark TOKEN (token number)
as having face CLASS (prefix or suffix).
Intended as a grammar action."
  (when (eq wisi--parse-action 'face)
    (let ((i 0))
      (while (< i (length pairs))
	(let ((region (wisi-tok-region (aref wisi-tokens (1- (aref pairs i)))))
	      (class (aref pairs (setq i (1+ i)))))
	  (setq i (1+ i))
	  (when region
	    ;; region can be null on an optional or virtual token
	    (let ((cache (get-text-property (car region) 'wisi-face)))
	      (if cache
		  ;; previously marked; extend this cache, delete any others
		  (progn
		    (with-silent-modifications
		      (remove-text-properties (+ (car region) (wisi-cache-last cache)) (cdr region) '(wisi-face nil)))
		    (setf (wisi-cache-class cache) class)
		    (setf (wisi-cache-last cache) (- (cdr region) (car region))))

		;; else not previously marked
		(wisi-elisp-parse--face-put-cache region class)))
	    ))
	))))

(defun wisi-face-remove-action (tokens)
  ;; Not wisi-elisp-parse--face-remove-action to match existing grammar files
  "Remove face caches and faces in TOKENS.
Intended as a grammar action.

TOKENS is a vector of token numbers."
  (when (eq wisi--parse-action 'face)
    (let ((i 0))
      (while (< i (length tokens))
	(let* ((number (1- (aref tokens i)))
	       (region (wisi-tok-region (aref wisi-tokens number)))
	       face-cache)

	  (setq i (1+ i))

	  (when region
	    (let ((pos (car region)))
	      (while (< pos (cdr region))
		(when (setq face-cache (get-text-property pos 'wisi-face))
		  (when (> wisi-debug 1)
		    (message "face: remove face %s" (cons pos (+ pos (wisi-cache-last face-cache)))))
		  (with-silent-modifications
		    (remove-text-properties
		     pos (+ pos (wisi-cache-last face-cache))
		     (list
		      'wisi-face nil
		      'font-lock-face nil
		      'fontified t))))
		(setq pos (next-single-property-change
			   (+ pos (or (and face-cache
					   (wisi-cache-last face-cache))
				      0))
			   'wisi-face nil (cdr region)))
		)))
	  )))))

(defun wisi-elisp-parse--face-action-1 (face region)
  "Apply FACE to REGION."
  (when region
    (when (> wisi-debug 1)
      (message "face: add face %s:%s" region face))
    (with-silent-modifications
      (add-text-properties
       (car region) (cdr region)
       (list
	'font-lock-face face
	'fontified t)))
    ))

(defun wisi-face-apply-action (triples)
  ;; Not wisi-elisp-parse--face-apply-action to match existing grammar files
  "Set face information in `wisi-face' text properties of tokens.
Intended as a grammar non-terminal action.

TRIPLES is a vector of the form [TOKEN-NUMBER PREFIX-FACE SUFFIX-FACE ...]

In the first ’wisi-face’ cache in each token region, apply
PREFIX-FACE to class PREFIX, SUFFIX-FACE to class SUFFIX, or
SUFFIX-FACE to all of the token region if there is no ’wisi-face’
cache."
  (when (eq wisi--parse-action 'face)
    (let (number prefix-face suffix-face (i 0))
      (while (< i (length triples))
	(setq number (aref triples i))
	(setq prefix-face (aref triples (setq i (1+ i))))
	(setq suffix-face (aref triples (setq i (1+ i))))
	(cond
	 ((integerp number)
	  (let* ((token-region (wisi-tok-region (aref wisi-tokens (1- number))))
		 (pos (car token-region))
		 (j 0)
		 (some-cache nil)
		 cache)
	    (when token-region
	      ;; region can be null for an optional or virtual token
	      (while (< j 2)
		(setq cache (get-text-property pos 'wisi-face))
		(cond
		 ((and (not some-cache)
		       (null cache))
		  ;; cache is null when applying a face to a token
		  ;; directly, without first calling
		  ;; wisi-face-mark-action. Or when there is a
		  ;; previously applied face in a lower level token,
		  ;; such as a numeric literal.
		  (wisi-elisp-parse--face-action-1 suffix-face token-region))

		 ((and cache
		       (eq 'prefix (wisi-cache-class cache)))
		  (setq some-cache t)
		  (wisi-elisp-parse--face-action-1 prefix-face (wisi-cache-region cache pos)))

		 ((and cache
		       (eq 'suffix (wisi-cache-class cache)))
		  (setq some-cache t)
		  (wisi-elisp-parse--face-action-1 suffix-face (wisi-cache-region cache pos)))

		 (t
		  ;; don’t apply a face
		  nil)
		 )

		(setq j (1+ j))
		(if suffix-face
		    (setq pos (next-single-property-change (+ 2 pos) 'wisi-face nil (cdr token-region)))
		  (setq j 2))
		))))

	 (t
	  ;; catch conversion errors from previous grammar syntax
	  (error "wisi-face-apply-action with non-integer token number"))
	 )
	(setq i (1+ i))
	))))

(defun wisi-face-apply-list-action (triples)
  ;; Not wisi-elisp-parse--face-apply-list-action to match existing grammar files
  "Similar to ’wisi-face-apply-action’, but applies faces to all
tokens with a `wisi-face' cache in the wisi-tokens[token-number]
region, and does not apply a face if there are no such caches."
  (when (eq wisi--parse-action 'face)
    (let (number token-region face-region prefix-face suffix-face cache (i 0) pos)
      (while (< i (length triples))
	(setq number (aref triples i))
	(setq prefix-face (aref triples (setq i (1+ i))))
	(setq suffix-face (aref triples (setq i (1+ i))))
	(cond
	 ((integerp number)
	  (setq token-region (wisi-tok-region (aref wisi-tokens (1- number))))
	  (when token-region
	    ;; region can be null for an optional token
	    (setq pos (car token-region))
	    (while (and pos
			(< pos (cdr token-region)))
	      (setq cache (get-text-property pos 'wisi-face))
	      (setq face-region (wisi-cache-region cache pos))
	      (cond
	       ((or (null (wisi-cache-class cache))
		    (eq 'prefix (wisi-cache-class cache)))
		(wisi-elisp-parse--face-action-1 prefix-face face-region))
	       ((eq 'suffix (wisi-cache-class cache))
		(wisi-elisp-parse--face-action-1 suffix-face face-region))

	       (t
		(error "wisi-face-apply-list-action: face cache class is not prefix or suffix")))

	      (setq pos (next-single-property-change (1+ pos) 'wisi-face nil (cdr token-region)))
	      )))
	 (t
	  ;; catch conversion errors from previous grammar syntax
	  (error "wisi-face-apply-list-action with non-integer token number"))
	 )
	(setq i (1+ i))
	))))

;;;; indent grammar actions

(defvar wisi-elisp-parse-indent-hanging-function nil
  "Language-specific implementation of `wisi-hanging', `wisi-hanging%'.
A function taking args TOK DELTA1 DELTA2 OPTION NO-ACCUMULATE,
and returning an indent.
TOK is a `wisi-tok' struct for the token being indented.
DELTA1, DELTA2 are the indents of the first and following lines
within the nonterminal.  OPTION is non-nil if action is `wisi-hanging%'.
point is at start of TOK, and may be moved.")
(make-variable-buffer-local 'wisi-elisp-parse-indent-hanging-function)

(defvar wisi-token-index nil
  ;; Not wisi-elisp-parse--token-index for backward compatibility
  "Index of current token in `wisi-tokens'.
Let-bound in `wisi-indent-action', for grammar actions.")

(defvar wisi-indent-comment nil
  ;; Not wisi-elisp-parse--indent-comment for backward compatibility
  "Non-nil if computing indent for comment.
Let-bound in `wisi-indent-action', for grammar actions.")

(defun wisi-elisp-parse--indent-zero-p (indent)
  (cond
   ((integerp indent)
    (= indent 0))

   (t ;; 'anchor
    (integerp (nth 2 indent)))
   ))

(defun wisi-elisp-parse--apply-int (i delta)
  "Add DELTA (an integer) to the indent at index I."
  (let ((indent (aref wisi-elisp-parse--indent i))) ;; reference if list

    (cond
     ((integerp indent)
      (aset wisi-elisp-parse--indent i (+ delta indent)))

     ((listp indent)
      (cond
       ((eq 'anchor (car indent))
	(when (integerp (nth 2 indent))
	  (setf (nth 2 indent) (+ delta (nth 2 indent)))
	  ;; else anchored; not affected by this delta
	  ))

       ((eq 'anchored (car indent))
	;; not affected by this delta
	)))

     (t
      (error "wisi-elisp-parse--apply-int: invalid form : %s" indent))
     )))

(defun wisi-elisp-parse--apply-anchored (delta i)
  "Apply DELTA (an anchored indent) to indent I."
  ;; delta is from wisi-anchored; ('anchored 1 delta no-accumulate)
  (let ((indent (aref wisi-elisp-parse--indent i))
	(accumulate (not (nth 3 delta))))

    (cond
     ((integerp indent)
      (when (or accumulate
		(= indent 0))
	(let ((temp (seq-take delta 3)))
    	  (setf (nth 2 temp) (+ indent (nth 2 temp)))
	  (aset wisi-elisp-parse--indent i temp))))

     ((and (listp indent)
	   (eq 'anchor (car indent))
	   (integerp (nth 2 indent)))
      (when (or accumulate
		(= (nth 2 indent) 0))
	(let ((temp (seq-take delta 3)))
	  (setf (nth 2 temp) (+ (nth 2 indent) (nth 2 temp)))
	  (setf (nth 2 indent) temp))))
     )))

(defun wisi-elisp-parse--indent-token-1 (line end delta)
  "Apply indent DELTA to all lines from LINE (a line number) thru END (a buffer position)."
  (let ((i (1- line));; index to wisi-elisp-lexer-line-begin, wisi-elisp-parse--indent
	(paren-first (when (and (listp delta)
				(eq 'hanging (car delta)))
		       (nth 2 delta))))

    (while (<= (aref (wisi-elisp-lexer-line-begin wisi--lexer) i) end)
      (unless
	  (and ;; no check for called from wisi--indent-comment;
	       ;; comments within tokens are indented by
	       ;; wisi--indent-token
	       wisi-indent-comment-col-0
	       (= 11 (syntax-class (syntax-after (aref (wisi-elisp-lexer-line-begin wisi--lexer) i)))))
	(cond
	 ((integerp delta)
	  (wisi-elisp-parse--apply-int i delta))

	 ((listp delta)
	  (cond
	   ((eq 'anchored (car delta))
	    (wisi-elisp-parse--apply-anchored delta i))

	   ((eq 'hanging (car delta))
	    ;; from wisi-hanging; delta is ('hanging first-line nest delta1 delta2 no-accumulate)
	    ;; delta1, delta2 may be anchored
	    (when (or (not (nth 5 delta))
		      (wisi-elisp-parse--indent-zero-p (aref wisi-elisp-parse--indent i)))
	      (if (= i (1- (nth 1 delta)))
		  ;; apply delta1
		  (let ((delta1 (nth 3 delta)))
		    (cond
		     ((integerp delta1)
		      (wisi-elisp-parse--apply-int i delta1))

		     (t ;; anchored
		      (wisi-elisp-parse--apply-anchored delta1 i))
		     ))

		;; don't apply hanging indent in nested parens.
		;; test/ada_mode-parens.adb
		;; No_Conditional_Set : constant Ada.Strings.Maps.Character_Set :=
		;;   Ada.Strings.Maps."or"
		;;     (Ada.Strings.Maps.To_Set (' '),
		(when (= paren-first
			 (nth 0 (save-excursion (syntax-ppss (aref (wisi-elisp-lexer-line-begin wisi--lexer) i)))))
		  (let ((delta2 (nth 4 delta)))
		    (cond
		     ((integerp delta2)
		      (wisi-elisp-parse--apply-int i delta2))

		     (t ;; anchored
		      (wisi-elisp-parse--apply-anchored delta2 i))
		     )))
		)))

	   (t
	    (error "wisi-elisp-parse--indent-token-1: invalid delta: %s" delta))
	   )) ;; listp delta

	 (t
	  (error "wisi-elisp-parse--indent-token-1: invalid delta: %s" delta))
	 ))
      (setq i (1+ i))
      )))

(defun wisi-elisp-parse--indent-token (tok token-delta)
  "Add TOKEN-DELTA to all indents in TOK region,"
  (let ((line (if (wisi-tok-nonterminal tok)
		  (wisi-tok-first tok)
		(when (wisi-tok-first tok) (wisi-tok-line tok))))
	(end (cdr (wisi-tok-region tok))))
    (when (and line end token-delta)
      (wisi-elisp-parse--indent-token-1 line end token-delta))))

(defun wisi-elisp-parse--indent-comment (tok comment-delta)
  "Add COMMENT-DELTA to all indents in comment region following TOK."
  (let ((line (wisi-tok-comment-line tok))
	(end (wisi-tok-comment-end tok)))
    (when (and line end comment-delta)
      (wisi-elisp-parse--indent-token-1 line end comment-delta))))

(defun wisi-elisp-parse--anchored-1 (tok offset &optional no-accumulate)
  "Return offset of TOK relative to current indentation + OFFSET.
For use in grammar indent actions."
  (when (wisi-tok-region tok)
    ;; region can be nil when token is inserted by error recovery
    (let ((pos (car (wisi-tok-region tok)))
	  delta)

      (goto-char pos)
      (setq delta (+ offset (- (current-column) (current-indentation))))
      (wisi-elisp-parse--anchored-2
       (wisi-tok-line tok) ;; anchor-line
       (if wisi-indent-comment
	   (wisi-tok-comment-end (aref wisi-tokens wisi-token-index))
	 (cdr (wisi-tok-region (aref wisi-tokens wisi-token-index))));; end
       delta
       no-accumulate)
      )))

(defun wisi-elisp-parse--max-anchor (begin-line end)
  (let ((i (1- begin-line))
	(max-i (length (wisi-elisp-lexer-line-begin wisi--lexer)))
	(result 0))
    (while (and (< i max-i)
		(<= (aref (wisi-elisp-lexer-line-begin wisi--lexer) i) end))
      (let ((indent (aref wisi-elisp-parse--indent i)))
	(when (listp indent)
	  (cond
	   ((eq 'anchor (car indent))
	    (setq result (max result (car (nth 1 indent))))
	    (when (listp (nth 2 indent))
	      (setq result (max result (nth 1 (nth 2 indent))))
	      ))
	   (t ;; anchored
	    (setq result (max result (nth 1 indent))))
	   )))
      (setq i (1+ i)))
    result
    ))

(defun wisi-elisp-parse--anchored-2 (anchor-line end delta no-accumulate)
  "Set ANCHOR-LINE as anchor, increment anchors thru END, return anchored delta."
  ;; Typically, we use anchored to indent relative to a token buried in a line:
  ;;
  ;; test/ada_mode-parens.adb
  ;; Local_2 : Integer := (1 + 2 +
  ;;                         3);
  ;; line starting with '3' is anchored to '('
  ;;
  ;; If the anchor is a nonterminal, and the first token in the anchor
  ;; is also first on a line, we don't need anchored to compute the
  ;; delta:
  ;;
  ;; test/ada_mode-parens.adb
  ;; Local_5 : Integer :=
  ;;   (1 + 2 +
  ;;      3);
  ;; delta for line starting with '3' can just be '3'.
  ;;
  ;; However, in some places we need anchored to prevent later
  ;; deltas from accumulating:
  ;;
  ;; test/ada_mode-parens.adb
  ;; No_Conditional_Set : constant Ada.Strings.Maps.Character_Set :=
  ;;   Ada.Strings.Maps."or"
  ;;     (Ada.Strings.Maps.To_Set (' '),
  ;;
  ;; here the function call actual parameter part is indented first
  ;; by 'name' and later by 'expression'; we use anchored to keep the
  ;; 'name' delta and ignore the later delta.
  ;;
  ;; So we apply anchored whether the anchor token is first or not.

  (let* ((i (1- anchor-line))
	 (indent (aref wisi-elisp-parse--indent i)) ;; reference if list
	 (anchor-id (1+ (wisi-elisp-parse--max-anchor anchor-line end))))

    ;; Set anchor
    (cond
     ((integerp indent)
      (aset wisi-elisp-parse--indent i (list 'anchor (list anchor-id) indent)))

     ((and (listp indent)
	   (eq 'anchor (car indent)))
      (push anchor-id (nth 1 indent)))

     ((and (listp indent)
	   (eq 'anchored (car indent)))
      (aset wisi-elisp-parse--indent i (list 'anchor (list anchor-id) (copy-sequence indent))))

     (t
      (error "wisi-anchored-delta: invalid form in indent: %s" indent)))

    (list 'anchored anchor-id delta no-accumulate)
    ))

(defun wisi-anchored (token-number offset &optional no-accumulate)
  ;; Not wisi-elisp-parse--anchored to match existing grammar files
  "Return offset of token TOKEN-NUMBER in `wisi-tokens'.relative to current indentation + OFFSET.
For use in grammar indent actions."
  (wisi-elisp-parse--anchored-1 (aref wisi-tokens (1- token-number)) offset no-accumulate))

(defun wisi-anchored* (token-number offset)
  ;; Not wisi-elisp-parse--anchored* to match existing grammar files
  "If TOKEN-NUMBER token in `wisi-tokens' is first on a line,
call ’wisi-anchored OFFSET’. Otherwise return 0.
For use in grammar indent actions."
  (if (wisi-tok-first (aref wisi-tokens (1- token-number)))
      (wisi-anchored token-number offset)
    0))

(defun wisi-anchored*- (token-number offset)
  ;; Not wisi-elisp-parse--anchored*- to match existing grammar files
  "If existing indent is zero, and TOKEN-NUMBER token in `wisi-tokens' is first on a line,
call ’wisi-anchored OFFSET’. Otherwise return 0.
For use in grammar indent actions."
  (if (wisi-tok-first (aref wisi-tokens (1- token-number)))
      (wisi-anchored token-number offset t)
    0))

(defun wisi-elisp-parse--paren-in-anchor-line (anchor-tok offset)
  "If there is an opening paren containing ANCHOR-TOK in the same line as ANCHOR-TOK,
return OFFSET plus the delta from the line indent to the paren
position. Otherwise return OFFSET."
  (let* ((tok-syntax (syntax-ppss (car (wisi-tok-region anchor-tok))))
	 (paren-pos (nth 1 tok-syntax))
	 (anchor-line (wisi-tok-line anchor-tok)))

    (when (and paren-pos ;; in paren
	      (< paren-pos (aref (wisi-elisp-lexer-line-begin wisi--lexer) (1- anchor-line))))
      ;; paren not in anchor line
      (setq paren-pos nil))

    (if paren-pos
	(progn
	  (goto-char paren-pos)
	  (+ 1 (- (current-column) (current-indentation)) offset))
      offset)
    ))

(defun wisi-anchored% (token-number offset &optional no-accumulate)
  ;; Not wisi-elisp-parse--anchored% to match existing grammar files
  "Return either an anchor for the current token at OFFSET from an enclosing paren on
the line containing TOKEN-NUMBER, or OFFSET.
For use in grammar indent actions."
  (let* ((indent-tok (aref wisi-tokens wisi-token-index))
	 ;; indent-tok is a nonterminal; this function makes no sense for terminals
	 (anchor-tok (aref wisi-tokens (1- token-number))))

    (wisi-elisp-parse--anchored-2
     (wisi-tok-line anchor-tok)

     (if wisi-indent-comment
	 (wisi-tok-comment-end indent-tok)
       (cdr (wisi-tok-region indent-tok))) ;; end

     (wisi-elisp-parse--paren-in-anchor-line anchor-tok offset)
     no-accumulate)
    ))

(defun wisi-anchored%- (token-number offset)
  ;; Not wisi-elisp-parse--anchored%- to match existing grammar files
  "If existing indent is zero, anchor the current token at OFFSET
from the first token on the line containing TOKEN-NUMBER in `wisi-tokens'.
Return the delta.
For use in grammar indent actions."
  (wisi-anchored% token-number offset t))

(defun wisi-elisp-parse--hanging-1 (delta1 delta2 option no-accumulate)
  "If OPTION is nil, implement `wisi-hanging'; otherwise `wisi-hanging%'."
  (let ((tok (aref wisi-tokens wisi-token-index)))
    ;; tok is a nonterminal; this function makes no sense for terminals
    ;; syntax-ppss moves point to start of tok

    (cond
     ((functionp wisi-elisp-parse-indent-hanging-function)
      (funcall wisi-elisp-parse-indent-hanging-function tok delta1 delta2 option no-accumulate))

     (t
      (let ((tok-syntax (syntax-ppss (car (wisi-tok-region tok))))
	    (first-tok-first-on-line
	     ;; first token in tok is first on line
	     (and (numberp (wisi-tok-first tok))
		  (= (wisi-tok-line tok) (wisi-tok-first tok)))))
	(list 'hanging
	      (wisi-tok-line tok) ;; first line of token
	      (nth 0 tok-syntax) ;; paren nest level at tok
	      delta1
	      (if (or (not option) first-tok-first-on-line)
		  delta2
		delta1)
	      no-accumulate))
      ))
    ))

(defun wisi-hanging (delta1 delta2)
  ;; Not wisi-elisp-parse--hanging to match existing grammar files
  "Use DETLA1 for first line, DELTA2 for following lines.
For use in grammar indent actions."
  (wisi-elisp-parse--hanging-1 delta1 delta2 nil nil))

(defun wisi-hanging% (delta1 delta2)
  ;; Not wisi-elisp-parse--hanging% to match existing grammar files
  "If first token is first in line, use DETLA1 for first line, DELTA2 for following lines.
Otherwise use DELTA1 for all lines.
For use in grammar indent actions."
  (wisi-elisp-parse--hanging-1 delta1 delta2 t nil))

(defun wisi-hanging%- (delta1 delta2)
  ;; Not wisi-elisp-parse--hanging%- to match existing grammar files
  "If existing indent is non-zero, do nothing.
Else if first token is first in line, use DETLA1 for first line,
DELTA2 for following lines.  Otherwise use DELTA1 for all lines.
For use in grammar indent actions."
  (wisi-elisp-parse--hanging-1 delta1 delta2 t t))

(defun wisi-elisp-parse--indent-offset (token offset)
  "Return offset from beginning of first token on line containing TOKEN,
   to beginning of TOKEN, plus OFFSET."
  (save-excursion
    (goto-char (aref (wisi-elisp-lexer-line-begin wisi--lexer) (1- (wisi-tok-line token))))
    (back-to-indentation)
    (+ offset (- (car (wisi-tok-region token)) (point)))
    ))

(defun wisi-elisp-parse--indent-compute-delta (delta tok)
  "Return evaluation of DELTA."
  (cond
   ((integerp delta)
    delta)

   ((symbolp delta)
    (symbol-value delta))

   ((vectorp delta)
    ;; [token comment]
    ;; if wisi-indent-comment, we are indenting the comments of the
    ;; previous token; they should align with the 'token' delta.
    (wisi-elisp-parse--indent-compute-delta (aref delta 0) tok))

   (t ;; form
    (cond
     ((eq 'anchored (car delta))
      delta)

     (t
      (save-excursion
	(goto-char (car (wisi-tok-region tok)))
	(eval delta)))))
   ))

(defun wisi-indent-action (deltas)
  ;; Not wisi-elisp-parse--indent-action to match existing grammar files
  "Accumulate `wisi--indents' from DELTAS.
DELTAS is a vector; each element can be:
- an integer
- a symbol
- a lisp form
- a vector.

The first three are evaluated to give an integer delta. A vector must
have two elements, giving the code and following comment
deltas. Otherwise the comment delta is the following delta in
DELTAS."
  (when (eq wisi--parse-action 'indent)
    (dotimes (wisi-token-index (length wisi-tokens))
      (let* ((tok (aref wisi-tokens wisi-token-index))
	     (token-delta (aref deltas wisi-token-index))
	     (comment-delta
	      (cond
	       ((vectorp token-delta)
		(aref token-delta 1))

	       ((< wisi-token-index (1- (length wisi-tokens)))
		(aref deltas (1+ wisi-token-index)))
	       )))
	(when (wisi-tok-region tok)
	  ;; region is null when optional nonterminal is empty
	  (let ((wisi-indent-comment nil))
	    (setq token-delta
		  (when (and token-delta
			     (wisi-tok-first tok))
		    (wisi-elisp-parse--indent-compute-delta token-delta tok)))

	    (when (and token-delta
		       (or (consp token-delta)
			   (not (= 0 token-delta))))
	      (wisi-elisp-parse--indent-token tok token-delta))

	    (setq wisi-indent-comment t)
	    (setq comment-delta
		  (when (and comment-delta
			     (wisi-tok-comment-line tok))
		    (wisi-elisp-parse--indent-compute-delta comment-delta tok)))

	    (when (and comment-delta
		       (or (consp comment-delta)
			   (not (= 0 comment-delta))))
	      (wisi-elisp-parse--indent-comment tok comment-delta))
	    )
	  )))))

(defun wisi-indent-action* (n deltas)
  ;; Not wisi-elisp-parse--indent-action* to match existing grammar files
  "If any of the first N tokens in `wisi-tokens' is first on a line,
call `wisi-indent-action' with DELTAS.  Otherwise do nothing."
  (when (eq wisi--parse-action 'indent)
    (let ((done nil)
	  (i 0)
	  tok)
      (while (and (not done)
		  (< i n))
	(setq tok (aref wisi-tokens i))
	(setq i (1+ i))
	(when (and (wisi-tok-region tok)
		   (wisi-tok-first tok))
	  (setq done t)
	  (wisi-indent-action deltas))
	))))

;;;; non-grammar indent functions

(defconst wisi-elisp-parse--max-anchor-depth 20) ;; IMRPOVEME: can compute in actions

(defun wisi-elisp-parse--indent-leading-comments ()
  "Set `wisi-elisp-parse--indent to 0 for comment lines before first token in buffer.
Leave point at first token (or eob)."
  (save-excursion
    (goto-char (point-min))
    (forward-comment (point-max))
    (let ((end (point))
	  (i 0)
	  (max-i (length wisi-elisp-parse--indent)))
      (while (and (< i max-i)
		  (< (aref (wisi-elisp-lexer-line-begin wisi--lexer) i) end))
	(aset wisi-elisp-parse--indent i 0)
	(setq i (1+ i)))
      )))

(defun wisi-elisp-parse--resolve-anchors ()
  (let ((anchor-indent (make-vector wisi-elisp-parse--max-anchor-depth 0))
	pos)

    (dotimes (i (length wisi-elisp-parse--indent))
      (let ((indent (aref wisi-elisp-parse--indent i)))

	(cond
	 ((integerp indent))

	 ((listp indent)
	  (let ((anchor-ids (nth 1 indent))
		(indent2 (nth 2 indent)))
	    (cond
	     ((eq 'anchor (car indent))
	      (cond
	       ((integerp indent2)
		(dotimes (i (length anchor-ids))
		  (aset anchor-indent (nth i anchor-ids) indent2))
		(setq indent indent2))

	       ((listp indent2) ;; 'anchored
		(setq indent (+ (aref anchor-indent (nth 1 indent2)) (nth 2 indent2)))

		(dotimes (i (length anchor-ids))
		  (aset anchor-indent (nth i anchor-ids) indent)))

	       (t
		(error "wisi-indent-region: invalid form in wisi-ind-indent %s" indent))
	       ));; 'anchor

	     ((eq 'anchored (car indent))
	      (setq indent (+ (aref anchor-indent (nth 1 indent)) indent2)))

	     (t
	      (error "wisi-indent-region: invalid form in wisi-ind-indent %s" indent))
	     )));; listp indent

	 (t
	  (error "wisi-indent-region: invalid form in wisi-ind-indent %s" indent))
	 );; cond indent

	(when (> i 0)
	  (setq pos (aref (wisi-elisp-lexer-line-begin wisi--lexer) i))
	  (with-silent-modifications
	    (put-text-property (1- pos) pos 'wisi-indent indent)))
	)) ;; dotimes lines

    ))

(provide 'wisi-elisp-parse)
;;; wisi-elisp-parse.el ends here
