emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/wisi d10db37 22/35: Release ada-mode version 6.0. Relea


From: Stefan Monnier
Subject: [elpa] externals/wisi d10db37 22/35: Release ada-mode version 6.0. Release wisi version 2.0
Date: Sat, 28 Nov 2020 14:47:54 -0500 (EST)

branch: externals/wisi
commit d10db37c397cfdcb56cf10a9a71fd4b8e5aca51c
Author: Stephen Leake <stephen_leake@stephe-leake.org>
Commit: Stephen Leake <stephen_leake@stephe-leake.org>

    Release ada-mode version 6.0. Release wisi version 2.0
---
 NEWS                                               |   22 +-
 README                                             |    6 +-
 build-wisitoken-bnf-generate.sh                    |    9 +
 long_float_elementary_functions.ads                |   21 +
 parse_table-mode.el                                |   64 -
 sal-gen_bounded_definite_vectors-gen_image.adb     |   39 +
 sal-gen_bounded_definite_vectors-gen_image.ads     |   23 +
 sal-gen_bounded_definite_vectors-gen_image_aux.adb |   35 +
 sal-gen_bounded_definite_vectors-gen_image_aux.ads |   23 +
 sal-gen_bounded_definite_vectors-gen_sorted.adb    |   85 +
 sal-gen_bounded_definite_vectors-gen_sorted.ads    |   50 +
 sal-gen_bounded_definite_vectors.adb               |  224 ++
 sal-gen_bounded_definite_vectors.ads               |  150 +
 sal-gen_definite_doubly_linked_lists.adb           |  304 ++
 sal-gen_definite_doubly_linked_lists.ads           |  159 +
 ...finite_doubly_linked_lists_sorted-gen_image.adb |   47 +
 ...finite_doubly_linked_lists_sorted-gen_image.ads |   25 +
 sal-gen_definite_doubly_linked_lists_sorted.adb    |  542 ++++
 sal-gen_definite_doubly_linked_lists_sorted.ads    |  175 ++
 sal-gen_indefinite_doubly_linked_lists.adb         |  201 ++
 sal-gen_indefinite_doubly_linked_lists.ads         |  114 +
 sal-gen_trimmed_image.adb                          |   28 +
 sal-gen_trimmed_image.ads                          |   23 +
 sal-gen_unbounded_definite_min_heaps_fibonacci.adb |  340 +++
 sal-gen_unbounded_definite_min_heaps_fibonacci.ads |  114 +
 ...gen_unbounded_definite_queues-gen_image_aux.adb |   35 +
 ...gen_unbounded_definite_queues-gen_image_aux.ads |   23 +
 sal-gen_unbounded_definite_queues.adb              |   97 +
 sal-gen_unbounded_definite_queues.ads              |  108 +
 sal-gen_unbounded_definite_red_black_trees.adb     |  863 ++++++
 sal-gen_unbounded_definite_red_black_trees.ads     |  181 ++
 ...gen_unbounded_definite_stacks-gen_image_aux.adb |   42 +
 ...gen_unbounded_definite_stacks-gen_image_aux.ads |   27 +
 sal-gen_unbounded_definite_stacks.adb              |  178 ++
 sal-gen_unbounded_definite_stacks.ads              |  133 +
 ...n_unbounded_definite_vectors-gen_comparable.adb |   73 +
 ...n_unbounded_definite_vectors-gen_comparable.ads |   30 +
 sal-gen_unbounded_definite_vectors-gen_image.adb   |   50 +
 sal-gen_unbounded_definite_vectors-gen_image.ads   |   24 +
 ...en_unbounded_definite_vectors-gen_image_aux.adb |   36 +
 ...en_unbounded_definite_vectors-gen_image_aux.ads |   23 +
 sal-gen_unbounded_definite_vectors.adb             |  578 ++++
 sal-gen_unbounded_definite_vectors.ads             |  226 ++
 sal.adb                                            |   32 +
 sal.ads                                            |   75 +
 standard_common.gpr                                |  118 +
 wisi-compat-24.2.el                                |   34 -
 wisi-compile.el                                    |   34 +-
 wisi-elisp-lexer.el                                |  393 +++
 wisi-elisp-parse.el                                | 1682 +++++++++++
 wisi-fringe.el                                     |  146 +
 wisi-parse-common.el                               |  341 +++
 wisi-parse.el                                      |  549 ----
 wisi-process-parse.el                              |  691 +++++
 wisi.adb                                           | 1891 ++++++++++++
 wisi.ads                                           |  666 +++++
 wisi.el                                            | 2940 +++++++++----------
 wisitoken-bnf-generate.adb                         |  522 ++++
 wisitoken-bnf-generate_grammar.adb                 |   86 +
 wisitoken-bnf-generate_packrat.adb                 |  331 +++
 wisitoken-bnf-generate_utils.adb                   |  818 ++++++
 wisitoken-bnf-generate_utils.ads                   |  176 ++
 wisitoken-bnf-output_ada.adb                       |  436 +++
 wisitoken-bnf-output_ada_common.adb                | 1407 +++++++++
 wisitoken-bnf-output_ada_common.ads                |   91 +
 wisitoken-bnf-output_ada_emacs.adb                 | 1519 ++++++++++
 wisitoken-bnf-output_elisp.adb                     |  293 ++
 wisitoken-bnf-output_elisp_common.adb              |  145 +
 wisitoken-bnf-output_elisp_common.ads              |   49 +
 wisitoken-bnf-utils.adb                            |   45 +
 wisitoken-bnf-utils.ads                            |   29 +
 wisitoken-bnf.adb                                  |  337 +++
 wisitoken-bnf.ads                                  |  310 ++
 wisitoken-gen_token_enum.adb                       |  133 +
 wisitoken-gen_token_enum.ads                       |  130 +
 wisitoken-generate-lr-lalr_generate.adb            |  593 ++++
 wisitoken-generate-lr-lalr_generate.ads            |   67 +
 wisitoken-generate-lr-lr1_generate.adb             |  315 ++
 wisitoken-generate-lr-lr1_generate.ads             |   76 +
 wisitoken-generate-lr.adb                          | 1141 ++++++++
 wisitoken-generate-lr.ads                          |  176 ++
 wisitoken-generate-lr1_items.adb                   |  580 ++++
 wisitoken-generate-lr1_items.ads                   |  332 +++
 wisitoken-generate-packrat.adb                     |  247 ++
 wisitoken-generate-packrat.ads                     |   75 +
 wisitoken-generate.adb                             |  495 ++++
 wisitoken-generate.ads                             |  136 +
 wisitoken-lexer-re2c.adb                           |  244 ++
 wisitoken-lexer-re2c.ads                           |  129 +
 wisitoken-lexer-regexp.adb                         |  240 ++
 wisitoken-lexer-regexp.ads                         |  102 +
 wisitoken-lexer.adb                                |   56 +
 wisitoken-lexer.ads                                |  161 ++
 wisitoken-parse-lr-mckenzie_recover-base.adb       |  433 +++
 wisitoken-parse-lr-mckenzie_recover-base.ads       |  180 ++
 wisitoken-parse-lr-mckenzie_recover-explore.adb    | 1301 +++++++++
 wisitoken-parse-lr-mckenzie_recover-explore.ads    |   28 +
 wisitoken-parse-lr-mckenzie_recover-parse.adb      |  302 ++
 wisitoken-parse-lr-mckenzie_recover-parse.ads      |   77 +
 wisitoken-parse-lr-mckenzie_recover.adb            | 1062 +++++++
 wisitoken-parse-lr-mckenzie_recover.ads            |  220 ++
 wisitoken-parse-lr-parser.adb                      | 1105 +++++++
 wisitoken-parse-lr-parser.ads                      |  145 +
 wisitoken-parse-lr-parser_lists.adb                |  405 +++
 wisitoken-parse-lr-parser_lists.ads                |  260 ++
 wisitoken-parse-lr-parser_no_recover.adb           |  492 ++++
 wisitoken-parse-lr-parser_no_recover.ads           |   84 +
 wisitoken-parse-lr.adb                             |  856 ++++++
 wisitoken-parse-lr.ads                             |  624 ++++
 wisitoken-parse-packrat-generated.adb              |   86 +
 wisitoken-parse-packrat-generated.ads              |   70 +
 wisitoken-parse-packrat-procedural.adb             |  251 ++
 wisitoken-parse-packrat-procedural.ads             |   80 +
 wisitoken-parse-packrat.adb                        |   56 +
 wisitoken-parse-packrat.ads                        |   71 +
 wisitoken-parse.adb                                |   88 +
 wisitoken-parse.ads                                |   66 +
 wisitoken-productions.adb                          |   51 +
 wisitoken-productions.ads                          |   64 +
 wisitoken-regexp.adb                               | 1347 +++++++++
 wisitoken-regexp.ads                               |  139 +
 wisitoken-semantic_checks.adb                      |  135 +
 wisitoken-semantic_checks.ads                      |   89 +
 wisitoken-syntax_trees.adb                         | 1114 +++++++
 wisitoken-syntax_trees.ads                         |  411 +++
 wisitoken-text_io_trace.adb                        |   70 +
 wisitoken-text_io_trace.ads                        |   45 +
 wisitoken-wisi_ada.adb                             |  163 ++
 wisitoken-wisi_ada.ads                             |   82 +
 wisitoken.adb                                      |  351 +++
 wisitoken.ads                                      |  432 +++
 wisitoken.gpr                                      |   56 +
 wisitoken_grammar_actions.adb                      |  105 +
 wisitoken_grammar_actions.ads                      |  168 ++
 wisitoken_grammar_main.adb                         |  305 ++
 wisitoken_grammar_main.ads                         |   33 +
 wisitoken_grammar_re2c.c                           | 3025 ++++++++++++++++++++
 wisitoken_grammar_re2c_c.ads                       |   63 +
 wisitoken_grammar_runtime.adb                      |  610 ++++
 wisitoken_grammar_runtime.ads                      |   85 +
 140 files changed, 42135 insertions(+), 2314 deletions(-)

diff --git a/NEWS b/NEWS
index 5e837c7..f86dbe5 100644
--- a/NEWS
+++ b/NEWS
@@ -1,12 +1,32 @@
 GNU Emacs wisi NEWS -- history of user-visible changes.
 
-Copyright (C) 2014 Free Software Foundation, Inc.
+Copyright (C) 2018 Free Software Foundation, Inc.
 See the end of the file for license conditions.
 
 Please send wisi bug reports to bug-gnu-emacs@gnu.org, with
 'wisi' in the subject. If possible, use M-x report-emacs-bug.
 
 
+* wisi 2.0.0
+17 Nov 2018
+
+** Change indentation engine to compute indent directly in parser actions.
+
+** Add error correcting external process parser.
+
+** Factor out wisi-elisp-lexer.el from wisi.el, and
+   ada-wisi-elisp-parse.el from ada-wisi.el. Move elisp grammar
+   actions from wisi.el to wisi-elisp-parse.el; they are not used with
+   the process parser.
+
+** Add support for error corrections in parser; 'wisi-repair-error'
+   can apply the corrections to the buffer text.
+
+** Display marks in fringe at location of errors detected by
+   background parser.
+
+** include sources for wisitoken parser runtime, parser generator.
+
 * wisi 1.1.6
 3 Oct 2017
 
diff --git a/README b/README
index 648f35c..0435747 100644
--- a/README
+++ b/README
@@ -1,7 +1,7 @@
-Emacs wisi package 1.1.6
+Emacs wisi package 2.0.0
 
 The wisi package provides utilities for using generalized LALR parsers
-to do indentation, fontification, and navigation. See ada-mode for an
-example of its use.
+(in elisp or external processes) to do indentation, fontification, and
+navigation. See ada-mode for an example of its use.
 
 
diff --git a/build-wisitoken-bnf-generate.sh b/build-wisitoken-bnf-generate.sh
new file mode 100644
index 0000000..c087be6
--- /dev/null
+++ b/build-wisitoken-bnf-generate.sh
@@ -0,0 +1,9 @@
+# Build wisitoken-bnf-generate.exe, for generating code from grammar files.
+# 
+# Assumes build.sh has run.
+#
+# Instead of using this, you should consider using the complete
+# wisitoken development tree; see
+# http://stephe-leake.org/ada/wisitoken.html
+
+gprbuild -p -P wisitoken.gpr wisitoken-bnf-generate
diff --git a/long_float_elementary_functions.ads 
b/long_float_elementary_functions.ads
new file mode 100644
index 0000000..3f543b9
--- /dev/null
+++ b/long_float_elementary_functions.ads
@@ -0,0 +1,21 @@
+--  Abstract :
+--
+--  instantiation
+--
+--  Copyright (C) 2017 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Numerics.Generic_Elementary_Functions;
+package Long_Float_Elementary_Functions is new 
Ada.Numerics.Generic_Elementary_Functions (Long_Float);
diff --git a/parse_table-mode.el b/parse_table-mode.el
deleted file mode 100755
index d8d2651..0000000
--- a/parse_table-mode.el
+++ /dev/null
@@ -1,64 +0,0 @@
-;; parse_table-mode.el --- For navigating in a parse_table as output by 
wisi-generate. -*- lexical-binding:t -*-
-;;
-;; Copyright (C) 2017  Free Software Foundation, Inc.
-;;
-;; Author: Stephen Leake <stephen_leake@stephe-leake.org>
-;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
-;; Keywords: parser
-;; Version: 1.0
-;; package-requires: ((emacs "25.1"))
-;; URL: http://www.nongnu.org/ada-mode/wisi/wisi.html
-;;
-;; 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/>.
-
-(require 'xref)
-
-(defun parse_table--xref-backend () 'parse_table)
-
-(cl-defgeneric xref-backend-identifier-completion-table ((_backend (eql 
parse_table)))
-  ;; could complete on nonterms, find productions
-  nil)
-
-(cl-defmethod xref-backend-identifier-at-point ((_backend (eql parse_table)))
-  ;; assume we are on one of:
-  ;; - ’goto state nnn’ in a state action
-  ;; - ’=> State nnn’ in the debug kernels list
-  ;; - ’( nnn)’ in the unknown conflicts list
-  (save-excursion
-    (end-of-line)
-    (when (or (looking-back "[Ss]tate \\([0-9]+\\),?" 
(line-beginning-position))
-             (looking-back "( \\([0-9]+\\))" (line-beginning-position)))
-      (match-string 1))))
-
-(cl-defgeneric xref-backend-definitions ((_backend (eql parse_table)) 
identifier)
-  ;; state tables are self-contained; IDENTIFIER must be a state number
-  (save-excursion
-    (goto-char (point-min))
-    (search-forward-regexp (concat "^State " identifier ":$"))
-    (list (xref-make identifier (xref-make-buffer-location (current-buffer) 
(match-beginning 0))))))
-
-(define-minor-mode parse_table-mode
-  "Provides navigation in wisi-generate parse table output."
-  nil ":parse_table" nil
-  (add-hook 'xref-backend-functions #'parse_table--xref-backend nil t)
-
-  (if parse_table-mode
-      (read-only-mode 0)
-    (read-only-mode 1)
-  ))
-
-(provide 'parse_table-mode)
-;; end of file
diff --git a/sal-gen_bounded_definite_vectors-gen_image.adb 
b/sal-gen_bounded_definite_vectors-gen_image.adb
new file mode 100644
index 0000000..893b178
--- /dev/null
+++ b/sal-gen_bounded_definite_vectors-gen_image.adb
@@ -0,0 +1,39 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+function SAL.Gen_Bounded_Definite_Vectors.Gen_Image (Item : in Vector) return 
String
+is
+   use all type SAL.Base_Peek_Type;
+   use Ada.Strings;
+   use Ada.Strings.Unbounded;
+   Result : Unbounded_String := To_Unbounded_String ("(");
+   Last   : Base_Peek_Type   := To_Peek_Index (Item.Last);
+begin
+   for I in Item.Elements (1 .. Last) loop
+      Result := Result &
+        ((if Trim
+          then Fixed.Trim (Element_Image (Item.Elements (I)), Left)
+          else Element_Image (Item.Elements (I)));
+      if I /= Last then
+         Result := Result & ", ";
+      end if;
+   end loop;
+   Result := Result & ")";
+   return To_String (Result);
+end SAL.Gen_Bounded_Definite_Vectors.Gen_Image;
diff --git a/sal-gen_bounded_definite_vectors-gen_image.ads 
b/sal-gen_bounded_definite_vectors-gen_image.ads
new file mode 100644
index 0000000..6202be0
--- /dev/null
+++ b/sal-gen_bounded_definite_vectors-gen_image.ads
@@ -0,0 +1,23 @@
+--  Abstract :
+--
+--  Image for instantiations of parent.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+generic
+   with function Element_Image (Item : in Element_Type) return String;
+   Trim : in Boolean;
+function SAL.Gen_Bounded_Definite_Vectors.Gen_Image (Item : in Vector) return 
String;
diff --git a/sal-gen_bounded_definite_vectors-gen_image_aux.adb 
b/sal-gen_bounded_definite_vectors-gen_image_aux.adb
new file mode 100644
index 0000000..39ecd46
--- /dev/null
+++ b/sal-gen_bounded_definite_vectors-gen_image_aux.adb
@@ -0,0 +1,35 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Strings.Unbounded;
+function SAL.Gen_Bounded_Definite_Vectors.Gen_Image_Aux (Item : in Vector; Aux 
: in Aux_Data) return String
+is
+   use Ada.Strings.Unbounded;
+   Result : Unbounded_String        := To_Unbounded_String ("(");
+   Last   : constant Base_Peek_Type := To_Peek_Index (Item.Last);
+begin
+   for I in 1 .. Last loop
+      Result := Result & Element_Image (Item.Elements (I), Aux);
+      if I /= Last then
+         Result := Result & ", ";
+      end if;
+   end loop;
+   Result := Result & ")";
+   return To_String (Result);
+end SAL.Gen_Bounded_Definite_Vectors.Gen_Image_Aux;
diff --git a/sal-gen_bounded_definite_vectors-gen_image_aux.ads 
b/sal-gen_bounded_definite_vectors-gen_image_aux.ads
new file mode 100644
index 0000000..c72f8ee
--- /dev/null
+++ b/sal-gen_bounded_definite_vectors-gen_image_aux.ads
@@ -0,0 +1,23 @@
+--  Abstract :
+--
+--  Image with auxiliary data for instantiations of parent.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+generic
+   type Aux_Data (<>) is private;
+   with function Element_Image (Item : in Element_Type; Aux : in Aux_Data) 
return String;
+function SAL.Gen_Bounded_Definite_Vectors.Gen_Image_Aux (Item : in Vector; Aux 
: in Aux_Data) return String;
diff --git a/sal-gen_bounded_definite_vectors-gen_sorted.adb 
b/sal-gen_bounded_definite_vectors-gen_sorted.adb
new file mode 100644
index 0000000..088b807
--- /dev/null
+++ b/sal-gen_bounded_definite_vectors-gen_sorted.adb
@@ -0,0 +1,85 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+package body SAL.Gen_Bounded_Definite_Vectors.Gen_Sorted is
+
+   overriding procedure Append (Container : in out Vector; New_Item : in 
Element_Type)
+   is begin
+      raise Programmer_Error;
+   end Append;
+
+   overriding procedure Prepend (Container : in out Vector; New_Item : in 
Element_Type)
+   is begin
+      raise Programmer_Error;
+   end Prepend;
+
+   overriding
+   procedure Insert
+     (Container : in out Vector;
+      New_Item  : in     Element_Type;
+      Before    : in     Extended_Index)
+   is begin
+      raise Programmer_Error;
+   end Insert;
+
+   procedure Insert
+     (Container : in out Vector;
+      New_Item  : in     Element_Type)
+   is
+      K : constant Base_Peek_Type := To_Peek_Index (Container.Last);
+      J : Base_Peek_Type := K;
+   begin
+      if K + 1 > Container.Elements'Last then
+         raise Container_Full;
+
+      elsif K = 0 then
+         --  Container empty
+         Container.Last := Container.Last + 1;
+         Container.Elements (1) := New_Item;
+         return;
+      end if;
+
+      loop
+         exit when J < 1;
+
+         case Element_Compare (New_Item, Container.Elements (J)) is
+         when Less =>
+            J := J - 1;
+         when Equal =>
+            --  Insert after J
+            exit;
+         when Greater =>
+            --  Insert after J
+            exit;
+         end case;
+      end loop;
+
+      if J = 0 then
+         --  Insert before all
+         Container.Elements (2 .. K + 1) := Container.Elements (1 .. K);
+         Container.Elements (1) := New_Item;
+      else
+         --  Insert after J
+         Container.Elements (J + 2 .. K + 1) := Container.Elements (J + 1 .. 
K);
+         Container.Elements (J + 1) := New_Item;
+      end if;
+      Container.Last := Container.Last + 1;
+   end Insert;
+
+end SAL.Gen_Bounded_Definite_Vectors.Gen_Sorted;
diff --git a/sal-gen_bounded_definite_vectors-gen_sorted.ads 
b/sal-gen_bounded_definite_vectors-gen_sorted.ads
new file mode 100644
index 0000000..d210c0b
--- /dev/null
+++ b/sal-gen_bounded_definite_vectors-gen_sorted.ads
@@ -0,0 +1,50 @@
+--  Abstract :
+--
+--  Add sorted behavior to parent.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+generic
+   with function Element_Compare (Left, Right : in Element_Type) return 
Compare_Result;
+package SAL.Gen_Bounded_Definite_Vectors.Gen_Sorted is
+
+   type Vector is new SAL.Gen_Bounded_Definite_Vectors.Vector with null record;
+
+   overriding procedure Append (Container : in out Vector; New_Item : in 
Element_Type)
+   with Inline => True;
+   --  Raises Programmer_Error
+
+   overriding procedure Prepend (Container : in out Vector; New_Item : in 
Element_Type)
+   with Inline => True;
+   --  Raises Programmer_Error
+
+   overriding
+   procedure Insert
+     (Container : in out Vector;
+      New_Item  : in     Element_Type;
+      Before    : in     Extended_Index)
+   with Inline => True;
+   --  Raises Programmer_Error
+
+   not overriding
+   procedure Insert
+     (Container : in out Vector;
+      New_Item  : in     Element_Type);
+   --  Insert New_Item in sorted position. Items are sorted in increasing
+   --  order according to Element_Compare. New_Item is inserted after
+   --  Equal items.
+
+end SAL.Gen_Bounded_Definite_Vectors.Gen_Sorted;
diff --git a/sal-gen_bounded_definite_vectors.adb 
b/sal-gen_bounded_definite_vectors.adb
new file mode 100644
index 0000000..75b4016
--- /dev/null
+++ b/sal-gen_bounded_definite_vectors.adb
@@ -0,0 +1,224 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2017, 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+package body SAL.Gen_Bounded_Definite_Vectors is
+
+   function Length (Container : in Vector) return Ada.Containers.Count_Type
+   is begin
+      --  We assume the type ranges are sensible, so no exceptions occur
+      --  here.
+      return Ada.Containers.Count_Type (Container.Last - Index_Type'First + 1);
+   end Length;
+
+   function Is_Full (Container : in Vector) return Boolean
+   is begin
+      return To_Peek_Index (Container.Last) = Peek_Type (Capacity);
+   end Is_Full;
+
+   procedure Clear (Container : in out Vector)
+   is begin
+      Container.Last := No_Index;
+   end Clear;
+
+   function Element (Container : Vector; Index : Index_Type) return 
Element_Type
+   is begin
+      return Container.Elements (Peek_Type (Index - Index_Type'First + 1));
+   end Element;
+
+   function Last_Index (Container : Vector) return Extended_Index
+   is begin
+      return Container.Last;
+   end Last_Index;
+
+   procedure Set_Last (Container : in out Vector; Last : in Index_Type)
+   is begin
+      Container.Last := Last;
+   end Set_Last;
+
+   procedure Append (Container : in out Vector; New_Item : in Element_Type)
+   is
+      J : constant Peek_Type := To_Peek_Index (Container.Last + 1);
+   begin
+      if J > Container.Elements'Last then
+         raise Container_Full;
+      end if;
+      Container.Elements (J) := New_Item;
+      Container.Last := Container.Last + 1;
+   end Append;
+
+   procedure Prepend (Container : in out Vector; New_Item : in Element_Type)
+   is
+      J : constant Peek_Type := Peek_Type (Container.Last + 1 - 
Index_Type'First + 1);
+   begin
+      if J > Container.Elements'Last then
+         raise Container_Full;
+      end if;
+
+      Container.Elements (2 .. J) := Container.Elements (1 .. J - 1);
+      Container.Elements (1) := New_Item;
+      Container.Last := Container.Last + 1;
+   end Prepend;
+
+   procedure Insert
+     (Container : in out Vector;
+      New_Item  : in     Element_Type;
+      Before    : in     Extended_Index)
+   is
+      J : constant Peek_Type := To_Peek_Index ((if Before = No_Index then 
Container.Last + 1 else Before));
+      K : constant Base_Peek_Type := To_Peek_Index (Container.Last);
+   begin
+      if K + 1 > Container.Elements'Last then
+         raise Container_Full;
+      end if;
+
+      Container.Elements (J + 1 .. K + 1) := Container.Elements (J .. K);
+      Container.Elements (J) := New_Item;
+      Container.Last := Container.Last + 1;
+   end Insert;
+
+   function "+" (Item : in Element_Type) return Vector
+   is begin
+      return Result : Vector do
+         Result.Append (Item);
+      end return;
+   end "+";
+
+   function "&" (Left : in Vector; Right : in Element_Type) return Vector
+   is begin
+      return Result : Vector := Left do
+         Result.Append (Right);
+      end return;
+   end "&";
+
+   procedure Delete_First (Container : in out Vector; Count : in Index_Type := 
1)
+   is
+      J : constant Peek_Type := Peek_Type (Container.Last - Index_Type'First + 
Count);
+   begin
+      if Count > Container.Last then
+         raise Container_Empty;
+      end if;
+      Container.Elements (1 .. J - 1) := Container.Elements (2 .. J);
+      Container.Last := Container.Last - Count;
+   end Delete_First;
+
+   function Constant_Reference (Container : aliased Vector; Index : in 
Index_Type) return Constant_Reference_Type
+   is
+      J : constant Peek_Type := Peek_Type (Index - Index_Type'First + 1);
+   begin
+      if Index > Container.Last then
+         raise Constraint_Error;
+      end if;
+      return (Element => Container.Elements (J)'Access);
+   end Constant_Reference;
+
+   function Variable_Reference
+     (Container : aliased in out Vector;
+      Index     :         in     Index_Type)
+     return Variable_Reference_Type
+   is
+      J : constant Peek_Type := Peek_Type (Index - Index_Type'First + 1);
+   begin
+      if Index > Container.Last then
+         raise Constraint_Error;
+      end if;
+      return (Element => Container.Elements (J)'Access);
+   end Variable_Reference;
+
+   function Has_Element (Position : Cursor) return Boolean is
+   begin
+      if Position.Container = null then
+         return False;
+      end if;
+
+      return Position.Index <= Position.Container.Last;
+   end Has_Element;
+
+   overriding function First (Object : Iterator) return Cursor
+   is begin
+      if Object.Container.Last = No_Index then
+         return (null, Index_Type'First);
+      else
+         return (Object.Container, Object.Container.First_Index);
+      end if;
+   end First;
+
+   overriding function Last  (Object : Iterator) return Cursor
+   is begin
+      if Object.Container.Last = No_Index then
+         return (null, Index_Type'First);
+      else
+         return (Object.Container, Object.Container.Last_Index);
+      end if;
+   end Last;
+
+   overriding function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor
+   is begin
+      if Position.Index = Object.Container.Last then
+         return (null, Index_Type'First);
+      else
+         return (Object.Container, Position.Index + 1);
+      end if;
+   end Next;
+
+   overriding function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor
+   is begin
+      if Position.Index = Index_Type'First then
+         return (null, Index_Type'First);
+      else
+         return (Object.Container, Position.Index - 1);
+      end if;
+   end Previous;
+
+   function Iterate (Container : Vector) return 
Vector_Iterator_Interfaces.Reversible_Iterator'Class
+   is begin
+      return Iterator'
+        (Container => Container'Unrestricted_Access,
+         Index     => No_Index);
+   end Iterate;
+
+   function Constant_Reference (Container : aliased Vector; Position : in 
Cursor) return Constant_Reference_Type
+   is
+      J : constant Peek_Type := Peek_Type (Position.Index - Index_Type'First + 
1);
+   begin
+      return (Element => Container.Elements (J)'Access);
+   end Constant_Reference;
+
+   function Variable_Reference
+     (Container : aliased in out Vector;
+      Position  :         in     Cursor)
+     return Variable_Reference_Type
+   is
+      J : constant Peek_Type := Peek_Type (Position.Index - Index_Type'First + 
1);
+   begin
+      return (Element => Container.Elements (J)'Access);
+   end Variable_Reference;
+
+   ----------
+   --  Spec private functions
+
+   function To_Peek_Index (Index : in Extended_Index) return Base_Peek_Type
+   is begin
+      return Base_Peek_Type (Index - Index_Type'First + 1);
+   end To_Peek_Index;
+
+end SAL.Gen_Bounded_Definite_Vectors;
diff --git a/sal-gen_bounded_definite_vectors.ads 
b/sal-gen_bounded_definite_vectors.ads
new file mode 100644
index 0000000..d4c808d
--- /dev/null
+++ b/sal-gen_bounded_definite_vectors.ads
@@ -0,0 +1,150 @@
+--  Abstract :
+--
+--  A simple bounded vector of definite items, intended to be faster
+--  than Ada.Containers.Bounded_Definite_Vectors.
+--
+--  Copyright (C) 2017, 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Iterator_Interfaces;
+generic
+   type Index_Type is range <>;
+   type Element_Type is private;
+   Capacity : in Ada.Containers.Count_Type;
+package SAL.Gen_Bounded_Definite_Vectors is
+
+   subtype Extended_Index is Index_Type'Base
+     range Index_Type'First - 1 ..
+           Index_Type'Min (Index_Type'Base'Last - 1, Index_Type'Last) + 1;
+
+   No_Index : constant Extended_Index := Extended_Index'First;
+
+   type Vector is tagged private with
+      Constant_Indexing => Constant_Reference,
+      Variable_Indexing => Variable_Reference,
+      Default_Iterator  => Iterate,
+      Iterator_Element  => Element_Type;
+
+   Empty_Vector : constant Vector;
+
+   function Length (Container : in Vector) return Ada.Containers.Count_Type;
+
+   function Is_Full (Container : in Vector) return Boolean;
+
+   procedure Clear (Container : in out Vector);
+
+   function First_Index (Container : in Vector) return Index_Type is 
(Index_Type'First);
+
+   function Last_Index (Container : in Vector) return Extended_Index;
+   --  No_Index when Container is empty.
+
+   procedure Set_Last (Container : in out Vector; Last : in Index_Type);
+   --  Elements with indices < Last that have not been set are undefined.
+
+   function Element (Container : Vector; Index : Index_Type) return 
Element_Type;
+   --  Index of first element in vector is Index_Type'First.
+
+   procedure Append (Container : in out Vector; New_Item : in Element_Type);
+   --  Raises Container_Full if full (more useful than a precondition failure).
+
+   procedure Prepend (Container : in out Vector; New_Item : in Element_Type);
+   --  Insert New_Item at beginning of Container; current elements slide right.
+
+   procedure Insert
+     (Container : in out Vector;
+      New_Item  : in     Element_Type;
+      Before    : in     Extended_Index);
+   --  Insert New_Item before Before, or after Last_Index if Before is
+   --  No_Index. Current elements at Before and after slide right.
+   --  New_Item then has index Before.
+
+   function "+" (Item : in Element_Type) return Vector;
+   function "&" (Left : in Vector; Right : in Element_Type) return Vector;
+
+   procedure Delete_First (Container : in out Vector; Count : in Index_Type := 
1);
+   --  Remaining elements slide down.
+
+   type Constant_Reference_Type (Element : not null access constant 
Element_Type) is null record
+   with Implicit_Dereference => Element;
+
+   function Constant_Reference (Container : aliased Vector; Index : in 
Index_Type) return Constant_Reference_Type;
+
+   type Variable_Reference_Type (Element : not null access Element_Type) is 
null record
+   with Implicit_Dereference => Element;
+
+   function Variable_Reference
+     (Container : aliased in out Vector;
+      Index     :         in     Index_Type)
+     return Variable_Reference_Type;
+
+   type Cursor is private;
+
+   function Has_Element (Position : Cursor) return Boolean;
+
+   package Vector_Iterator_Interfaces is new Ada.Iterator_Interfaces (Cursor, 
Has_Element);
+
+   function Iterate (Container : Vector) return 
Vector_Iterator_Interfaces.Reversible_Iterator'Class;
+
+   function Constant_Reference (Container : aliased Vector; Position : in 
Cursor) return Constant_Reference_Type;
+
+   function Variable_Reference
+     (Container : aliased in out Vector;
+      Position  :         in     Cursor)
+     return Variable_Reference_Type;
+
+private
+
+   type Array_Type is array (Peek_Type range 1 .. Peek_Type (Capacity)) of 
aliased Element_Type;
+
+   type Vector is tagged
+   record
+      Elements : Array_Type := (others => <>);
+      Last     : Extended_Index := No_Index;
+   end record;
+
+   type Vector_Access is access all Vector;
+   for Vector_Access'Storage_Size use 0;
+
+   type Cursor is record
+      Container : Vector_Access;
+      Index     : Index_Type := Index_Type'First;
+   end record;
+
+   type Iterator is new Vector_Iterator_Interfaces.Reversible_Iterator with
+   record
+      Container : Vector_Access;
+      Index     : Index_Type'Base;
+   end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+   overriding function Last  (Object : Iterator) return Cursor;
+
+   overriding function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
+   overriding function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
+   Empty_Vector : constant Vector := (others => <>);
+
+   ----------
+   --  For child units
+
+   function To_Peek_Index (Index : in Extended_Index) return Base_Peek_Type
+   with Inline;
+
+end SAL.Gen_Bounded_Definite_Vectors;
diff --git a/sal-gen_definite_doubly_linked_lists.adb 
b/sal-gen_definite_doubly_linked_lists.adb
new file mode 100644
index 0000000..3855ae6
--- /dev/null
+++ b/sal-gen_definite_doubly_linked_lists.adb
@@ -0,0 +1,304 @@
+--  Abstract :
+--
+--  see spec
+--
+--  Copyright (C) 2017, 2018 Stephen Leake.  All Rights Reserved.
+--
+--  This library is free software; you can redistribute it and/or
+--  modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or (at
+--  your option) any later version. This library 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
+--  distributed with this program; see file COPYING. If not, write to
+--  the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
+--  MA 02111-1307, USA.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+package body SAL.Gen_Definite_Doubly_Linked_Lists is
+
+   ---------
+   --  Public operations, declaration order.
+
+   overriding
+   procedure Adjust (Container : in out List)
+   is
+      Next_Source : Node_Access := Container.Head;
+      New_Node    : Node_Access;
+   begin
+      if Next_Source = null then
+         return;
+      end if;
+
+      Container.Tail := null;
+
+      loop
+         New_Node := new Node_Type'
+           (Element => Next_Source.Element,
+            Next    => null,
+            Prev    => Container.Tail);
+         if Container.Tail = null then
+            Container.Head := New_Node;
+            Container.Tail := New_Node;
+         else
+            Container.Tail.Next := New_Node;
+            Container.Tail      := New_Node;
+         end if;
+         Next_Source := Next_Source.Next;
+         exit when Next_Source = null;
+      end loop;
+   end Adjust;
+
+   overriding
+   procedure Finalize (Container : in out List)
+   is
+      Next : Node_Access := Container.Head;
+   begin
+      loop
+         exit when Next = null;
+         Next := Container.Head.Next;
+         Free (Container.Head);
+         Container.Head := Next;
+      end loop;
+      Container.Tail := null;
+   end Finalize;
+
+   function Length (Container : in List) return Ada.Containers.Count_Type
+   is begin
+      return Container.Count;
+   end Length;
+
+   procedure Append (Container : in out List; Element : in Element_Type)
+   is
+      use all type Ada.Containers.Count_Type;
+      New_Node : constant Node_Access := new Node_Type'
+        (Element => Element,
+         Prev    => Container.Tail,
+         Next    => null);
+   begin
+      if Container.Tail = null then
+         Container.Head := New_Node;
+         Container.Tail := New_Node;
+      else
+         Container.Tail.Next := New_Node;
+         Container.Tail      := New_Node;
+      end if;
+      Container.Count := Container.Count + 1;
+   end Append;
+
+   procedure Prepend (Container : in out List; Element : in Element_Type)
+   is
+      use all type Ada.Containers.Count_Type;
+      New_Node : constant Node_Access := new Node_Type'
+        (Element => Element,
+         Prev    => null,
+         Next    => Container.Head);
+   begin
+      if Container.Tail = null then
+         Container.Head := New_Node;
+         Container.Tail := New_Node;
+      else
+         Container.Head.Prev := New_Node;
+         Container.Head      := New_Node;
+      end if;
+      Container.Count := Container.Count + 1;
+   end Prepend;
+
+   function To_List (Element : in Element_Type) return List
+   is begin
+      return Result : List do
+         Result.Append (Element);
+      end return;
+   end To_List;
+
+   function Has_Element (Position : in Cursor) return Boolean
+   is begin
+      return Position.Ptr /= null;
+   end Has_Element;
+
+   function First (Container : in List) return Cursor
+   is begin
+      if Container.Head = null then
+         return No_Element;
+      else
+         return (Container'Unrestricted_Access, Container.Head);
+      end if;
+   end First;
+
+   function Last (Container : in List) return Cursor
+   is begin
+      if Container.Tail = null then
+         return No_Element;
+      else
+         return (Container'Unrestricted_Access, Container.Tail);
+      end if;
+   end Last;
+
+   procedure Next (Position : in out Cursor)
+   is begin
+      if Position.Ptr /= null then
+         if Position.Ptr.Next = null then
+            Position := No_Element;
+         else
+            Position.Ptr := Position.Ptr.Next;
+         end if;
+      end if;
+   end Next;
+
+   function Next (Position : in Cursor) return Cursor
+   is begin
+      if Position.Ptr = null then
+         return Position;
+      else
+         if Position.Ptr.Next = null then
+            return No_Element;
+         else
+            return (Position.Container, Position.Ptr.Next);
+         end if;
+      end if;
+   end Next;
+
+   function Previous (Position : in Cursor) return Cursor
+   is begin
+      if Position.Ptr = null then
+         return Position;
+      else
+         if Position.Ptr.Prev = null then
+            return No_Element;
+         else
+            return (Position.Container, Position.Ptr.Prev);
+         end if;
+      end if;
+   end Previous;
+
+   function Element (Position : in Cursor) return Element_Type
+   is begin
+      return Position.Ptr.Element;
+   end Element;
+
+   procedure Delete (Container : in out List; Position : in out Cursor)
+   is
+      use all type Ada.Containers.Count_Type;
+      Node : Node_Access renames Position.Ptr;
+   begin
+      if Node.Next = null then
+         Container.Tail := Node.Prev;
+      else
+         Node.Next.Prev := Node.Prev;
+      end if;
+      if Node.Prev = null then
+         Container.Head := Node.Next;
+      else
+         Node.Prev.Next := Node.Next;
+      end if;
+      Free (Node);
+      Position        := No_Element;
+      Container.Count := Container.Count - 1;
+   end Delete;
+
+   procedure Insert
+     (Container : in out List;
+      Before    : in     Cursor;
+      Element   : in     Element_Type)
+   is
+      use all type Ada.Containers.Count_Type;
+   begin
+      if Before = No_Element then
+         Container.Append (Element);
+      else
+         if Before.Ptr = Container.Head then
+            declare
+               --  old list: before ...
+               --  newlist:  new  before ...
+               New_Node : constant Node_Access := new Node_Type'
+                 (Element => Element,
+                  Prev    => null,
+                  Next    => Before.Ptr);
+            begin
+               Before.Ptr.Prev := New_Node;
+               Container.Head  := New_Node;
+            end;
+         else
+            declare
+               --  old list: ... prev  before ...
+               --  newlist:  ... prev  new  before ...
+               New_Node : constant Node_Access := new Node_Type'
+                 (Element => Element,
+                  Prev    => Before.Ptr.Prev,
+                  Next    => Before.Ptr);
+            begin
+               Before.Ptr.Prev.Next := New_Node;
+               Before.Ptr.Prev      := New_Node;
+
+            end;
+         end if;
+         Container.Count := Container.Count + 1;
+      end if;
+   end Insert;
+
+   function Persistent_Ref (Position : in Cursor) return access Element_Type
+   is begin
+      return Position.Ptr.Element'Access;
+   end Persistent_Ref;
+
+   function Constant_Reference (Container : in List; Position : in Cursor) 
return Constant_Reference_Type
+   is
+      pragma Unreferenced (Container);
+   begin
+      return (Element => Position.Ptr.all.Element'Access);
+   end Constant_Reference;
+
+   function Constant_Ref (Position : in Cursor) return Constant_Reference_Type
+   is begin
+      return (Element => Position.Ptr.all.Element'Access);
+   end Constant_Ref;
+
+   function Reference (Container : in List; Position : in Cursor) return 
Reference_Type
+   is
+      pragma Unreferenced (Container);
+   begin
+      return (Element => Position.Ptr.all.Element'Access);
+   end Reference;
+
+   function Ref (Position : in Cursor) return Reference_Type
+   is begin
+      return (Element => Position.Ptr.all.Element'Access);
+   end Ref;
+
+   function Iterate (Container : aliased in List) return 
Iterator_Interfaces.Reversible_Iterator'Class
+   is begin
+      return Iterator'(Container => Container'Unrestricted_Access);
+   end Iterate;
+
+   overriding function First (Object : Iterator) return Cursor
+   is begin
+      return First (Object.Container.all);
+   end First;
+
+   overriding function Last  (Object : Iterator) return Cursor
+   is begin
+      return Last (Object.Container.all);
+   end Last;
+
+   overriding function Next (Object : in Iterator; Position : in Cursor) 
return Cursor
+   is
+      pragma Unreferenced (Object);
+   begin
+      return Next (Position);
+   end Next;
+
+   overriding function Previous (Object : in Iterator; Position : in Cursor) 
return Cursor
+   is
+      pragma Unreferenced (Object);
+   begin
+      return Previous (Position);
+   end Previous;
+
+end SAL.Gen_Definite_Doubly_Linked_Lists;
diff --git a/sal-gen_definite_doubly_linked_lists.ads 
b/sal-gen_definite_doubly_linked_lists.ads
new file mode 100644
index 0000000..203f9ad
--- /dev/null
+++ b/sal-gen_definite_doubly_linked_lists.ads
@@ -0,0 +1,159 @@
+--  Abstract :
+--
+--  A generic doubly linked list with definite elements, allowing
+--  permanent references to elements.
+--
+--  Copyright (C) 2017, 2018 Stephen Leake.  All Rights Reserved.
+--
+--  This library is free software; you can redistribute it and/or
+--  modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or (at
+--  your option) any later version. This library 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
+--  distributed with this program; see file COPYING. If not, write to
+--  the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
+--  MA 02111-1307, USA.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Containers;
+with Ada.Finalization;
+with Ada.Iterator_Interfaces;
+with Ada.Unchecked_Deallocation;
+generic
+   type Element_Type is private;
+package SAL.Gen_Definite_Doubly_Linked_Lists is
+
+   type List is new Ada.Finalization.Controlled with private
+   with
+      Constant_Indexing => Constant_Reference,
+      Variable_Indexing => Reference,
+      Default_Iterator  => Iterate,
+      Iterator_Element  => Element_Type;
+
+   type List_Access_Constant is access constant List;
+   for List_Access_Constant'Storage_Size use 0;
+
+   type List_Access is access all List;
+   for List_Access'Storage_Size use 0;
+
+   Empty_List : constant List;
+
+   overriding procedure Adjust (Container : in out List);
+   --  Deep copy.
+
+   overriding procedure Finalize (Container : in out List);
+   --  Free all items in List.
+
+   function Length (Container : in List) return Ada.Containers.Count_Type;
+
+   procedure Append (Container : in out List; Element : in Element_Type);
+
+   procedure Prepend (Container : in out List; Element : in Element_Type);
+
+   function To_List (Element : in Element_Type) return List;
+
+   type Cursor is private;
+
+   No_Element : constant Cursor;
+
+   function Has_Element (Position : in Cursor) return Boolean;
+
+   function First (Container : in List) return Cursor;
+   function Last (Container : in List) return Cursor;
+
+   procedure Next (Position : in out Cursor)
+   with Pre => Position /= No_Element;
+
+   function Next (Position : in Cursor) return Cursor
+   with Pre => Position /= No_Element;
+   function Previous (Position : in Cursor) return Cursor
+   with Pre => Position /= No_Element;
+
+   function Element (Position : in Cursor) return Element_Type
+   with Pre => Position /= No_Element;
+
+   procedure Delete (Container : in out List; Position : in out Cursor)
+   with Pre => Position /= No_Element;
+
+   procedure Insert
+     (Container : in out List;
+      Before    : in     Cursor;
+      Element   : in     Element_Type);
+   --  If Before is No_Element, insert after Last.
+
+   function Persistent_Ref (Position : in Cursor) return access Element_Type
+   with Pre => Position /= No_Element;
+
+   type Constant_Reference_Type (Element : not null access constant 
Element_Type) is null record
+   with Implicit_Dereference => Element;
+
+   function Constant_Reference (Container : in List; Position : in Cursor) 
return Constant_Reference_Type
+   with Pre => Position /= No_Element;
+   function Constant_Ref (Position : in Cursor) return Constant_Reference_Type
+   with Pre => Position /= No_Element;
+
+   type Reference_Type (Element : not null access Element_Type) is null record
+   with Implicit_Dereference => Element;
+
+   function Reference (Container : in List; Position : in Cursor) return 
Reference_Type
+   with Pre => Position /= No_Element;
+   function Ref (Position : in Cursor) return Reference_Type
+   with Pre => Position /= No_Element;
+
+   package Iterator_Interfaces is new Ada.Iterator_Interfaces (Cursor, 
Has_Element);
+
+   function Iterate (Container : aliased in List) return 
Iterator_Interfaces.Reversible_Iterator'Class;
+
+private
+   type Node_Type;
+
+   type Node_Access is access Node_Type;
+
+   type Node_Type is record
+      Element : aliased Element_Type;
+      Prev    : Node_Access;
+      Next    : Node_Access;
+   end record;
+
+   procedure Free is new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+
+   type List is new Ada.Finalization.Controlled with record
+      Head  : Node_Access               := null;
+      Tail  : Node_Access               := null;
+      Count : Ada.Containers.Count_Type := 0;
+   end record;
+
+   type Cursor is record
+      Container : List_Access;
+      Ptr       : Node_Access;
+   end record;
+
+   Empty_List : constant List := (Ada.Finalization.Controlled with null, null, 
0);
+
+   No_Element : constant Cursor := (null, null);
+
+   type Iterator is new Iterator_Interfaces.Reversible_Iterator with
+   record
+      Container : List_Access;
+   end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+   overriding function Last  (Object : Iterator) return Cursor;
+
+   overriding function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
+   overriding function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
+end SAL.Gen_Definite_Doubly_Linked_Lists;
diff --git a/sal-gen_definite_doubly_linked_lists_sorted-gen_image.adb 
b/sal-gen_definite_doubly_linked_lists_sorted-gen_image.adb
new file mode 100644
index 0000000..898a588
--- /dev/null
+++ b/sal-gen_definite_doubly_linked_lists_sorted-gen_image.adb
@@ -0,0 +1,47 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Strings.Unbounded;
+function SAL.Gen_Definite_Doubly_Linked_Lists_Sorted.Gen_Image
+  (Item : in List; Strict : in Boolean := False) return String
+is
+   use Ada.Strings;
+   use Ada.Strings.Unbounded;
+   Result     : Unbounded_String := To_Unbounded_String ("(");
+   Need_Comma : Boolean          := False;
+begin
+   if Strict and Item.Length = 0 then
+      return "(1 .. 0 => <>)";
+
+   elsif Strict and Item.Length = 1 then
+      return "(1 => " & Element_Image (Element (Item.First)) & ")";
+
+   else
+      for El of Item loop
+         if Need_Comma then
+            Result := Result & ", ";
+         else
+            Need_Comma := True;
+         end if;
+         Result := Result & Element_Image (El);
+      end loop;
+      Result := Result & ")";
+      return To_String (Result);
+   end if;
+end SAL.Gen_Definite_Doubly_Linked_Lists_Sorted.Gen_Image;
diff --git a/sal-gen_definite_doubly_linked_lists_sorted-gen_image.ads 
b/sal-gen_definite_doubly_linked_lists_sorted-gen_image.ads
new file mode 100644
index 0000000..2743f4e
--- /dev/null
+++ b/sal-gen_definite_doubly_linked_lists_sorted-gen_image.ads
@@ -0,0 +1,25 @@
+--  Abstract :
+--
+--  Image of parent.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+generic
+   with function Element_Image (Item : in Element_Type) return String;
+function SAL.Gen_Definite_Doubly_Linked_Lists_Sorted.Gen_Image
+  (Item : in List; Strict : in Boolean := False) return String;
+--  Image of Item, in Ada aggregate syntax. If Strict, use correct
+--  syntax for 0 and 1 item; otherwise, use () and (item).
diff --git a/sal-gen_definite_doubly_linked_lists_sorted.adb 
b/sal-gen_definite_doubly_linked_lists_sorted.adb
new file mode 100644
index 0000000..da99b3e
--- /dev/null
+++ b/sal-gen_definite_doubly_linked_lists_sorted.adb
@@ -0,0 +1,542 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+package body SAL.Gen_Definite_Doubly_Linked_Lists_Sorted is
+
+   ----------
+   --  Body subprograms, alphabetical
+
+   procedure Find
+     (Container     : in     List;
+      Element       : in     Element_Type;
+      Found         :    out Node_Access;
+      Found_Compare :    out Compare_Result)
+   is
+      --  Return pointer to first item in Container for which Compare (item,
+      --  element) returns True or Greater. If no such element exists, Found
+      --  is null, Found_Compare is Less.
+      use Ada.Containers;
+   begin
+      if Container.Head = null then
+         Found         := null;
+         Found_Compare := Less;
+         return;
+      end if;
+
+      declare
+         Low_Index  : Count_Type  := 1;
+         High_Index : Count_Type  := Container.Count;
+         Next_Node  : Node_Access := Container.Head;
+         Next_Index : Count_Type  := Low_Index;
+         Old_Index  : Count_Type;
+      begin
+         loop
+            Old_Index  := Next_Index;
+            Next_Index := (Low_Index + High_Index) / 2;
+
+            if Next_Index > Old_Index then
+               for I in Old_Index + 1 .. Next_Index loop
+                  Next_Node := Next_Node.Next;
+               end loop;
+            elsif Next_Index < Old_Index then
+               for I in Next_Index .. Old_Index - 1 loop
+                  Next_Node := Next_Node.Prev;
+               end loop;
+            end if;
+
+            case Element_Compare (Next_Node.Element, Element) is
+            when Less =>
+               if Next_Index = High_Index then
+                  --  no more nodes to check
+                  Found         := null;
+                  Found_Compare := Less;
+                  return;
+               elsif Next_Index = Low_Index then
+                  --  force check of high_index
+                  Low_Index := High_Index;
+               else
+                  Low_Index := Next_Index;
+               end if;
+
+            when Equal =>
+               Found         := Next_Node;
+               Found_Compare := Equal;
+               return;
+
+            when Greater =>
+               if Low_Index = Next_Index then
+                  --  no more nodes to check
+                  Found         := Next_Node;
+                  Found_Compare := Greater;
+                  return;
+               elsif High_Index = Next_Index then
+                  --  Desired result is either high_index or low_index
+                  pragma Assert (Low_Index + 1 = High_Index);
+                  case Element_Compare (Next_Node.Prev.Element, Element) is
+                  when Less =>
+                     Found         := Next_Node;
+                     Found_Compare := Greater;
+                     return;
+                  when Equal =>
+                     Found         := Next_Node.Prev;
+                     Found_Compare := Equal;
+                     return;
+                  when Greater =>
+                     Found         := Next_Node.Prev;
+                     Found_Compare := Greater;
+                     return;
+                  end case;
+               else
+                  High_Index := Next_Index;
+               end if;
+            end case;
+         end loop;
+      end;
+   end Find;
+
+   procedure Insert_Before
+     (Container : in out List;
+      Before    : in     Node_Access;
+      Element   : in     Element_Type)
+   is
+      New_Node : constant Node_Access := new Node_Type'
+        (Element => Element,
+         Prev    => Before.Prev,
+         Next    => Before);
+   begin
+      if Before = Container.Head then
+         Before.Prev    := New_Node;
+         Container.Head := New_Node;
+      else
+         Before.Prev.Next := New_Node;
+         Before.Prev      := New_Node;
+      end if;
+   end Insert_Before;
+
+   procedure Insert_After_Tail
+     (Container : in out List;
+      Element   : in     Element_Type)
+   is
+      New_Node : constant Node_Access := new Node_Type'
+        (Element => Element,
+         Prev    => Container.Tail,
+         Next    => null);
+   begin
+      Container.Tail.Next := New_Node;
+      Container.Tail      := New_Node;
+   end Insert_After_Tail;
+
+   ---------
+   --  Public operations, declaration order.
+
+   overriding
+   procedure Adjust (Container : in out List)
+   is
+      Next_Source : Node_Access := Container.Head;
+      New_Node    : Node_Access;
+   begin
+      if Next_Source = null then
+         return;
+      end if;
+
+      Container.Tail := null;
+
+      loop
+         New_Node := new Node_Type'
+           (Element => Next_Source.Element,
+            Next    => null,
+            Prev    => Container.Tail);
+         if Container.Tail = null then
+            Container.Head := New_Node;
+            Container.Tail := New_Node;
+         else
+            Container.Tail.Next := New_Node;
+            Container.Tail      := New_Node;
+         end if;
+         Next_Source := Next_Source.Next;
+         exit when Next_Source = null;
+      end loop;
+   end Adjust;
+
+   overriding
+   procedure Finalize (Container : in out List)
+   is
+      Next : Node_Access := Container.Head;
+   begin
+      loop
+         exit when Next = null;
+         Next := Container.Head.Next;
+         Free (Container.Head);
+         Container.Head := Next;
+      end loop;
+      Container.Tail := null;
+   end Finalize;
+
+   overriding function "=" (Left, Right : in List) return Boolean
+   is
+      Left_I  : Node_Access := Left.Head;
+      Right_I : Node_Access := Right.Head;
+   begin
+      loop
+         exit when Left_I = null;
+
+         if Right_I = null then
+            return False;
+         elsif Left_I.Element /= Right_I.Element then
+            return False;
+         end if;
+
+         Left_I  := Left_I.Next;
+         Right_I := Right_I.Next;
+      end loop;
+      return Right_I = null;
+   end "=";
+
+   function Length (Container : in List) return Ada.Containers.Count_Type
+   is begin
+      return Container.Count;
+   end Length;
+
+   function To_List (Element : in Element_Type) return List
+   is
+      New_Node : constant Node_Access := new Node_Type'
+        (Element => Element,
+         Prev    => null,
+         Next    => null);
+   begin
+      return Result : constant List :=
+        (Ada.Finalization.Controlled with
+         Head  => New_Node,
+         Tail  => New_Node,
+         Count => 1);
+   end To_List;
+
+   procedure Insert (Container : in out List; Element : in Element_Type)
+   is
+      Node    : Node_Access := Container.Head;
+      Compare : Compare_Result;
+   begin
+      if Node = null then
+         Container := To_List (Element);
+      else
+         Find (Container, Element, Node, Compare);
+
+         Container.Count := Container.Count + 1;
+
+         if Node = null then
+            Insert_After_Tail (Container, Element);
+         else
+            Insert_Before (Container, Node, Element);
+         end if;
+      end if;
+   end Insert;
+
+   function Contains (Container : in List; Element : in Element_Type) return 
Boolean
+   is
+      Node    : Node_Access := Container.Head;
+      Compare : Compare_Result;
+   begin
+      Find (Container, Element, Node, Compare);
+      return Compare = Equal;
+   end Contains;
+
+   procedure Merge
+     (Target : in out List;
+      Source : in     List;
+      Added  :    out Boolean)
+   is
+      Target_I : Node_Access := Target.Head;
+      Source_I : Node_Access := Source.Head;
+   begin
+      if Target_I = null then
+         if Source_I = null then
+            Added := False;
+         else
+            Target.Head  := Source.Head;
+            Target.Tail  := Source.Tail;
+            Target.Count := Source.Count;
+            Adjust (Target);
+
+            Added := True;
+         end if;
+
+      elsif Source_I = null then
+         Added := False;
+
+      else
+         Added := False;
+         loop
+            exit when Source_I = null;
+
+            if Target_I = null then
+               Added := True;
+               Target.Count := Target.Count + 1;
+               Insert_After_Tail (Target, Source_I.Element);
+               Source_I := Source_I.Next;
+
+            else
+               case Element_Compare (Target_I.Element, Source_I.Element) is
+               when Greater =>
+                  Added := True;
+                  Target.Count := Target.Count + 1;
+                  Insert_Before (Target, Target_I, Source_I.Element);
+                  Source_I := Source_I.Next;
+
+               when Equal =>
+                  Target_I := Target_I.Next;
+                  Source_I := Source_I.Next;
+
+               when Less =>
+                  Target_I := Target_I.Next;
+               end case;
+            end if;
+         end loop;
+      end if;
+   end Merge;
+
+   procedure Merge
+     (Target  : in out List;
+      Source  : in     List;
+      Added   :    out Boolean;
+      Exclude : in     Element_Type)
+   is
+      Target_I : Node_Access := Target.Head;
+      Source_I : Node_Access := Source.Head;
+   begin
+      Added := False;
+
+      if Target_I = null then
+         if Source_I = null then
+            return;
+         else
+            loop
+               if Source_I = null then
+                  return;
+               end if;
+               exit when Source_I.Element /= Exclude;
+               Source_I := Source_I.Next;
+            end loop;
+
+            Added    := True;
+            Target   := To_List (Source_I.Element);
+            Source_I := Source_I.Next;
+         end if;
+      end if;
+
+      loop
+         exit when Source_I = null;
+
+         if Source_I.Element = Exclude then
+            Source_I := Source_I.Next;
+
+         elsif Target_I = null then
+            Added := True;
+            Target.Count := Target.Count + 1;
+            Insert_After_Tail (Target, Source_I.Element);
+            Source_I := Source_I.Next;
+
+         else
+            case Element_Compare (Target_I.Element, Source_I.Element) is
+            when Greater =>
+               Added := True;
+               Target.Count := Target.Count + 1;
+               Insert_Before (Target, Target_I, Source_I.Element);
+               Source_I := Source_I.Next;
+
+            when Equal =>
+               Target_I := Target_I.Next;
+               Source_I := Source_I.Next;
+
+            when Less =>
+               Target_I := Target_I.Next;
+            end case;
+         end if;
+      end loop;
+   end Merge;
+
+   function Has_Element (Position : in Cursor) return Boolean
+   is begin
+      return Position.Ptr /= null;
+   end Has_Element;
+
+   function First (Container : in List) return Cursor
+   is begin
+      if Container.Head = null then
+         return No_Element;
+      else
+         return (Container'Unrestricted_Access, Container.Head);
+      end if;
+   end First;
+
+   function Last (Container : in List) return Cursor
+   is begin
+      if Container.Tail = null then
+         return No_Element;
+      else
+         return (Container'Unrestricted_Access, Container.Tail);
+      end if;
+   end Last;
+
+   function Find (Container : in List; Element : in Element_Type) return Cursor
+   is
+      Node    : Node_Access;
+      Compare : Compare_Result;
+   begin
+      Find (Container, Element, Node, Compare);
+
+      if Node = null then
+         return No_Element;
+      elsif Compare = Equal then
+         return (Container'Unrestricted_Access, Node);
+      else
+         return No_Element;
+      end if;
+   end Find;
+
+   procedure Next (Position : in out Cursor)
+   is begin
+      if Position.Ptr /= null then
+         if Position.Ptr.Next = null then
+            Position := No_Element;
+         else
+            Position.Ptr := Position.Ptr.Next;
+         end if;
+      end if;
+   end Next;
+
+   function Next (Position : in Cursor) return Cursor
+   is begin
+      if Position.Ptr = null then
+         return Position;
+      else
+         if Position.Ptr.Next = null then
+            return No_Element;
+         else
+            return (Position.Container, Position.Ptr.Next);
+         end if;
+      end if;
+   end Next;
+
+   function Previous (Position : in Cursor) return Cursor
+   is begin
+      if Position.Ptr = null then
+         return Position;
+      else
+         if Position.Ptr.Prev = null then
+            return No_Element;
+         else
+            return (Position.Container, Position.Ptr.Prev);
+         end if;
+      end if;
+   end Previous;
+
+   function Element (Position : in Cursor) return Element_Type
+   is begin
+      return Position.Ptr.Element;
+   end Element;
+
+   procedure Delete (Container : in out List; Position : in out Cursor)
+   is
+      Node : Node_Access renames Position.Ptr;
+   begin
+      if Node.Next = null then
+         Container.Tail := Node.Prev;
+      else
+         Node.Next.Prev := Node.Prev;
+      end if;
+      if Node.Prev = null then
+         Container.Head := Node.Next;
+      else
+         Node.Prev.Next := Node.Next;
+      end if;
+      Free (Node);
+      Position        := No_Element;
+      Container.Count := Container.Count - 1;
+   end Delete;
+
+   function Pop (Container : in out List) return Element_Type
+   is
+      Node : Node_Access := Container.Head;
+   begin
+      return Result : constant Element_Type := Container.Head.Element do
+         Container.Head := Node.Next;
+         if Node.Next = null then
+            Container.Tail := null;
+         else
+            Node.Next.Prev := null;
+         end if;
+         Free (Node);
+         Container.Count := Container.Count - 1;
+      end return;
+   end Pop;
+
+   function Constant_Reference (Container : in List; Position : in Cursor) 
return Constant_Reference_Type
+   is
+      pragma Unreferenced (Container);
+   begin
+      return (Element => Position.Ptr.all.Element'Access);
+   end Constant_Reference;
+
+   function Constant_Ref (Position : in Cursor) return Constant_Reference_Type
+   is begin
+      return (Element => Position.Ptr.all.Element'Access);
+   end Constant_Ref;
+
+   function Reference (Container : in List; Position : in Cursor) return 
Reference_Type
+   is
+      pragma Unreferenced (Container);
+   begin
+      return (Element => Position.Ptr.all.Element'Access);
+   end Reference;
+
+   function Ref (Position : in Cursor) return Reference_Type
+   is begin
+      return (Element => Position.Ptr.all.Element'Access);
+   end Ref;
+
+   function Iterate (Container : aliased in List) return 
Iterator_Interfaces.Reversible_Iterator'Class
+   is begin
+      return Iterator'(Container => Container'Unrestricted_Access);
+   end Iterate;
+
+   overriding function First (Object : Iterator) return Cursor
+   is begin
+      return First (Object.Container.all);
+   end First;
+
+   overriding function Last  (Object : Iterator) return Cursor
+   is begin
+      return Last (Object.Container.all);
+   end Last;
+
+   overriding function Next (Object : in Iterator; Position : in Cursor) 
return Cursor
+   is
+      pragma Unreferenced (Object);
+   begin
+      return Next (Position);
+   end Next;
+
+   overriding function Previous (Object : in Iterator; Position : in Cursor) 
return Cursor
+   is
+      pragma Unreferenced (Object);
+   begin
+      return Previous (Position);
+   end Previous;
+
+end SAL.Gen_Definite_Doubly_Linked_Lists_Sorted;
diff --git a/sal-gen_definite_doubly_linked_lists_sorted.ads 
b/sal-gen_definite_doubly_linked_lists_sorted.ads
new file mode 100644
index 0000000..464ff86
--- /dev/null
+++ b/sal-gen_definite_doubly_linked_lists_sorted.ads
@@ -0,0 +1,175 @@
+--  Abstract :
+--
+--  A generic sorted doubly linked list with definite elements.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Finalization;
+with Ada.Iterator_Interfaces;
+with Ada.Unchecked_Deallocation;
+generic
+   type Element_Type is private;
+   with function Element_Compare (Left, Right : in Element_Type) return 
Compare_Result;
+package SAL.Gen_Definite_Doubly_Linked_Lists_Sorted is
+   use all type Ada.Containers.Count_Type;
+
+   type List is new Ada.Finalization.Controlled with private
+   with
+      Constant_Indexing => Constant_Reference,
+      Variable_Indexing => Reference,
+      Default_Iterator  => Iterate,
+      Iterator_Element  => Element_Type;
+
+   --  If user uses Variable_Indexing, they must not change the sort
+   --  order of the elements.
+
+   type List_Access is access all List;
+   for List_Access'Storage_Size use 0;
+
+   Empty_List : constant List;
+
+   overriding procedure Adjust (Container : in out List);
+   --  Deep copy.
+
+   overriding procedure Finalize (Container : in out List);
+   --  Free all items in List.
+
+   overriding function "=" (Left, Right : in List) return Boolean;
+   --  True if contents are the same.
+
+   function Length (Container : in List) return Ada.Containers.Count_Type;
+
+   function To_List (Element : in Element_Type) return List;
+
+   procedure Insert (Container : in out List; Element : in Element_Type);
+   --  Insert Element before first item for which Element_Order (item,
+   --  element) returns True.
+
+   function Contains (Container : in List; Element : in Element_Type) return 
Boolean;
+
+   procedure Merge
+     (Target : in out List;
+      Source : in     List;
+      Added  :    out Boolean);
+   --  Add all elements of Source to Target, if they are not already
+   --  present.
+   --
+   --  Added is True if any element was not already present.
+
+   procedure Merge
+     (Target  : in out List;
+      Source  : in     List;
+      Added   :    out Boolean;
+      Exclude : in     Element_Type);
+   --  Add all elements of Source to Target, if they are not already
+   --  present, and are not equal to Exclude.
+   --
+   --  Added is True if any element was not already present.
+
+   type Cursor is private;
+
+   No_Element : constant Cursor;
+
+   function Has_Element (Position : in Cursor) return Boolean;
+
+   function First (Container : in List) return Cursor;
+   function Last (Container : in List) return Cursor;
+
+   function Find (Container : in List; Element : in Element_Type) return 
Cursor;
+   --  No_Element if Element not found.
+
+   procedure Next (Position : in out Cursor)
+   with Pre => Position /= No_Element;
+
+   function Next (Position : in Cursor) return Cursor
+   with Pre => Position /= No_Element;
+   function Previous (Position : in Cursor) return Cursor
+   with Pre => Position /= No_Element;
+
+   function Element (Position : in Cursor) return Element_Type
+   with Pre => Position /= No_Element;
+
+   procedure Delete (Container : in out List; Position : in out Cursor)
+   with Pre => Position /= No_Element;
+
+   function Pop (Container : in out List) return Element_Type
+   with Pre => Container.Length > 0;
+   --  Return Container.First, delete it from Container.
+
+   type Constant_Reference_Type (Element : not null access constant 
Element_Type) is null record
+   with Implicit_Dereference => Element;
+
+   function Constant_Reference (Container : in List; Position : in Cursor) 
return Constant_Reference_Type;
+   function Constant_Ref (Position : in Cursor) return Constant_Reference_Type;
+
+   type Reference_Type (Element : not null access Element_Type) is null record
+   with Implicit_Dereference => Element;
+
+   function Reference (Container : in List; Position : in Cursor) return 
Reference_Type
+   with Pre => Position /= No_Element;
+   function Ref (Position : in Cursor) return Reference_Type
+   with Pre => Position /= No_Element;
+   --  User must not change the element in a way that affects the sort order.
+
+   package Iterator_Interfaces is new Ada.Iterator_Interfaces (Cursor, 
Has_Element);
+
+   function Iterate (Container : aliased in List) return 
Iterator_Interfaces.Reversible_Iterator'Class;
+
+private
+   type Node_Type;
+
+   type Node_Access is access Node_Type;
+
+   type Node_Type is record
+      Element : aliased Element_Type;
+      Prev    : Node_Access;
+      Next    : Node_Access;
+   end record;
+
+   procedure Free is new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+
+   type List is new Ada.Finalization.Controlled with record
+      Head  : Node_Access               := null;
+      Tail  : Node_Access               := null;
+      Count : Ada.Containers.Count_Type := 0;
+   end record;
+
+   type Cursor is record
+      Container : List_Access;
+      Ptr       : Node_Access;
+   end record;
+
+   Empty_List : constant List := (Ada.Finalization.Controlled with null, null, 
0);
+
+   No_Element : constant Cursor := (null, null);
+
+   type Iterator is new Iterator_Interfaces.Reversible_Iterator with
+   record
+      Container : List_Access;
+   end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+   overriding function Last  (Object : Iterator) return Cursor;
+
+   overriding function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
+   overriding function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
+end SAL.Gen_Definite_Doubly_Linked_Lists_Sorted;
diff --git a/sal-gen_indefinite_doubly_linked_lists.adb 
b/sal-gen_indefinite_doubly_linked_lists.adb
new file mode 100644
index 0000000..079e736
--- /dev/null
+++ b/sal-gen_indefinite_doubly_linked_lists.adb
@@ -0,0 +1,201 @@
+--  Abstract :
+--
+--  see spec
+--
+--  Copyright (C) 2018 Stephen Leake.  All Rights Reserved.
+--
+--  This library is free software; you can redistribute it and/or
+--  modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or (at
+--  your option) any later version. This library 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
+--  distributed with this program; see file COPYING. If not, write to
+--  the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
+--  MA 02111-1307, USA.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+package body SAL.Gen_Indefinite_Doubly_Linked_Lists is
+
+   ---------
+   --  Public operations, declaration order.
+
+   overriding
+   procedure Adjust (Container : in out List)
+   is
+      Source   : Node_Access := Container.Head;
+      New_Node : Node_Access;
+   begin
+      if Source = null then
+         return;
+      end if;
+
+      Container.Tail := null;
+
+      loop
+         New_Node := new Node_Type'
+           (Element => new Element_Type'(Source.Element.all),
+            Next    => null,
+            Prev    => Container.Tail);
+         if Container.Tail = null then
+            Container.Head := New_Node;
+            Container.Tail := New_Node;
+         else
+            Container.Tail.Next := New_Node;
+            Container.Tail      := New_Node;
+         end if;
+         Source := Source.Next;
+         exit when Source = null;
+      end loop;
+   end Adjust;
+
+   overriding
+   procedure Finalize (Container : in out List)
+   is
+      Next : Node_Access := Container.Head;
+   begin
+      loop
+         exit when Next = null;
+         Next := Container.Head.Next;
+         Free (Container.Head.Element);
+         Free (Container.Head);
+         Container.Head := Next;
+      end loop;
+      Container.Tail := null;
+   end Finalize;
+
+   function Length (Container : in List) return SAL.Base_Peek_Type
+   is begin
+      return Container.Count;
+   end Length;
+
+   procedure Append (Container : in out List; Element : in Element_Type)
+   is
+      New_Node : constant Node_Access := new Node_Type'
+        (Element => new Element_Type'(Element),
+         Prev    => Container.Tail,
+         Next    => null);
+   begin
+      if Container.Tail = null then
+         Container.Head := New_Node;
+         Container.Tail := New_Node;
+      else
+         Container.Tail.Next := New_Node;
+         Container.Tail      := New_Node;
+      end if;
+      Container.Count := Container.Count + 1;
+   end Append;
+
+   procedure Prepend (Container : in out List; Element : in Element_Type)
+   is
+      New_Node : constant Node_Access := new Node_Type'
+        (Element => new Element_Type'(Element),
+         Prev    => null,
+         Next    => Container.Head);
+   begin
+      if Container.Tail = null then
+         Container.Head := New_Node;
+         Container.Tail := New_Node;
+      else
+         Container.Head.Prev := New_Node;
+         Container.Head      := New_Node;
+      end if;
+      Container.Count := Container.Count + 1;
+   end Prepend;
+
+   function Has_Element (Position : in Cursor) return Boolean
+   is begin
+      return Position.Ptr /= null;
+   end Has_Element;
+
+   function First (Container : in List) return Cursor
+   is begin
+      if Container.Head = null then
+         return No_Element;
+      else
+         return (Container'Unrestricted_Access, Container.Head);
+      end if;
+   end First;
+
+   procedure Next (Position : in out Cursor)
+   is begin
+      if Position.Ptr /= null then
+         if Position.Ptr.Next = null then
+            Position := No_Element;
+         else
+            Position.Ptr := Position.Ptr.Next;
+         end if;
+      end if;
+   end Next;
+
+   function Next (Position : in Cursor) return Cursor
+   is begin
+      if Position.Ptr = null then
+         return Position;
+      else
+         if Position.Ptr.Next = null then
+            return No_Element;
+         else
+            return (Position.Container, Position.Ptr.Next);
+         end if;
+      end if;
+   end Next;
+
+   function Element (Position : in Cursor) return Element_Type
+   is begin
+      return Position.Ptr.Element.all;
+   end Element;
+
+   procedure Delete (Container : in out List; Position : in out Cursor)
+   is
+      Node : Node_Access renames Position.Ptr;
+   begin
+      if Node.Next = null then
+         Container.Tail := Node.Prev;
+      else
+         Node.Next.Prev := Node.Prev;
+      end if;
+      if Node.Prev = null then
+         Container.Head := Node.Next;
+      else
+         Node.Prev.Next := Node.Next;
+      end if;
+      Free (Node.Element);
+      Free (Node);
+      Position        := No_Element;
+      Container.Count := Container.Count - 1;
+   end Delete;
+
+   function Persistent_Ref (Position : in Cursor) return access Element_Type
+   is begin
+      return Position.Ptr.Element;
+   end Persistent_Ref;
+
+   function Constant_Reference (Position : in Cursor) return 
Constant_Reference_Type
+   is begin
+      return (Element => Position.Ptr.all.Element);
+   end Constant_Reference;
+
+   function Constant_Ref (Container : in List'Class; Position : in Peek_Type) 
return Constant_Reference_Type
+   is
+      Ptr : Node_Access := Container.Head;
+   begin
+      for I in 2 .. Position loop
+         Ptr := Ptr.Next;
+      end loop;
+      return (Element => Ptr.all.Element);
+   end Constant_Ref;
+
+   function Reference (Position : in Cursor) return Reference_Type
+   is begin
+      return (Element => Position.Ptr.all.Element);
+   end Reference;
+
+end SAL.Gen_Indefinite_Doubly_Linked_Lists;
diff --git a/sal-gen_indefinite_doubly_linked_lists.ads 
b/sal-gen_indefinite_doubly_linked_lists.ads
new file mode 100644
index 0000000..f477f2d
--- /dev/null
+++ b/sal-gen_indefinite_doubly_linked_lists.ads
@@ -0,0 +1,114 @@
+--  Abstract :
+--
+--  A generic doubly linked list with indefinite elements, allowing
+--  permanent references to elements.
+--
+--  Copyright (C) 2018 Stephen Leake.  All Rights Reserved.
+--
+--  This library is free software; you can redistribute it and/or
+--  modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or (at
+--  your option) any later version. This library 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
+--  distributed with this program; see file COPYING. If not, write to
+--  the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
+--  MA 02111-1307, USA.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Finalization;
+with Ada.Unchecked_Deallocation;
+generic
+   type Element_Type (<>) is private;
+package SAL.Gen_Indefinite_Doubly_Linked_Lists is
+
+   type List is new Ada.Finalization.Controlled with private;
+
+   Empty_List : constant List;
+
+   overriding procedure Adjust (Container : in out List);
+   --  Deep copy.
+
+   overriding procedure Finalize (Container : in out List);
+   --  Free all items in List.
+
+   function Length (Container : in List) return Base_Peek_Type;
+
+   procedure Append (Container : in out List; Element : in Element_Type);
+
+   procedure Prepend (Container : in out List; Element : in Element_Type);
+
+   type Cursor is private;
+
+   No_Element : constant Cursor;
+
+   function Has_Element (Position : in Cursor) return Boolean;
+
+   function First (Container : in List) return Cursor;
+
+   procedure Next (Position : in out Cursor);
+
+   function Next (Position : in Cursor) return Cursor;
+
+   function Element (Position : in Cursor) return Element_Type
+   with Pre => Has_Element (Position);
+
+   procedure Delete (Container : in out List; Position : in out Cursor)
+   with Pre => Has_Element (Position);
+
+   function Persistent_Ref (Position : in Cursor) return access Element_Type
+   with Pre => Has_Element (Position);
+
+   type Constant_Reference_Type (Element : not null access constant 
Element_Type) is null record
+   with Implicit_Dereference => Element;
+
+   function Constant_Reference (Position : in Cursor) return 
Constant_Reference_Type
+   with Pre => Has_Element (Position);
+
+   function Constant_Ref (Container : in List'Class; Position : in Peek_Type) 
return Constant_Reference_Type
+   with Pre => Position <= Container.Length;
+
+   type Reference_Type (Element : not null access Element_Type) is null record
+   with Implicit_Dereference => Element;
+
+   function Reference (Position : in Cursor) return Reference_Type
+   with Pre => Has_Element (Position);
+
+private
+   type Node_Type;
+   type Node_Access is access Node_Type;
+   type Element_Access is access Element_Type;
+
+
+   type Node_Type is record
+      Element : Element_Access;
+      Prev    : Node_Access;
+      Next    : Node_Access;
+   end record;
+
+   procedure Free is new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+   procedure Free is new Ada.Unchecked_Deallocation (Element_Type, 
Element_Access);
+
+   type List is new Ada.Finalization.Controlled with record
+      Head  : Node_Access        := null;
+      Tail  : Node_Access        := null;
+      Count : SAL.Base_Peek_Type := 0;
+   end record;
+
+   type Cursor is record
+      Container : access List;
+      Ptr       : Node_Access;
+   end record;
+
+   Empty_List : constant List := (Ada.Finalization.Controlled with null, null, 
0);
+
+   No_Element : constant Cursor := (null, null);
+
+end SAL.Gen_Indefinite_Doubly_Linked_Lists;
diff --git a/sal-gen_trimmed_image.adb b/sal-gen_trimmed_image.adb
new file mode 100644
index 0000000..41fb042
--- /dev/null
+++ b/sal-gen_trimmed_image.adb
@@ -0,0 +1,28 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Strings;
+with Ada.Strings.Fixed;
+function SAL.Gen_Trimmed_Image (Item : in Element_Type) return String
+is
+   use Ada.Strings;
+   use Ada.Strings.Fixed;
+begin
+   return Trim (Element_Type'Image (Item), Both);
+end SAL.Gen_Trimmed_Image;
diff --git a/sal-gen_trimmed_image.ads b/sal-gen_trimmed_image.ads
new file mode 100644
index 0000000..faf782f
--- /dev/null
+++ b/sal-gen_trimmed_image.ads
@@ -0,0 +1,23 @@
+--  Abstract :
+--
+--  Generic trimmed image.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+generic
+   type Element_Type is range <>;
+function SAL.Gen_Trimmed_Image (Item : in Element_Type) return String;
+--  Return image of Item with no leading space.
diff --git a/sal-gen_unbounded_definite_min_heaps_fibonacci.adb 
b/sal-gen_unbounded_definite_min_heaps_fibonacci.adb
new file mode 100644
index 0000000..75b9478
--- /dev/null
+++ b/sal-gen_unbounded_definite_min_heaps_fibonacci.adb
@@ -0,0 +1,340 @@
+--  Abstract:
+--
+--  See spec.
+--
+--  Copyright (C) 2017, 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Unchecked_Deallocation;
+with Long_Float_Elementary_Functions;
+package body SAL.Gen_Unbounded_Definite_Min_Heaps_Fibonacci is
+
+   ----------
+   --  local subprogram specs (as needed), alphabetical order
+
+   procedure Insert_Into_Root_List (Heap : in out Heap_Type; X : in 
Node_Access);
+
+   procedure Link (Y, X : in Node_Access);
+
+   procedure Remove_From_List (X : in Node_Access);
+
+   procedure Swap (A, B : in out Node_Access);
+
+   ----------
+   --  local subprogram bodies, alphabetical order
+
+   function Add (Heap : in out Heap_Type; Item : in Element_Type) return 
Node_Access
+   is
+      X : constant Node_Access := new Node'(Item, null, null, null, null, 0, 
False);
+   begin
+      --  [1] 19.2 FIB-HEAP-INSERT
+      if Heap.Min = null then
+         Heap.Min       := X;
+         Heap.Min.Left  := Heap.Min;
+         Heap.Min.Right := Heap.Min;
+      else
+         Insert_Into_Root_List (Heap, X);
+
+         if Key (Item) < Key (Heap.Min.Element) then
+            Heap.Min := X;
+         end if;
+      end if;
+      Heap.Count := Heap.Count + 1;
+
+      return X;
+   end Add;
+
+   procedure Consolidate (Heap : in out Heap_Type)
+   is
+      --  [1] 19.4 max degree of Fibonacci heap
+      Phi : constant := 1.61803398874989484820458683436563811772; -- 
https://oeis.org/A001622/constant
+      Max_Degree : constant Integer := Integer
+        (Long_Float_Elementary_Functions.Log (Long_Float (Heap.Count), Base => 
Phi));
+
+      --  [1] 19.2 CONSOLIDATE
+      A : array (0 .. Max_Degree) of Node_Access := (others => null);
+
+      W    : Node_Access := Heap.Min;
+      Last : Node_Access := Heap.Min;
+      X, Y : Node_Access;
+      D    : Integer;
+
+      Min_Key : Key_Type;
+   begin
+      loop
+         X := W;
+         W := W.Right;
+
+         D := X.Degree;
+
+         loop
+            exit when A (D) = null;
+
+            Y := A (D);
+            if Key (Y.Element) < Key (X.Element) then
+               Swap (X, Y);
+            end if;
+            if Y = Last and W /= Last then
+               Last := Y.Right;
+            end if;
+            Link (Y, X);
+            A (D) := null;
+            D := D + 1;
+            exit when D = A'Last;
+         end loop;
+
+         A (D) := X;
+
+         exit when W = Last;
+      end loop;
+
+      Heap.Min := null;
+      for I in A'Range loop
+         if A (I) /= null then
+            if Heap.Min = null then
+               Heap.Min       := A (I);
+               Heap.Min.Left  := Heap.Min;
+               Heap.Min.Right := Heap.Min;
+               Min_Key        := Key (Heap.Min.Element);
+            else
+               Insert_Into_Root_List (Heap, A (I));
+               if Key (A (I).Element) < Min_Key then
+                  Heap.Min := A (I);
+                  Min_Key := Key (A (I).Element);
+               end if;
+            end if;
+         end if;
+      end loop;
+   end Consolidate;
+
+   procedure Copy_Node (Old_Obj : in Node_Access; New_Obj : in out Heap_Type)
+   is
+      Child : Node_Access;
+   begin
+      if Old_Obj = null then
+         return;
+      end if;
+
+      if Old_Obj.Child /= null then
+         Child := Old_Obj.Child;
+
+         loop
+            Add (New_Obj, Child.Element);
+            Child := Child.Right;
+            exit when Child = Old_Obj.Child;
+         end loop;
+      end if;
+
+      Add (New_Obj, Old_Obj.Element);
+   end Copy_Node;
+
+   procedure Free is new Ada.Unchecked_Deallocation (Node, Node_Access);
+
+   procedure Free_Node (Item : in out Node_Access)
+   is
+      Child : Node_Access;
+      Temp  : Node_Access;
+   begin
+      if Item = null then
+         return;
+      end if;
+
+      --  Parent has already been free'd
+      --  Siblings are freed by caller
+
+      --  Free children
+      if Item.Child /= null then
+         Child := Item.Child;
+
+         loop
+            Temp  := Child;
+            Child := Child.Right;
+            Free_Node (Temp);
+            exit when Child = Item.Child;
+         end loop;
+      end if;
+      Free (Item);
+   end Free_Node;
+
+   procedure Insert_Into_Root_List (Heap : in out Heap_Type; X : in 
Node_Access)
+   is begin
+      --  match [1] fig 19.3
+      X.Right             := Heap.Min;
+      X.Left              := Heap.Min.Left;
+      Heap.Min.Left.Right := X;
+      Heap.Min.Left       := X;
+   end Insert_Into_Root_List;
+
+   procedure Link (Y, X : in Node_Access)
+   is begin
+      --  [1] 19.2 FIB-HEAP-LINK
+      Remove_From_List (Y);
+      Y.Parent := X;
+      X.Degree := X.Degree + 1;
+      if X.Child = null then
+         X.Child := Y;
+         Y.Right := Y;
+         Y.Left  := Y;
+      else
+         --  Insert Y into X child list
+         Y.Right            := X.Child;
+         Y.Left             := X.Child.Left;
+         X.Child.Left.Right := Y;
+         X.Child.Left       := Y;
+      end if;
+      Y.Mark := False;
+   end Link;
+
+   procedure Remove_From_List (X : in Node_Access)
+   is begin
+      X.Left.Right := X.Right;
+      X.Right.Left := X.Left;
+   end Remove_From_List;
+
+   procedure Swap (A, B : in out Node_Access)
+   is
+      C : constant Node_Access := A;
+   begin
+      A := B;
+      B := C;
+   end Swap;
+
+   ----------
+   --  Visible operations
+
+   overriding
+   procedure Initialize (Object : in out Heap_Type)
+   is begin
+      --  Min is null by default.
+      Object.Count := 0;
+   end Initialize;
+
+   overriding
+   procedure Finalize (Object : in out Heap_Type)
+   is
+      Next : Node_Access := Object.Min;
+      Temp : Node_Access;
+   begin
+      if Next = null then
+         return;
+      end if;
+
+      loop
+         Temp := Next;
+         Next := Next.Right;
+         Free_Node (Temp);
+         exit when Next = Object.Min;
+      end loop;
+      Object.Min   := null;
+      Object.Count := 0;
+   end Finalize;
+
+   overriding
+   procedure Adjust (Object : in out Heap_Type)
+   is
+      Old_Obj : Node_Access := Object.Min;
+      Last : constant Node_Access := Old_Obj;
+   begin
+      if Old_Obj = null then
+         return;
+      end if;
+
+      Object.Min := null;
+      Object.Count := 0;
+
+      loop
+         Copy_Node (Old_Obj, Object);
+         Old_Obj := Old_Obj.Right;
+         exit when Old_Obj = Last;
+      end loop;
+   end Adjust;
+
+   procedure Clear (Heap : in out Heap_Type)
+   is begin
+      Finalize (Heap);
+   end Clear;
+
+   function Count (Heap : in Heap_Type) return Base_Peek_Type
+   is begin
+      return Heap.Count;
+   end Count;
+
+   function Remove (Heap : in out Heap_Type) return Element_Type
+   is
+      Z           : Node_Access := Heap.Min;
+      Child, Temp : Node_Access;
+   begin
+      if Heap.Count = 0 then
+         raise Container_Empty;
+      end if;
+
+      --  [1] 19.2 FIB-HEAP-EXTRACT-MIN
+      Child := Z.Child;
+      for I in 1 .. Z.Degree loop
+         Temp        := Child;
+         Child       := Child.Right;
+         Temp.Parent := null;
+         Insert_Into_Root_List (Heap, Temp);
+      end loop;
+
+      Remove_From_List (Z);
+
+      if Z.Right = Z then
+         Heap.Min := null;
+      else
+         Heap.Min := Z.Right;
+         Consolidate (Heap);
+      end if;
+      Heap.Count := Heap.Count - 1;
+
+      return Result : constant Element_Type := Z.Element do
+         Free (Z);
+      end return;
+   end Remove;
+
+   function Min_Key (Heap : in out Heap_Type) return Key_Type
+   is begin
+      return Key (Heap.Min.Element);
+   end Min_Key;
+
+   procedure Drop (Heap : in out Heap_Type)
+   is
+      Junk : Element_Type := Remove (Heap);
+      pragma Unreferenced (Junk);
+   begin
+      null;
+   end Drop;
+
+   procedure Add (Heap : in out Heap_Type; Item : in Element_Type)
+   is
+      X : constant Node_Access := Add (Heap, Item);
+      pragma Unreferenced (X);
+   begin
+      null;
+   end Add;
+
+   function Add (Heap : in out Heap_Type; Item : in Element_Type) return 
Element_Access
+   is
+      X : constant Node_Access := Add (Heap, Item);
+   begin
+      return X.all.Element'Access;
+   end Add;
+
+   function Peek (Heap : in Heap_Type) return Constant_Reference_Type
+   is begin
+      return (Element => Heap.Min.all.Element'Access);
+   end Peek;
+
+end SAL.Gen_Unbounded_Definite_Min_Heaps_Fibonacci;
diff --git a/sal-gen_unbounded_definite_min_heaps_fibonacci.ads 
b/sal-gen_unbounded_definite_min_heaps_fibonacci.ads
new file mode 100644
index 0000000..381bd35
--- /dev/null
+++ b/sal-gen_unbounded_definite_min_heaps_fibonacci.ads
@@ -0,0 +1,114 @@
+--  Abstract:
+--
+--  An unbounded minimum Fibonacci heap of definite non-limited elements.
+--
+--  References:
+--
+--  [1] Introduction to Algorithms, Third Edition. Thomas H. Cormen,
+--  Charles E. Leiserson, Ronald L. Rivest, Clifford Stein. Chapter 19.
+--
+--  Copyright (C) 2017, 2018 Stephen Leake.  All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Finalization;
+generic
+   type Element_Type is private;
+   type Element_Access is access all Element_Type;
+   type Key_Type is private;
+   with function Key (Item : in Element_Type) return Key_Type;
+   with procedure Set_Key (Item : in out Element_Type; Key : in Key_Type);
+   pragma Unreferenced (Set_Key); -- needed for Decrease_Key
+   with function "<" (Left, Right : in Key_Type) return Boolean is <>;
+package SAL.Gen_Unbounded_Definite_Min_Heaps_Fibonacci is
+
+   type Heap_Type is new Ada.Finalization.Controlled with private;
+
+   Empty_Heap : constant Heap_Type;
+
+   overriding
+   procedure Initialize (Object : in out Heap_Type);
+
+   overriding
+   procedure Finalize (Object : in out Heap_Type);
+
+   overriding
+   procedure Adjust (Object : in out Heap_Type);
+
+   procedure Clear (Heap : in out Heap_Type);
+   --  Empty Heap.
+
+   function Count (Heap : in Heap_Type) return Base_Peek_Type;
+   --  Return count of elements in Heap.
+
+   function Remove (Heap : in out Heap_Type) return Element_Type;
+   --  Remove minimum element in Heap, return it.
+
+   function Min_Key (Heap : in out Heap_Type) return Key_Type;
+   --  Return a copy of the minimum key value.
+
+   function Get (Heap : in out Heap_Type) return Element_Type renames Remove;
+
+   procedure Drop (Heap : in out Heap_Type);
+   --  Remove minimum element in Heap, discard it.
+
+   procedure Add (Heap : in out Heap_Type; Item : in Element_Type);
+   --  Add Item to Heap.
+
+   procedure Insert (Heap : in out Heap_Type; Item : in Element_Type) renames 
Add;
+
+   function Add (Heap : in out Heap_Type; Item : in Element_Type) return 
Element_Access;
+   --  Add Item to Heap, return a pointer to it. This avoids extra
+   --  copying of Item.
+   --
+   --  Result is valid at least until next Get.
+
+   --  Despite being called a "mergeable heap" in [1], there is no
+   --  algorithm for merging two Fibonacci heaps. And the naive method of
+   --  simply splicing the root lists apparently breaks the consolidate
+   --  algorithm; it assumes there can only be one tree of each degree >
+   --  0.
+
+   --  procedure Increase_Key (Heap : in out Heap_Type; index : in index_type; 
Item : in Element_Type);
+   --  IMPROVEME: implement. need Index (heap, Key), or Add return index.
+
+   type Constant_Reference_Type (Element : not null access constant 
Element_Type) is null record
+   with Implicit_Dereference => Element;
+
+   function Peek (Heap : in Heap_Type) return Constant_Reference_Type;
+   --  Return a constant reference to the min element.
+
+private
+
+   type Node;
+   type Node_Access is access Node;
+
+   type Node is record
+      Element : aliased Element_Type;
+      Parent  : Node_Access;
+      Child   : Node_Access;
+      Left    : Node_Access;
+      Right   : Node_Access;
+      Degree  : Natural;
+      Mark    : Boolean;
+   end record;
+
+   type Heap_Type is new Ada.Finalization.Controlled with record
+      Min   : Node_Access;
+      Count : Base_Peek_Type;
+   end record;
+
+   Empty_Heap : constant Heap_Type := (Ada.Finalization.Controlled with Min => 
null, Count => 0);
+
+end SAL.Gen_Unbounded_Definite_Min_Heaps_Fibonacci;
diff --git a/sal-gen_unbounded_definite_queues-gen_image_aux.adb 
b/sal-gen_unbounded_definite_queues-gen_image_aux.adb
new file mode 100644
index 0000000..233aa1b
--- /dev/null
+++ b/sal-gen_unbounded_definite_queues-gen_image_aux.adb
@@ -0,0 +1,35 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Strings.Unbounded;
+function SAL.Gen_Unbounded_Definite_Queues.Gen_Image_Aux (Item : in Queue; Aux 
: in Aux_Data) return String
+is
+   use Ada.Strings.Unbounded;
+   Result : Unbounded_String        := To_Unbounded_String ("(");
+   Last   : constant Base_Peek_Type := Item.Count;
+begin
+   for I in 1 .. Last loop
+      Result := Result & Element_Image (Item.Peek (I), Aux);
+      if I /= Last then
+         Result := Result & ", ";
+      end if;
+   end loop;
+   Result := Result & ")";
+   return To_String (Result);
+end SAL.Gen_Unbounded_Definite_Queues.Gen_Image_Aux;
diff --git a/sal-gen_unbounded_definite_queues-gen_image_aux.ads 
b/sal-gen_unbounded_definite_queues-gen_image_aux.ads
new file mode 100644
index 0000000..6ea7c8f
--- /dev/null
+++ b/sal-gen_unbounded_definite_queues-gen_image_aux.ads
@@ -0,0 +1,23 @@
+--  Abstract :
+--
+--  Image with auxiliary data for instantiations of parent.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+generic
+   type Aux_Data (<>) is private;
+   with function Element_Image (Item : in Element_Type; Aux : in Aux_Data) 
return String;
+function SAL.Gen_Unbounded_Definite_Queues.Gen_Image_Aux (Item : in Queue; Aux 
: in Aux_Data) return String;
diff --git a/sal-gen_unbounded_definite_queues.adb 
b/sal-gen_unbounded_definite_queues.adb
new file mode 100644
index 0000000..f71fbe5
--- /dev/null
+++ b/sal-gen_unbounded_definite_queues.adb
@@ -0,0 +1,97 @@
+--  Abstract:
+--
+--  See spec.
+--
+--  Copyright (C) 2017, 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+package body SAL.Gen_Unbounded_Definite_Queues is
+
+   procedure Clear (Queue : in out Pkg.Queue)
+   is begin
+      Queue.Data.Clear;
+   end Clear;
+
+   function Count (Queue : in Pkg.Queue) return Base_Peek_Type
+   is begin
+      return Base_Peek_Type (Queue.Data.Length);
+   end Count;
+
+   function Is_Empty (Queue : in Pkg.Queue) return Boolean
+   is
+      use all type Ada.Containers.Count_Type;
+   begin
+      return Queue.Data.Length = 0;
+   end Is_Empty;
+
+   function Remove (Queue : in out Pkg.Queue) return Element_Type
+   is
+      use Element_Lists;
+   begin
+      return A : constant Element_Type := Element (Queue.Data.First) do
+         Queue.Data.Delete_First;
+      end return;
+   end Remove;
+
+   procedure Drop (Queue : in out Pkg.Queue)
+   is begin
+      Queue.Data.Delete_First;
+   end Drop;
+
+   function Peek (Queue : in Pkg.Queue; N : Peek_Type := 1) return 
Constant_Reference_Type
+   is
+      use Ada.Containers;
+      use Element_Lists;
+      I : Cursor := Queue.Data.First;
+   begin
+      if Count_Type (N) > Queue.Data.Length then
+         raise Parameter_Error;
+      end if;
+
+      for K in 2 .. N loop
+         Next (I);
+      end loop;
+
+      return (Element => Element_Lists.Constant_Reference (Queue.Data, 
I).Element, Dummy => 1);
+   end Peek;
+
+   function Variable_Peek (Queue : in out Pkg.Queue; N : Peek_Type := 1) 
return Variable_Reference_Type
+   is
+      use Ada.Containers;
+      use Element_Lists;
+      I : Cursor := Queue.Data.First;
+   begin
+      if Count_Type (N) > Queue.Data.Length then
+         raise Parameter_Error;
+      end if;
+
+      for K in 2 .. N loop
+         Next (I);
+      end loop;
+
+      return (Element => Element_Lists.Reference (Queue.Data, I).Element, 
Dummy => 1);
+   end Variable_Peek;
+
+   procedure Add (Queue : in out Pkg.Queue; Item : in Element_Type)
+   is begin
+      Queue.Data.Append (Item);
+   end Add;
+
+   procedure Add_To_Head (Queue : in out Pkg.Queue; Item : in Element_Type)
+   is begin
+      Queue.Data.Prepend (Item);
+   end Add_To_Head;
+
+end SAL.Gen_Unbounded_Definite_Queues;
diff --git a/sal-gen_unbounded_definite_queues.ads 
b/sal-gen_unbounded_definite_queues.ads
new file mode 100644
index 0000000..d891f9d
--- /dev/null
+++ b/sal-gen_unbounded_definite_queues.ads
@@ -0,0 +1,108 @@
+--  Abstract:
+--
+--  An unbounded queue of definite non-limited elements.
+--
+--  Copyright (C) 2017, 2018 Stephen Leake.  All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Containers.Doubly_Linked_Lists;
+generic
+   type Element_Type is private;
+package SAL.Gen_Unbounded_Definite_Queues is
+
+   package Pkg renames SAL.Gen_Unbounded_Definite_Queues;
+
+   type Queue is tagged private;
+
+   Empty_Queue : constant Queue;
+
+   procedure Clear (Queue : in out Pkg.Queue);
+   --  Empty Queue.
+
+   function Count (Queue : in Pkg.Queue) return Base_Peek_Type;
+   --  Return count of items in the Queue
+
+   function Length (Queue : in Pkg.Queue) return Base_Peek_Type renames Count;
+
+   function Is_Empty (Queue : in Pkg.Queue) return Boolean;
+   --  Return true if no items are in Pkg.Queue.
+
+   function Is_Full (Queue : in Pkg.Queue) return Boolean is (False);
+   --  Return true if Queue is full.
+
+   function Remove (Queue : in out Pkg.Queue) return Element_Type;
+   --  Remove head/front item from Queue, return it.
+   --
+   --  Raise Container_Empty if Is_Empty.
+
+   function Get (Queue : in out Pkg.Queue) return Element_Type renames Remove;
+
+   procedure Drop (Queue : in out Pkg.Queue);
+   --  Remove head/front item from Queue, discard it.
+   --
+   --  Raise Container_Empty if Is_Empty.
+
+   type Constant_Reference_Type (Element : not null access constant 
Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   function Peek (Queue : in Pkg.Queue; N : Peek_Type := 1) return 
Constant_Reference_Type;
+   --  Return a constant reference to a queue item. N = 1 is the queue
+   --  head.
+   --
+   --  Raise Parameter_Error if N > Count
+
+   type Variable_Reference_Type (Element : not null access Element_Type) is 
private
+   with Implicit_Dereference => Element;
+
+   function Variable_Peek (Queue : in out Pkg.Queue; N : Peek_Type := 1) 
return Variable_Reference_Type;
+   --  Return a variable reference to a queue item. N = 1 is the queue
+   --  head.
+   --
+   --  Raises Parameter_Error if N > Count
+
+   procedure Add (Queue : in out Pkg.Queue; Item : in Element_Type);
+   --  Add Element to the tail/back of Queue.
+
+   procedure Put (Queue : in out Pkg.Queue; Item : in Element_Type) renames 
Add;
+
+   procedure Add_To_Head (Queue : in out Pkg.Queue; Item : in Element_Type);
+   --  Add Element to the head/front of Queue.
+
+private
+
+   package Element_Lists is new Ada.Containers.Doubly_Linked_Lists 
(Element_Type);
+
+   --  We don't provide cursors or write access to queue elements, so we
+   --  don't need any tampering checks.
+
+   type Queue is tagged record
+      Data : Element_Lists.List;
+      --  Add at Tail/Back = Last, remove at Head/Front = First.
+   end record;
+
+   type Constant_Reference_Type (Element : not null access constant 
Element_Type) is
+   record
+      Dummy : Integer := raise Program_Error with "uninitialized reference";
+   end record;
+
+   type Variable_Reference_Type (Element : not null access Element_Type) is
+   record
+      Dummy : Integer := raise Program_Error with "uninitialized reference";
+   end record;
+
+   Empty_Queue : constant Queue := (Data => Element_Lists.Empty_List);
+
+end SAL.Gen_Unbounded_Definite_Queues;
diff --git a/sal-gen_unbounded_definite_red_black_trees.adb 
b/sal-gen_unbounded_definite_red_black_trees.adb
new file mode 100644
index 0000000..2d84c57
--- /dev/null
+++ b/sal-gen_unbounded_definite_red_black_trees.adb
@@ -0,0 +1,863 @@
+--  Abstract :
+--
+--  Generic unbounded red-black tree with definite elements.
+--
+--  Copyright (C) 2017, 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+package body SAL.Gen_Unbounded_Definite_Red_Black_Trees is
+
+   --  Local declarations (alphabetical order)
+
+   function Count_Tree (Item : in Node_Access; Nil : in Node_Access) return 
Ada.Containers.Count_Type
+   with Pre => Nil /= null;
+
+   procedure Delete_Fixup (T : in out Tree; X : in out Node_Access);
+
+   function Find (Root : in Node_Access; Key : in Key_Type; Nil : in 
Node_Access) return Node_Access
+   with Pre => Nil /= null;
+
+   procedure Left_Rotate (Tree : in out Pkg.Tree; X : in Node_Access)
+   with Pre => X /= null;
+
+   procedure Right_Rotate (Tree : in out Pkg.Tree; X : in Node_Access)
+   with Pre => X /= null;
+
+   procedure Transplant (T : in out Pkg.Tree; U, V : in Node_Access)
+   with Pre => U /= null and T.Root /= null;
+
+   ----------
+   --  local bodies (alphabetical order)
+
+   function Count_Tree (Item : in Node_Access; Nil : in Node_Access) return 
Ada.Containers.Count_Type
+   is
+      use all type Ada.Containers.Count_Type;
+      Result : Ada.Containers.Count_Type := 0;
+   begin
+      if Item.Left /= Nil then
+         Result := Result + Count_Tree (Item.Left, Nil);
+      end if;
+
+      if Item.Right /= Nil then
+         Result := Result + Count_Tree (Item.Right, Nil);
+      end if;
+
+      return Result + 1;
+   end Count_Tree;
+
+   procedure Delete_Fixup (T : in out Tree; X : in out Node_Access)
+   is
+      W : Node_Access;
+   begin
+      --  [1] 13.3 RB-Delete-Fixup
+      --  X is either "doubly black" or "red and black"
+      --  X.Parent is set, even if X = Nil.
+      --  In all cases, Nil.Left = null.Right = null.
+
+      while X /= T.Root and X.Color = Black loop
+         if X = X.Parent.Left then
+            W := X.Parent.Right;
+            if W.Color = Red then
+               W.Color        := Black;
+               X.Parent.Color := Red;
+               Left_Rotate (T, X.Parent);
+               W              := X.Parent.Right;
+            end if;
+
+            if W.Left.Color = Black and W.Right.Color = Black then
+               W.Color := Red;
+               X := X.Parent;
+            else
+               if W.Right.Color = Black then
+                  W.Left.Color := Black;
+                  W.Color      := Red;
+                  Right_Rotate (T, W);
+                  W            := X.Parent.Right;
+               end if;
+               W.Color        := X.Parent.Color;
+               X.Parent.Color := Black;
+               W.Right.Color  := Black;
+               Left_Rotate (T, X.Parent);
+               X              := T.Root;
+            end if;
+         else
+            W := X.Parent.Left;
+            if W.Color = Red then
+               W.Color        := Black;
+               X.Parent.Color := Red;
+               Right_Rotate (T, X.Parent);
+               W              := X.Parent.Left;
+            end if;
+
+            if W.Right.Color = Black and W.Left.Color = Black then
+               W.Color := Red;
+               X       := X.Parent;
+            else
+               if W.Left.Color = Black then
+                  W.Right.Color := Black;
+                  W.Color       := Red;
+                  Left_Rotate (T, W);
+                  W             := X.Parent.Left;
+               end if;
+               W.Color        := X.Parent.Color;
+               X.Parent.Color := Black;
+               W.Left.Color   := Black;
+               Right_Rotate (T, X.Parent);
+               X              := T.Root;
+            end if;
+         end if;
+      end loop;
+      X.Color := Black;
+   end Delete_Fixup;
+
+   function Find (Root : in Node_Access; Key : in Key_Type; Nil : in 
Node_Access) return Node_Access
+   is
+      Node : Node_Access := Root;
+   begin
+      while Node /= Nil loop
+         case Key_Compare (Key, Pkg.Key (Node.Element)) is
+         when Equal =>
+            return Node;
+         when Less =>
+            Node := Node.Left;
+         when Greater =>
+            Node := Node.Right;
+         end case;
+      end loop;
+      return null;
+   end Find;
+
+   procedure Free_Tree (Item : in out Node_Access; Nil : in Node_Access)
+   is begin
+      if Item = Nil or Item = null then
+         raise Programmer_Error;
+      end if;
+
+      if Item.Left /= Nil then
+         Free_Tree (Item.Left, Nil);
+      end if;
+
+      if Item.Right /= Nil then
+         Free_Tree (Item.Right, Nil);
+      end if;
+
+      Free (Item);
+   end Free_Tree;
+
+   procedure Insert_Fixup (Tree : in out Pkg.Tree; Z : in out Node_Access)
+   is
+      --  [1] 13.3 RB-Insert-Fixup (T, z)
+      Nil : Node_Access renames Tree.Nil;
+      Y   : Node_Access;
+   begin
+      while Z.Parent /= Nil and then Z.Parent.Color = Red loop
+         if Z.Parent = Z.Parent.Parent.Left then
+            Y := Z.Parent.Parent.Right;
+            if Y /= Nil and then Y.Color = Red then
+               Z.Parent.Color        := Black;
+               Y.Color               := Black;
+               Z.Parent.Parent.Color := Red;
+               Z                     := Z.Parent.Parent;
+            else
+               if Z = Z.Parent.Right then
+                  Z := Z.Parent;
+                  Left_Rotate (Tree, Z);
+               end if;
+               Z.Parent.Color        := Black;
+               Z.Parent.Parent.Color := Red;
+               Right_Rotate (Tree, Z.Parent.Parent);
+            end if;
+         else
+            Y := Z.Parent.Parent.Left;
+            if Y /= Nil and then Y.Color = Red then
+               Z.Parent.Color        := Black;
+               Y.Color               := Black;
+               Z.Parent.Parent.Color := Red;
+               Z                     := Z.Parent.Parent;
+            else
+               if Z = Z.Parent.Left then
+                  Z := Z.Parent;
+                  Right_Rotate (Tree, Z);
+               end if;
+               Z.Parent.Color        := Black;
+               Z.Parent.Parent.Color := Red;
+               Left_Rotate (Tree, Z.Parent.Parent);
+            end if;
+         end if;
+      end loop;
+      Tree.Root.Color := Black;
+   end Insert_Fixup;
+
+   procedure Left_Rotate (Tree : in out Pkg.Tree; X : in Node_Access)
+   is
+      --  [1] 13.2 Left-Rotate (T, x)
+      Nil : Node_Access renames Tree.Nil;
+      Y   : constant Node_Access := X.Right;
+   begin
+      X.Right := Y.Left;
+      if Y.Left /= Nil then
+         Y.Left.Parent := X;
+      end if;
+      Y.Parent := X.Parent;
+      if X.Parent = Nil then
+         Tree.Root := Y;
+      elsif X = X.Parent.Left then
+         X.Parent.Left := Y;
+      else
+         X.Parent.Right := Y;
+      end if;
+      Y.Left   := X;
+      X.Parent := Y;
+   end Left_Rotate;
+
+   function Minimum (Node : in Node_Access; Nil : in Node_Access) return 
Node_Access
+   is begin
+      return Result : Node_Access := Node
+      do
+         while Result.Left /= Nil loop
+            Result := Result.Left;
+         end loop;
+      end return;
+   end Minimum;
+
+   procedure Right_Rotate (Tree : in out Pkg.Tree; X : in Node_Access)
+   is
+      --  [1] 13.2 Right-Rotate (T, x)
+      Nil : Node_Access renames Tree.Nil;
+      Y   : constant Node_Access := X.Left;
+   begin
+      X.Left := Y.Right;
+      if Y.Right /= Nil then
+         Y.Right.Parent := X;
+      end if;
+      Y.Parent := X.Parent;
+      if X.Parent = Nil then
+         Tree.Root := Y;
+      elsif X = X.Parent.Right then
+         X.Parent.Right := Y;
+      else
+         X.Parent.Left := Y;
+      end if;
+      Y.Right  := X;
+      X.Parent := Y;
+   end Right_Rotate;
+
+   procedure Transplant (T : in out Pkg.Tree; U, V : in Node_Access)
+   is
+      Nil : Node_Access renames T.Nil;
+   begin
+      --  [1] 13.4 RB-Transplant, 12.3 Transplant
+
+      if U.Parent = Nil then
+         T.Root := V;
+      elsif U = U.Parent.Left then
+         U.Parent.Left := V;
+      else
+         U.Parent.Right := V;
+      end if;
+      V.Parent := U.Parent;
+   end Transplant;
+
+   ----------
+   --  Public subprograms, spec order
+
+   overriding procedure Finalize (Object : in out Tree)
+   is begin
+      if Object.Root /= null then
+         if Object.Root = Object.Nil then
+            Free (Object.Nil);
+            Object.Root := null;
+         else
+            Free_Tree (Object.Root, Object.Nil);
+            Free (Object.Nil);
+         end if;
+      end if;
+   end Finalize;
+
+   overriding procedure Initialize (Object : in out Tree)
+   is begin
+      Object.Nil       := new Node;
+      Object.Nil.Color := Black;
+      Object.Root      := Object.Nil;
+   end Initialize;
+
+   function Has_Element (Cursor : in Pkg.Cursor) return Boolean
+   is begin
+      return Cursor.Node /= null;
+   end Has_Element;
+
+   function Constant_Ref
+     (Container : aliased in Tree;
+      Position  :         in Cursor)
+     return Constant_Ref_Type
+   is
+      pragma Unreferenced (Container);
+   begin
+      return (Element => Position.Node.all.Element'Access);
+   end Constant_Ref;
+
+   function Constant_Ref
+     (Container : aliased in Tree;
+      Key       :         in Key_Type)
+     return Constant_Ref_Type
+   is
+      Node : constant Node_Access := Find (Container.Root, Key, Container.Nil);
+   begin
+      if Node = null then
+         raise Not_Found;
+      else
+         return (Element => Node.all.Element'Access);
+      end if;
+   end Constant_Ref;
+
+   function Variable_Ref
+     (Container : aliased in Tree;
+      Position  :         in Cursor)
+     return Variable_Ref_Type
+   is
+      pragma Unreferenced (Container);
+   begin
+      return (Element => Position.Node.all.Element'Access);
+   end Variable_Ref;
+
+   function Variable_Ref
+     (Container : aliased in Tree;
+      Key       :         in Key_Type)
+     return Variable_Ref_Type
+   is
+      Node : constant Node_Access := Find (Container.Root, Key, Container.Nil);
+   begin
+      if Node = null then
+         raise Not_Found;
+      else
+         return (Element => Node.all.Element'Access);
+      end if;
+   end Variable_Ref;
+
+   function Iterate (Tree : in Pkg.Tree'Class) return Iterator
+   is begin
+      return (Tree.Root, Tree.Nil);
+   end Iterate;
+
+   overriding function First (Iterator : in Pkg.Iterator) return Cursor
+   is
+      Nil  : Node_Access renames Iterator.Nil;
+      Node : Node_Access := Iterator.Root;
+   begin
+      if Node = Nil then
+         return
+           (Node       => null,
+            Direction  => Unknown,
+            Left_Done  => True,
+            Right_Done => True);
+      else
+         loop
+            exit when Node.Left = Nil;
+            Node := Node.Left;
+         end loop;
+
+         return
+           (Node       => Node,
+            Direction  => Ascending,
+            Left_Done  => True,
+            Right_Done => False);
+      end if;
+
+   end First;
+
+   overriding function Next (Iterator : in Pkg.Iterator; Position : in Cursor) 
return Cursor
+   is
+      Nil : Node_Access renames Iterator.Nil;
+   begin
+      if Position.Direction /= Ascending then
+         raise Programmer_Error;
+      end if;
+
+      if Position.Node = null then
+         return
+           (Node       => null,
+            Direction  => Unknown,
+            Left_Done  => True,
+            Right_Done => True);
+
+      elsif Position.Left_Done or Position.Node.Left = Nil then
+         if Position.Right_Done or Position.Node.Right = Nil then
+            if Position.Node.Parent = Nil then
+               return
+                 (Node       => null,
+                  Direction  => Unknown,
+                  Left_Done  => True,
+                  Right_Done => True);
+            else
+               declare
+                  Node : constant Node_Access := Position.Node.Parent;
+                  Temp : constant Cursor      :=
+                    (Node       => Node,
+                     Direction  => Ascending,
+                     Left_Done  => Node.Right = Position.Node or Node.Left = 
Position.Node,
+                     Right_Done => Node.Right = Position.Node);
+               begin
+                  if Temp.Right_Done then
+                     return Next (Iterator, Temp);
+                  else
+                     return Temp;
+                  end if;
+               end;
+            end if;
+         else
+            declare
+               Node : constant Node_Access := Position.Node.Right;
+               Temp : constant Cursor      :=
+                 (Node       => Node,
+                  Direction  => Ascending,
+                  Left_Done  => Node.Left = Nil,
+                  Right_Done => False);
+            begin
+               if Temp.Left_Done then
+                  return Temp;
+               else
+                  return Next (Iterator, Temp);
+               end if;
+            end;
+         end if;
+      else
+         declare
+            Node : constant Node_Access := Position.Node.Left;
+            Temp : constant Cursor      :=
+              (Node       => Node,
+               Direction  => Ascending,
+               Left_Done  => Node.Left = Nil,
+               Right_Done => False);
+         begin
+            if Temp.Left_Done then
+               return Temp;
+            else
+               return Next (Iterator, Temp);
+            end if;
+         end;
+      end if;
+   end Next;
+
+   overriding function Last (Iterator : in Pkg.Iterator) return Cursor
+   is
+      Nil  : Node_Access renames Iterator.Nil;
+      Node : Node_Access := Iterator.Root;
+   begin
+      if Node = Nil then
+         return
+           (Node       => null,
+            Direction  => Unknown,
+            Left_Done  => True,
+            Right_Done => True);
+      else
+         loop
+            exit when Node.Right = Nil;
+            Node := Node.Right;
+         end loop;
+         return
+           (Node       => Node,
+            Direction  => Descending,
+            Right_Done => True,
+            Left_Done  => False);
+      end if;
+   end Last;
+
+   overriding function Previous (Iterator : in Pkg.Iterator; Position : in 
Cursor) return Cursor
+   is
+      Nil : Node_Access renames Iterator.Nil;
+   begin
+      if Position.Direction /= Descending then
+         raise Programmer_Error;
+      end if;
+
+      if Position.Node = null then
+         return
+           (Node       => null,
+            Direction  => Unknown,
+            Left_Done  => True,
+            Right_Done => True);
+
+      elsif Position.Right_Done or Position.Node.Right = Nil then
+         if Position.Left_Done or Position.Node.Left = Nil then
+            if Position.Node.Parent = Nil then
+               return
+                 (Node       => null,
+                  Direction  => Unknown,
+                  Left_Done  => True,
+                  Right_Done => True);
+            else
+               declare
+                  Node : constant Node_Access := Position.Node.Parent;
+                  Temp : constant Cursor      :=
+                    (Node       => Node,
+                     Direction  => Descending,
+                     Right_Done => Node.Left = Position.Node or Node.Right = 
Position.Node,
+                     Left_Done  => Node.Left = Position.Node);
+               begin
+                  if Temp.Left_Done then
+                     return Previous (Iterator, Temp);
+                  else
+                     return Temp;
+                  end if;
+               end;
+            end if;
+         else
+            declare
+               Node : constant Node_Access := Position.Node.Left;
+               Temp : constant Cursor      :=
+                 (Node       => Node,
+                  Direction  => Descending,
+                  Right_Done => Node.Right = Nil,
+                  Left_Done  => False);
+            begin
+               if Temp.Right_Done then
+                  return Temp;
+               else
+                  return Previous (Iterator, Temp);
+               end if;
+            end;
+         end if;
+      else
+         declare
+            Node : constant Node_Access := Position.Node.Right;
+            Temp : constant Cursor      :=
+              (Node       => Node,
+               Direction  => Descending,
+               Right_Done => Node.Right = Nil,
+               Left_Done  => False);
+         begin
+            if Temp.Right_Done then
+               return Temp;
+            else
+               return Previous (Iterator, Temp);
+            end if;
+         end;
+      end if;
+   end Previous;
+
+   function Previous (Iterator : in Pkg.Iterator; Key : in Key_Type) return 
Cursor
+   is
+      Nil  : Node_Access renames Iterator.Nil;
+      Node : Node_Access := Iterator.Root;
+   begin
+      while Node /= Nil loop
+         declare
+            Current_Key : Key_Type renames Pkg.Key (Node.Element);
+         begin
+            case Key_Compare (Key, Current_Key) is
+            when Equal =>
+                  return Previous (Iterator, (Node, Descending, Right_Done => 
True, Left_Done => False));
+
+            when Less =>
+               if Node.Left = Nil then
+                  return Previous (Iterator, (Node, Descending, Right_Done => 
True, Left_Done => True));
+               else
+                  Node := Node.Left;
+               end if;
+
+            when Greater =>
+               if Node.Right = Nil then
+                  return (Node, Descending, Right_Done => True, Left_Done => 
False);
+               else
+                  Node := Node.Right;
+               end if;
+            end case;
+         end;
+      end loop;
+
+      return
+        (Node       => null,
+         Direction  => Unknown,
+         Left_Done  => True,
+         Right_Done => True);
+   end Previous;
+
+   function Find
+     (Iterator  : in Pkg.Iterator;
+      Key       : in Key_Type;
+      Direction : in Direction_Type := Ascending)
+     return Cursor
+   is
+      Nil  : Node_Access renames Iterator.Nil;
+      Node : constant Node_Access := Find (Iterator.Root, Key, Nil);
+   begin
+      if Node = null then
+         return
+           (Node       => null,
+            Direction  => Unknown,
+            Left_Done  => True,
+            Right_Done => True);
+      else
+         return
+           (Node       => Node,
+            Direction  => Direction,
+            Left_Done  =>
+              (case Direction is
+               when Ascending | Unknown => True,
+               when Descending => Node.Left = Nil),
+            Right_Done =>
+              (case Direction is
+               when Ascending => Node.Right = Nil,
+               when Descending | Unknown => True));
+      end if;
+   end Find;
+
+   function Find_In_Range
+     (Iterator    : in Pkg.Iterator;
+      Direction   : in Known_Direction_Type;
+      First, Last : in Key_Type)
+     return Cursor
+   is
+      Nil       : Node_Access renames Iterator.Nil;
+      Node      : Node_Access := Iterator.Root;
+      Candidate : Node_Access := null; -- best result found so far
+   begin
+      while Node /= Nil loop
+         declare
+            Current_Key : Key_Type renames Key (Node.Element);
+         begin
+            case Direction is
+            when Ascending =>
+               case Key_Compare (First, Current_Key) is
+               when Equal =>
+                     return (Node, Ascending, Right_Done => False, Left_Done 
=> True);
+
+               when Less =>
+                  if Node.Left = Nil then
+                     case Key_Compare (Current_Key, Last) is
+                     when Less | Equal =>
+                        return (Node, Ascending, Right_Done => False, 
Left_Done => True);
+                     when Greater =>
+                        if Candidate = null then
+                           return No_Element;
+                        else
+                           return (Candidate, Ascending, Right_Done => False, 
Left_Done => True);
+                        end if;
+                     end case;
+                  else
+                     case Key_Compare (Last, Current_Key) is
+                     when Greater | Equal =>
+                        Candidate := Node;
+                     when Less =>
+                        null;
+                     end case;
+                     Node := Node.Left;
+                  end if;
+
+               when Greater =>
+                  if Node.Right = Nil then
+                     if Candidate = null then
+                        return No_Element;
+                     else
+                        return (Candidate, Ascending, Right_Done => False, 
Left_Done => True);
+                     end if;
+                  else
+                     Node := Node.Right;
+                  end if;
+               end case;
+
+            when Descending =>
+               if Last = Current_Key then
+                  return (Node, Descending, Right_Done => True, Left_Done => 
False);
+
+               else
+                  case Key_Compare (Last, Current_Key) is
+                  when Greater =>
+                     if Node.Right = Nil then
+                        case Key_Compare (Current_Key, First) is
+                        when Greater | Equal =>
+                           return (Node, Descending, Right_Done => True, 
Left_Done => False);
+                        when Less =>
+                           if Candidate = null then
+                              return No_Element;
+                           else
+                              return (Candidate, Ascending, Right_Done => 
False, Left_Done => True);
+                           end if;
+                        end case;
+                     else
+                        case Key_Compare (First, Current_Key) is
+                        when Less | Equal =>
+                           Candidate := Node;
+                        when Greater =>
+                           null;
+                        end case;
+                        Node := Node.Right;
+                     end if;
+                  when Equal | Less =>
+                     if Node.Left = Nil then
+                        if Candidate = null then
+                           return No_Element;
+                        else
+                           return (Candidate, Ascending, Right_Done => False, 
Left_Done => True);
+                        end if;
+                     else
+                        Node := Node.Left;
+                     end if;
+                  end case;
+               end if;
+            end case;
+         end;
+      end loop;
+
+      return No_Element;
+   end Find_In_Range;
+
+   function Count (Tree : in Pkg.Tree) return Ada.Containers.Count_Type
+   is begin
+      if Tree.Root = Tree.Nil then
+         return 0;
+      else
+         return Count_Tree (Tree.Root, Tree.Nil);
+      end if;
+   end Count;
+
+   function Present (Container : in Tree; Key : in Key_Type) return Boolean
+   is
+      Nil  : Node_Access renames Container.Nil;
+      Node : Node_Access := Container.Root;
+   begin
+      while Node /= Nil loop
+         case Key_Compare (Key, Pkg.Key (Node.Element)) is
+         when Equal =>
+            return True;
+         when Less =>
+            Node := Node.Left;
+         when Greater =>
+            Node := Node.Right;
+         end case;
+      end loop;
+      return False;
+   end Present;
+
+   function Insert (Tree : in out Pkg.Tree; Element : in Element_Type) return 
Cursor
+   is
+      --  [1] 13.3 RB-Insert (T, z)
+      Nil   : Node_Access renames Tree.Nil;
+      Z     : Node_Access       := new Node'(Element, Nil, Nil, Nil, Red);
+      Key_Z : constant Key_Type := Key (Z.Element);
+      Y     : Node_Access       := Nil;
+      X     : Node_Access       := Tree.Root;
+
+      Result      : Node_Access;
+      Compare_Z_Y : Compare_Result;
+   begin
+      Nil.Parent := null;
+      Nil.Left   := null;
+      Nil.Right  := null;
+
+      while X /= Nil loop
+         Y := X;
+         Compare_Z_Y := Key_Compare (Key_Z, Key (X.Element));
+         case Compare_Z_Y is
+         when Less =>
+            X := X.Left;
+         when Equal | Greater =>
+            X := X.Right;
+         end case;
+      end loop;
+
+      Z.Parent := Y;
+      if Y = Nil then
+         Tree.Root := Z;
+      else
+         case Compare_Z_Y is
+         when Less =>
+            Y.Left := Z;
+         when Equal | Greater =>
+            Y.Right := Z;
+         end case;
+      end if;
+
+      Result := Z;
+      if Z = Tree.Root then
+         Z.Color := Black;
+      else
+         Insert_Fixup (Tree, Z);
+      end if;
+
+      return
+        (Node       => Result,
+         Direction  => Unknown,
+         Left_Done  => True,
+         Right_Done => True);
+   end Insert;
+
+   procedure Insert (Tree : in out Pkg.Tree; Element : in Element_Type)
+   is
+      Temp : Cursor := Insert (Tree, Element);
+      pragma Unreferenced (Temp);
+   begin
+      null;
+   end Insert;
+
+   procedure Delete (Tree : in out Pkg.Tree; Position : in out Cursor)
+   is
+      Nil          : Node_Access renames Tree.Nil;
+      T            : Pkg.Tree renames Tree;
+      Z            : constant Node_Access :=
+        (if Position.Node = null then raise Parameter_Error else 
Position.Node);
+      Y            : Node_Access          := Z;
+      Y_Orig_Color : Color                := Y.Color;
+      X            : Node_Access;
+   begin
+      --  Catch logic errors in use of Nil
+      Nil.Parent := null;
+      Nil.Left   := null;
+      Nil.Right  := null;
+
+      --  [1] 13.4 RB-Delete.
+      if Z.Left = Nil then
+         X := Z.Right;
+         Transplant (T, Z, Z.Right);
+
+      elsif Z.Right = Nil then
+         X := Z.Left;
+         Transplant (T, Z, Z.Left);
+
+      else
+         Y            := Minimum (Z.Right, Nil);
+         Y_Orig_Color := Y.Color;
+         X            := Y.Right;
+         if Y.Parent = Z then
+            X.Parent := Y;
+            --  This is already true unless X = Nil, in which case delete_fixup
+            --  needs the info.
+         else
+            Transplant (T, Y, Y.Right);
+            Y.Right := Z.Right;
+
+            Y.Right.Parent := Y;
+            --  This is already true unless Y.Right = Nil, in which case
+            --  delete_fixup needs the info.
+         end if;
+
+         Transplant (T, Z, Y);
+         Y.Left := Z.Left;
+
+         Y.Left.Parent := Y;
+         --  This is already true unless Y.Left = Nil, in which case
+         --  delete_fixup needs the info.
+
+         Y.Color := Z.Color;
+      end if;
+
+      if Y_Orig_Color = Black then
+         Delete_Fixup (T, X);
+      end if;
+
+      Free (Position.Node);
+   end Delete;
+
+end SAL.Gen_Unbounded_Definite_Red_Black_Trees;
diff --git a/sal-gen_unbounded_definite_red_black_trees.ads 
b/sal-gen_unbounded_definite_red_black_trees.ads
new file mode 100644
index 0000000..7096970
--- /dev/null
+++ b/sal-gen_unbounded_definite_red_black_trees.ads
@@ -0,0 +1,181 @@
+--  Abstract :
+--
+--  Generic unbounded red-black tree with definite elements, definite
+--  or indefinite key.
+--
+--  References :
+--
+--  [1] Introduction to Algorithms, Thomas H. Cormen, Charles E.
+--  Leiserson, Ronald L. Rivest, Clifford Stein.
+--
+--  Copyright (C) 2017, 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Finalization;
+with Ada.Iterator_Interfaces;
+with Ada.Unchecked_Deallocation;
+generic
+   type Element_Type is private;
+   type Key_Type (<>) is private;
+   with function Key (Element : in Element_Type) return Key_Type is <>;
+   with function Key_Compare (Left, Right : in Key_Type) return Compare_Result 
is <>;
+package SAL.Gen_Unbounded_Definite_Red_Black_Trees is
+
+   package Pkg renames Gen_Unbounded_Definite_Red_Black_Trees;
+
+   type Tree is new Ada.Finalization.Limited_Controlled with private
+   with
+     Constant_Indexing => Constant_Ref,
+     Variable_Indexing => Variable_Ref,
+     Default_Iterator  => Iterate,
+     Iterator_Element  => Element_Type;
+
+   overriding procedure Finalize (Object : in out Tree);
+   overriding procedure Initialize (Object : in out Tree);
+
+   type Direction_Type is (Ascending, Descending, Unknown);
+   subtype Known_Direction_Type is Direction_Type range Ascending .. 
Descending;
+   --  Direction of Iterators.
+   --  If Ascending, Next may be called.
+   --  If Descending, Previous may be called.
+   --  If Unknown, neither.
+
+   type Cursor is private;
+
+   No_Element : constant Cursor;
+
+   function Has_Element (Cursor : in Pkg.Cursor) return Boolean;
+
+   type Constant_Ref_Type (Element : not null access constant Element_Type) is 
null record
+   with Implicit_Dereference => Element;
+
+   function Constant_Ref
+     (Container : aliased in Tree;
+      Position  :         in Cursor)
+     return Constant_Ref_Type;
+
+   function Constant_Ref
+     (Container : aliased in Tree;
+      Key       :         in Key_Type)
+     return Constant_Ref_Type;
+
+   type Variable_Ref_Type (Element : not null access Element_Type) is null 
record
+   with Implicit_Dereference => Element;
+
+   function Variable_Ref
+     (Container : aliased in Tree;
+      Position  :         in Cursor)
+     return Variable_Ref_Type;
+
+   function Variable_Ref
+     (Container : aliased in Tree;
+      Key       :         in Key_Type)
+     return Variable_Ref_Type;
+   --  Raises Not_Found if Key not found in Container.
+
+   package Iterators is new Ada.Iterator_Interfaces (Cursor, Has_Element);
+
+   type Iterator is new Iterators.Reversible_Iterator with private;
+
+   function Iterate (Tree : in Pkg.Tree'Class) return Iterator;
+
+   overriding function First (Iterator : in Pkg.Iterator) return Cursor;
+   overriding function Next (Iterator : in Pkg.Iterator; Position : in Cursor) 
return Cursor;
+   overriding function Last (Iterator : in Pkg.Iterator) return Cursor;
+   overriding function Previous (Iterator : in Pkg.Iterator; Position : in 
Cursor) return Cursor;
+
+   function Previous (Iterator : in Pkg.Iterator; Key : in Key_Type) return 
Cursor;
+   --  Initialise Iterator to descending, starting at element with
+   --  largest key < Key. Has_Element (result) is False if there is no
+   --  such element.
+
+   function Find
+     (Iterator  : in Pkg.Iterator;
+      Key       : in Key_Type;
+      Direction : in Direction_Type := Ascending)
+     return Cursor;
+   --  Has_Element is False if Key is not in Container.
+
+   function Find_In_Range
+     (Iterator    : in Pkg.Iterator;
+      Direction   : in Known_Direction_Type;
+      First, Last : in Key_Type)
+     return Cursor;
+   --  Find first element with Key greater than or equal to First, and
+   --  less than or equal to Last. If Direction is Ascending, start
+   --  search at First; if Descending, at Last.
+   --
+   --  Has_Element is False if there is no such Key.
+
+   function Count (Tree : in Pkg.Tree) return Ada.Containers.Count_Type;
+
+   function Present (Container : in Tree; Key : in Key_Type) return Boolean;
+
+   procedure Insert (Tree : in out Pkg.Tree; Element : in Element_Type);
+   function Insert (Tree : in out Pkg.Tree; Element : in Element_Type) return 
Cursor;
+   --  Result points to newly inserted element.
+
+   procedure Delete (Tree : in out Pkg.Tree; Position : in out Cursor);
+   --  Delete element at Position; set Position to point to no element.
+private
+
+   type Node;
+   type Node_Access is access Node;
+
+   type Color is (Red, Black);
+
+   type Node is record
+      Element : aliased Element_Type;
+      Parent  : Node_Access;
+      Left    : Node_Access;
+      Right   : Node_Access;
+      Color   : Pkg.Color;
+   end record;
+
+   procedure Free is new Ada.Unchecked_Deallocation (Node, Node_Access);
+
+   type Tree is new Ada.Finalization.Limited_Controlled with record
+      Root : Node_Access;
+      Nil  : Node_Access;
+      --  Nil is the node pointed to by all links that would otherwise be
+      --  'null'. This simplifies several algorithm (for example,
+      --  Node.Left.Color is always valid). Its parent, left, right links
+      --  are used as temp storage for some algorithms (especially Delete).
+      --  Nil.Color is Black.
+   end record;
+
+   type Cursor is record
+      Node : Node_Access := null;
+
+      Direction  : Direction_Type := Unknown;
+      --  Set in First or Last, enforced in next/prev (cannot change 
direction).
+
+      Left_Done  : Boolean := True;
+      Right_Done : Boolean := True;
+   end record;
+
+   No_Element : constant Cursor :=
+     (Node       => null,
+      Direction  => Unknown,
+      Left_Done  => True,
+      Right_Done => True);
+
+   type Iterator is new Iterators.Reversible_Iterator with
+   record
+      Root : Node_Access;
+      Nil  : Node_Access;
+   end record;
+
+end SAL.Gen_Unbounded_Definite_Red_Black_Trees;
diff --git a/sal-gen_unbounded_definite_stacks-gen_image_aux.adb 
b/sal-gen_unbounded_definite_stacks-gen_image_aux.adb
new file mode 100644
index 0000000..e900846
--- /dev/null
+++ b/sal-gen_unbounded_definite_stacks-gen_image_aux.adb
@@ -0,0 +1,42 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Strings.Unbounded;
+function SAL.Gen_Unbounded_Definite_Stacks.Gen_Image_Aux
+  (Item  : in Stack;
+   Aux   : in Aux_Data;
+   Depth : in SAL.Base_Peek_Type := 0)
+  return String
+is
+   use Ada.Strings.Unbounded;
+   Result : Unbounded_String        := To_Unbounded_String ("(");
+   Last   : constant Base_Peek_Type :=
+     (if Depth = 0
+      then Item.Top
+      else Base_Peek_Type'Min (Depth, Item.Top));
+begin
+   for I in 1 .. Last loop
+      Result := Result & Element_Image (Item.Peek (I), Aux);
+      if I /= Last then
+         Result := Result & ", ";
+      end if;
+   end loop;
+   Result := Result & ")";
+   return To_String (Result);
+end SAL.Gen_Unbounded_Definite_Stacks.Gen_Image_Aux;
diff --git a/sal-gen_unbounded_definite_stacks-gen_image_aux.ads 
b/sal-gen_unbounded_definite_stacks-gen_image_aux.ads
new file mode 100644
index 0000000..ff732a8
--- /dev/null
+++ b/sal-gen_unbounded_definite_stacks-gen_image_aux.ads
@@ -0,0 +1,27 @@
+--  Abstract :
+--
+--  Image with auxiliary data for instantiations of parent.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+generic
+   type Aux_Data (<>) is private;
+   with function Element_Image (Item : in Element_Type; Aux : in Aux_Data) 
return String;
+function SAL.Gen_Unbounded_Definite_Stacks.Gen_Image_Aux
+  (Item  : in Stack;
+   Aux   : in Aux_Data;
+   Depth : in SAL.Base_Peek_Type := 0)
+  return String;
diff --git a/sal-gen_unbounded_definite_stacks.adb 
b/sal-gen_unbounded_definite_stacks.adb
new file mode 100644
index 0000000..d916b6e
--- /dev/null
+++ b/sal-gen_unbounded_definite_stacks.adb
@@ -0,0 +1,178 @@
+--  Abstract:
+--
+--  see spec
+--
+--  Copyright (C) 1998, 2003, 2009, 2015, 2017, 2018 Stephen Leake.  All 
Rights Reserved.
+--
+--  SAL is free software; you can redistribute it and/or modify it
+--  under terms of the GNU General Public License as published by the
+--  Free Software Foundation; either version 3, or (at your option)
+--  any later version. SAL 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 distributed
+--  with SAL; see file COPYING. If not, write to the Free Software
+--  Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+--  USA.
+--
+--  As a special exception, if other files instantiate generics from
+--  SAL, or you link SAL object files with other files to produce an
+--  executable, that does not by itself cause the resulting executable
+--  to be covered by the GNU General Public License. This exception
+--  does not however invalidate any other reasons why the executable
+--  file might be covered by the GNU Public License.
+
+pragma License (Modified_GPL);
+
+package body SAL.Gen_Unbounded_Definite_Stacks is
+
+   ----------
+   --  local subprogram bodies
+
+   procedure Grow (Stack : in out Sguds.Stack; Desired_Size : in 
Base_Peek_Type)
+   is
+      New_Data : constant Element_Array_Access := new Element_Array (1 .. 
Desired_Size);
+   begin
+      New_Data (1 .. Stack.Top) := Stack.Data (1 .. Stack.Top);
+      Free (Stack.Data);
+      Stack.Data := New_Data;
+   end Grow;
+
+   ----------
+   --  Spec visible subprograms
+   overriding procedure Finalize (Stack : in out Sguds.Stack)
+   is begin
+      if Stack.Data /= null then
+         Free (Stack.Data);
+         Stack.Top := Invalid_Peek_Index;
+      end if;
+   end Finalize;
+
+   overriding procedure Adjust (Stack : in out Sguds.Stack)
+   is begin
+      if Stack.Data /= null then
+         Stack.Data := new Element_Array'(Stack.Data.all);
+      end if;
+   end Adjust;
+
+   overriding
+   function "=" (Left, Right : in Sguds.Stack) return Boolean
+   is begin
+      if Left.Data = null then
+         return Right.Data = null;
+      elsif Left.Top /= Right.Top then
+         return False;
+      else
+         --  Assume stacks differ near top.
+         for I in reverse 1 .. Left.Top loop
+            if Left.Data (I) /= Right.Data (I) then
+               return False;
+            end if;
+         end loop;
+         return True;
+      end if;
+   end "=";
+
+   procedure Clear (Stack : in out Sguds.Stack)
+   is begin
+      --  We don't change the reserved capacity, on the assumption the
+      --  stack will be used again.
+      Stack.Top := 0;
+   end Clear;
+
+   function Depth (Stack : in Sguds.Stack) return Base_Peek_Type
+   is begin
+      return Stack.Top;
+   end Depth;
+
+   function Is_Empty (Stack : in Sguds.Stack) return Boolean
+   is begin
+      return Stack.Top = 0;
+   end Is_Empty;
+
+   function Peek
+     (Stack : in Sguds.Stack;
+      Index : in Peek_Type := 1)
+     return Element_Type
+   is begin
+      return Stack.Data (Stack.Top - Index + 1);
+   end Peek;
+
+   procedure Pop (Stack : in out Sguds.Stack; Count : in Base_Peek_Type := 1)
+   is begin
+      if Stack.Top < Count then
+         raise Container_Empty;
+      else
+         Stack.Top := Stack.Top - Count;
+      end if;
+   end Pop;
+
+   function Pop (Stack : in out Sguds.Stack) return Element_Type
+   is begin
+      if Stack.Top = 0 then
+         raise Container_Empty;
+      else
+         return Result : constant Element_Type := Stack.Peek (1)
+         do
+            Stack.Top := Stack.Top - 1;
+         end return;
+      end if;
+   end Pop;
+
+   procedure Push (Stack : in out Sguds.Stack; Item : in Element_Type)
+   is begin
+      if Stack.Data = null then
+         --  Adding a generic parameter for a reasonably large default initial
+         --  size here makes Wisitoken McKenzie recover slightly slower,
+         --  presumably due to increased cache thrashing.
+         Stack.Data := new Element_Array (1 .. 2);
+      elsif Stack.Top = Stack.Data'Last then
+         Grow (Stack, Desired_Size => 2 * Stack.Data'Last);
+      end if;
+      Stack.Top := Stack.Top + 1;
+      Stack.Data (Stack.Top) := Item;
+   end Push;
+
+   function Top (Stack : in Sguds.Stack) return Element_Type
+   is begin
+      if Stack.Top < 1 then
+         raise SAL.Container_Empty;
+      else
+         return Peek (Stack, 1);
+      end if;
+   end Top;
+
+   procedure Set_Depth
+     (Stack : in out Sguds.Stack;
+      Depth : in     Peek_Type)
+   is begin
+      if Stack.Data = null then
+         Stack.Data := new Element_Array (1 .. 2 * Depth);
+      elsif Depth > Stack.Data'Last then
+         Grow (Stack, Desired_Size => 2 * Depth);
+      end if;
+   end Set_Depth;
+
+   procedure Set
+     (Stack   : in out Sguds.Stack;
+      Index   : in     Peek_Type;
+      Depth   : in     Peek_Type;
+      Element : in     Element_Type)
+   is begin
+      --  Same Position algorithm as in Peek
+      Stack.Top := Depth;
+      Stack.Data (Depth - Index + 1) := Element;
+   end Set;
+
+   function Constant_Ref
+     (Container : aliased in Stack'Class;
+      Position  :         in Peek_Type)
+     return Constant_Ref_Type
+   is begin
+      return
+        (Element => Container.Data (Container.Top - Position + 1)'Access,
+         Dummy => 1);
+   end Constant_Ref;
+
+end SAL.Gen_Unbounded_Definite_Stacks;
diff --git a/sal-gen_unbounded_definite_stacks.ads 
b/sal-gen_unbounded_definite_stacks.ads
new file mode 100644
index 0000000..413071f
--- /dev/null
+++ b/sal-gen_unbounded_definite_stacks.ads
@@ -0,0 +1,133 @@
+--  Abstract:
+--
+--  Stack implementation.
+--
+--  Copyright (C) 1998-2000, 2002-2003, 2009, 2015, 2017, 2018 Stephen Leake.  
All Rights Reserved.
+--
+--  SAL is free software; you can redistribute it and/or modify it
+--  under terms of the GNU General Public License as published by the
+--  Free Software Foundation; either version 3, or (at your option)
+--  any later version. SAL 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 distributed
+--  with SAL; see file COPYING. If not, write to the Free Software
+--  Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+--  USA.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Finalization;
+with Ada.Unchecked_Deallocation;
+generic
+   type Element_Type is private;
+package SAL.Gen_Unbounded_Definite_Stacks is
+
+   package Sguds renames SAL.Gen_Unbounded_Definite_Stacks;
+
+   type Stack is new Ada.Finalization.Controlled with private
+   with
+     Constant_Indexing => Constant_Ref;
+
+   Empty_Stack : constant Stack;
+
+   overriding procedure Finalize (Stack : in out Sguds.Stack);
+   overriding procedure Adjust (Stack : in out Sguds.Stack);
+
+   overriding function "=" (Left, Right : in Sguds.Stack) return Boolean;
+
+   procedure Clear (Stack : in out Sguds.Stack);
+   --  Empty Stack of all items.
+
+   function Depth (Stack : in Sguds.Stack) return Base_Peek_Type;
+   --  Returns current count of items in the Stack
+
+   function Is_Empty (Stack : in Sguds.Stack) return Boolean;
+   --  Returns true iff no items are in Stack.
+
+   function Peek
+     (Stack : in Sguds.Stack;
+      Index : in Peek_Type := 1)
+     return Element_Type;
+   --  Return the Index'th item from the top of Stack; the Item is _not_ 
removed.
+   --  Top item has index 1.
+   --
+   --  Raises Constraint_Error if Index > Depth.
+   --
+   --  See also Constant_Ref, implicit indexing
+
+   procedure Pop (Stack : in out Sguds.Stack; Count : in Base_Peek_Type := 1);
+   --  Remove Count Items from the top of Stack, discard them.
+   --
+   --  Raises Container_Empty if there are fewer than Count items on
+   --  Stack.
+
+   function Pop (Stack : in out Sguds.Stack) return Element_Type;
+   --  Remove Item from the top of Stack, and return it.
+   --
+   --  Raises Container_Empty if Is_Empty.
+
+   procedure Push (Stack : in out Sguds.Stack; Item : in Element_Type);
+   --  Add Item to the top of Stack.
+   --
+   --  May raise Container_Full.
+
+   function Top (Stack : in Sguds.Stack) return Element_Type;
+   --  Return the item at the top of Stack; the Item is _not_ removed.
+   --  Same as Peek (Stack, 1).
+   --
+   --  Raises Container_Empty if Is_Empty.
+
+   procedure Set_Depth
+     (Stack : in out Sguds.Stack;
+      Depth : in     Peek_Type);
+   --  Empty Stack, set its Depth to Depth. Must be followed by Set
+   --  for each element.
+   --
+   --  Useful when creating a stack from pre-existing data.
+
+   procedure Set
+     (Stack   : in out Sguds.Stack;
+      Index   : in     Peek_Type;
+      Depth   : in     Peek_Type;
+      Element : in     Element_Type);
+   --  Set a Stack element. Index is the same as Peek Index; Depth is
+   --  used to compute the index in the underlying array.
+   --
+   --  Stack must have been initialized by Set_Depth.
+   --
+   --  Useful when creating a stack from pre-existing data.
+
+   type Constant_Ref_Type (Element : not null access constant Element_Type) is
+   record
+      Dummy : Integer := raise Program_Error with "uninitialized reference";
+   end record
+   with Implicit_Dereference => Element;
+
+   function Constant_Ref
+     (Container : aliased in Stack'Class;
+      Position  :         in Peek_Type)
+     return Constant_Ref_Type;
+
+private
+
+   type Element_Array is array (Peek_Type range <>) of aliased Element_Type;
+   type Element_Array_Access is access Element_Array;
+   procedure Free is new Ada.Unchecked_Deallocation (Element_Array, 
Element_Array_Access);
+
+   type Stack is new Ada.Finalization.Controlled with record
+      Top  : Base_Peek_Type := Invalid_Peek_Index; -- empty
+      Data : Element_Array_Access;
+
+      --  Top of stack is at Data (Top).
+      --  Data (1 .. Last_Index) has been set at some point.
+   end record;
+
+   Empty_Stack : constant Stack := (Ada.Finalization.Controlled with 
Invalid_Peek_Index, null);
+
+end SAL.Gen_Unbounded_Definite_Stacks;
diff --git a/sal-gen_unbounded_definite_vectors-gen_comparable.adb 
b/sal-gen_unbounded_definite_vectors-gen_comparable.adb
new file mode 100644
index 0000000..1bd9251
--- /dev/null
+++ b/sal-gen_unbounded_definite_vectors-gen_comparable.adb
@@ -0,0 +1,73 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+package body SAL.Gen_Unbounded_Definite_Vectors.Gen_Comparable is
+
+   function Compare (Left, Right : in Vector) return Compare_Result
+   is
+      use all type Ada.Containers.Count_Type;
+   begin
+      if Left.Length = 0 then
+         if Right.Length = 0 then
+            return Equal;
+         else
+            --  null is less than non-null
+            return Less;
+         end if;
+
+      elsif Right.Length = 0 then
+         return Greater;
+
+      else
+         declare
+            I : Base_Peek_Type := To_Peek_Type (Left.First);
+            J : Base_Peek_Type := To_Peek_Type (Right.First);
+
+            Left_Last  : constant Base_Peek_Type := To_Peek_Type (Left.Last);
+            Right_Last : constant Base_Peek_Type := To_Peek_Type (Right.Last);
+         begin
+            loop
+               exit when I > Left_Last or J > Right_Last;
+
+               case Element_Compare (Left.Elements (I), Right.Elements (J)) is
+               when Less =>
+                  return Less;
+               when Equal =>
+                  I := I + 1;
+                  J := J + 1;
+               when Greater =>
+                  return Greater;
+               end case;
+            end loop;
+            if I > Left_Last then
+               if J > Right_Last then
+                  return Equal;
+               else
+                  --  right is longer
+                  return Less;
+               end if;
+            else
+               --  left is longer
+               return Greater;
+            end if;
+         end;
+      end if;
+   end Compare;
+
+end SAL.Gen_Unbounded_Definite_Vectors.Gen_Comparable;
diff --git a/sal-gen_unbounded_definite_vectors-gen_comparable.ads 
b/sal-gen_unbounded_definite_vectors-gen_comparable.ads
new file mode 100644
index 0000000..a12f81a
--- /dev/null
+++ b/sal-gen_unbounded_definite_vectors-gen_comparable.ads
@@ -0,0 +1,30 @@
+--  Abstract :
+--
+--  Add "<" to parent
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+generic
+   with function Element_Compare (Left, Right : in Element_Type) return 
Compare_Result;
+package SAL.Gen_Unbounded_Definite_Vectors.Gen_Comparable is
+
+   type Vector is new SAL.Gen_Unbounded_Definite_Vectors.Vector with null 
record;
+
+   function Compare (Left, Right : in Vector) return Compare_Result;
+   --  Similar to Ada "<" for arrays; Ada Reference Manual
+   --  section 4.5.2 para 26/3.
+
+end SAL.Gen_Unbounded_Definite_Vectors.Gen_Comparable;
diff --git a/sal-gen_unbounded_definite_vectors-gen_image.adb 
b/sal-gen_unbounded_definite_vectors-gen_image.adb
new file mode 100644
index 0000000..03a1c5f
--- /dev/null
+++ b/sal-gen_unbounded_definite_vectors-gen_image.adb
@@ -0,0 +1,50 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Strings.Fixed;
+with Ada.Strings.Unbounded;
+function SAL.Gen_Unbounded_Definite_Vectors.Gen_Image (Item : in Vector; 
Strict : in Boolean := False) return String
+is
+   use all type Ada.Containers.Count_Type;
+   use Ada.Strings;
+   use Ada.Strings.Fixed;
+   use Ada.Strings.Unbounded;
+   Result : Unbounded_String        := To_Unbounded_String ("(");
+   First  : constant Base_Peek_Type := To_Peek_Type (Item.First_Index);
+   Last   : constant Base_Peek_Type := To_Peek_Type (Item.Last_Index);
+begin
+   if Strict and Item.Length = 0 then
+      return "(" & Trim (Index_Type'Image (Index_Type'First), Left) & " .. " &
+        Trim (Index_Type'Image (Extended_Index'First), Left) & " => <>)";
+
+   elsif Strict and Item.Length = 1 then
+      return "(" & Trim (Index_Type'Image (Index_Type'First), Left) & " => " &
+        Element_Image (Item.Elements (First)) & ")";
+
+   else
+      for I in First .. Last loop
+         Result := Result & Element_Image (Item.Elements (I));
+         if I /= Last then
+            Result := Result & ", ";
+         end if;
+      end loop;
+      Result := Result & ")";
+      return To_String (Result);
+   end if;
+end SAL.Gen_Unbounded_Definite_Vectors.Gen_Image;
diff --git a/sal-gen_unbounded_definite_vectors-gen_image.ads 
b/sal-gen_unbounded_definite_vectors-gen_image.ads
new file mode 100644
index 0000000..1ace2fe
--- /dev/null
+++ b/sal-gen_unbounded_definite_vectors-gen_image.ads
@@ -0,0 +1,24 @@
+--  Abstract :
+--
+--  Image of parent.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+generic
+   with function Element_Image (Item : in Element_Type) return String;
+function SAL.Gen_Unbounded_Definite_Vectors.Gen_Image (Item : in Vector; 
Strict : in Boolean := False) return String;
+--  Image of Item, in Ada aggregate syntax. If Strict, use correct
+--  syntax for 0 and 1 item; otherwise, use () and (item).
diff --git a/sal-gen_unbounded_definite_vectors-gen_image_aux.adb 
b/sal-gen_unbounded_definite_vectors-gen_image_aux.adb
new file mode 100644
index 0000000..c498e0e
--- /dev/null
+++ b/sal-gen_unbounded_definite_vectors-gen_image_aux.adb
@@ -0,0 +1,36 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Strings.Unbounded;
+function SAL.Gen_Unbounded_Definite_Vectors.Gen_Image_Aux (Item : in Vector; 
Aux : in Aux_Data) return String
+is
+   use Ada.Strings.Unbounded;
+   Result : Unbounded_String        := To_Unbounded_String ("(");
+   First  : constant Base_Peek_Type := To_Peek_Type (Item.First_Index);
+   Last   : constant Base_Peek_Type := To_Peek_Type (Item.Last_Index);
+begin
+   for I in First .. Last loop
+      Result := Result & Element_Image (Item.Elements (I), Aux);
+      if I /= Last then
+         Result := Result & ", ";
+      end if;
+   end loop;
+   Result := Result & ")";
+   return To_String (Result);
+end SAL.Gen_Unbounded_Definite_Vectors.Gen_Image_Aux;
diff --git a/sal-gen_unbounded_definite_vectors-gen_image_aux.ads 
b/sal-gen_unbounded_definite_vectors-gen_image_aux.ads
new file mode 100644
index 0000000..0be7c41
--- /dev/null
+++ b/sal-gen_unbounded_definite_vectors-gen_image_aux.ads
@@ -0,0 +1,23 @@
+--  Abstract :
+--
+--  Image with auxiliary data for instantiations of parent.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+generic
+   type Aux_Data (<>) is private;
+   with function Element_Image (Item : in Element_Type; Aux : in Aux_Data) 
return String;
+function SAL.Gen_Unbounded_Definite_Vectors.Gen_Image_Aux (Item : in Vector; 
Aux : in Aux_Data) return String;
diff --git a/sal-gen_unbounded_definite_vectors.adb 
b/sal-gen_unbounded_definite_vectors.adb
new file mode 100644
index 0000000..8faaf88
--- /dev/null
+++ b/sal-gen_unbounded_definite_vectors.adb
@@ -0,0 +1,578 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+package body SAL.Gen_Unbounded_Definite_Vectors is
+
+   function To_Peek_Type (Item : in Extended_Index) return Base_Peek_Type
+   is begin
+      return Base_Peek_Type'Base (Item - Index_Type'First) + Peek_Type'First;
+   end To_Peek_Type;
+
+   function To_Index_Type (Item : in Base_Peek_Type) return Extended_Index
+   is begin
+      return Extended_Index (Item - Peek_Type'First) + Index_Type'First;
+   end To_Index_Type;
+
+   procedure Grow (Elements : in out Array_Access; Index : in Base_Peek_Type)
+   is
+      --  Reallocate Elements so Elements (Index) is a valid element.
+
+      Old_First  : constant Peek_Type := Elements'First;
+      Old_Last   : constant Peek_Type := Elements'Last;
+      New_First  : Peek_Type          := Old_First;
+      New_Last   : Peek_Type          := Old_Last;
+      New_Length : Peek_Type          := Elements'Length;
+
+      New_Array : Array_Access;
+   begin
+      loop
+         exit when New_First <= Index;
+         New_Length := New_Length * 2;
+         New_First  := Peek_Type'Max (Peek_Type'First, Old_Last - New_Length + 
1);
+      end loop;
+      loop
+         exit when New_Last >= Index;
+         New_Length := New_Length * 2;
+         New_Last   := Peek_Type'Min (Peek_Type'Last, New_First + New_Length - 
1);
+      end loop;
+
+      New_Array := new Array_Type (New_First .. New_Last);
+
+      --  We'd like to use this:
+      --
+      --  New_Array (New_First .. Old_First - 1) := (others => <>);
+      --
+      --  but that can overflow the stack, since the aggregate is allocated
+      --  on the stack.
+
+      for I in New_First .. Old_First - 1 loop
+         New_Array (I .. I) := (others => <>);
+      end loop;
+
+      New_Array (Old_First .. Old_Last) := Elements.all;
+
+      for I in Old_Last + 1 .. New_Last loop
+         New_Array (I .. I)   := (others => <>);
+      end loop;
+
+      Free (Elements);
+      Elements := New_Array;
+   end Grow;
+
+   ----------
+   --  public subprograms
+
+   overriding procedure Finalize (Container : in out Vector)
+   is begin
+      Free (Container.Elements);
+      Container.First := No_Index;
+      Container.Last  := No_Index;
+   end Finalize;
+
+   overriding procedure Adjust (Container : in out Vector)
+   is begin
+      if Container.Elements /= null then
+         Container.Elements := new Array_Type'(Container.Elements.all);
+      end if;
+   end Adjust;
+
+   function Length (Container : in Vector) return Ada.Containers.Count_Type
+   is begin
+      --  We assume the type ranges are sensible, so no exceptions occur
+      --  here.
+      if Container.Elements = null then
+         return 0;
+      else
+         return Ada.Containers.Count_Type (To_Peek_Type (Container.Last) - 
Container.Elements'First + 1);
+      end if;
+   end Length;
+
+   function Capacity (Container : in Vector) return Ada.Containers.Count_Type
+   is begin
+      if Container.Elements = null then
+         return 0;
+      else
+         return Ada.Containers.Count_Type (Container.Elements'Length);
+      end if;
+   end Capacity;
+
+   function Element (Container : Vector; Index : Index_Type) return 
Element_Type
+   is begin
+      return Container.Elements (To_Peek_Type (Index));
+   end Element;
+
+   procedure Replace_Element (Container : Vector; Index : Index_Type; New_Item 
: in Element_Type)
+   is begin
+      Container.Elements (To_Peek_Type (Index)) := New_Item;
+   end Replace_Element;
+
+   function First_Index (Container : Vector) return Extended_Index
+   is begin
+      if Container.Elements = null then
+         return No_Index + 1;
+      else
+         return Container.First;
+      end if;
+   end First_Index;
+
+   function Last_Index (Container : Vector) return Extended_Index
+   is begin
+      if Container.Elements = null then
+         return No_Index;
+      else
+         return Container.Last;
+      end if;
+   end Last_Index;
+
+   procedure Append (Container : in out Vector; New_Item : in Element_Type)
+   is begin
+      if Container.First = No_Index then
+         Container.First := Index_Type'First;
+         Container.Last  := Index_Type'First;
+      else
+         Container.Last := Container.Last + 1;
+      end if;
+
+      declare
+         J : constant Base_Peek_Type := To_Peek_Type (Container.Last);
+      begin
+         if Container.Elements = null then
+            Container.Elements := new Array_Type (J .. J);
+
+         elsif J > Container.Elements'Last then
+            Grow (Container.Elements, J);
+         end if;
+
+         Container.Elements (J) := New_Item;
+      end;
+   end Append;
+
+   procedure Append (Container : in out Vector; New_Items : in Vector)
+   is
+      use all type Ada.Containers.Count_Type;
+      Old_Last : Extended_Index := Container.Last;
+   begin
+      if New_Items.Length = 0 then
+         return;
+      end if;
+
+      if Container.First = No_Index then
+         Container.First := Index_Type'First;
+         Old_Last        := Container.First - 1;
+         Container.Last  := Container.First + Extended_Index 
(New_Items.Length) - 1;
+      else
+         Container.Last := Container.Last + Extended_Index (New_Items.Length);
+      end if;
+
+      declare
+         I : constant Peek_Type := To_Peek_Type (Old_Last + 1);
+         J : constant Peek_Type := To_Peek_Type (Container.Last);
+      begin
+         if Container.Elements = null then
+            Container.Elements := new Array_Type (I .. J);
+         elsif J > Container.Elements'Last then
+            Grow (Container.Elements, J);
+         end if;
+
+         Container.Elements (I .. J) := New_Items.Elements
+           (To_Peek_Type (New_Items.First) .. To_Peek_Type (New_Items.Last));
+      end;
+   end Append;
+
+   procedure Prepend (Container : in out Vector; New_Item : in Element_Type)
+   is begin
+      if Container.First = No_Index then
+         Container.First := Index_Type'First;
+         Container.Last  := Index_Type'First;
+      else
+         Container.First := Container.First - 1;
+      end if;
+
+      declare
+         J : constant Peek_Type := To_Peek_Type (Container.First);
+      begin
+         if Container.Elements = null then
+            Container.Elements := new Array_Type (J .. J);
+
+         elsif J < Container.Elements'First then
+            Grow (Container.Elements, J);
+         end if;
+
+         Container.Elements (J) := New_Item;
+      end;
+   end Prepend;
+
+   procedure Prepend
+     (Target       : in out Vector;
+      Source       : in     Vector;
+      Source_First : in     Index_Type;
+      Source_Last  : in     Index_Type)
+   is
+      Source_I : constant Peek_Type := To_Peek_Type (Source_First);
+      Source_J : constant Peek_Type := To_Peek_Type (Source_Last);
+   begin
+      if Target.Elements = null then
+         Target.Elements := new Array_Type'(Source.Elements (Source_I .. 
Source_J));
+         Target.First    := Source_First;
+         Target.Last     := Source_Last;
+      else
+         declare
+            New_First : constant Index_Type := Target.First - (Source_Last - 
Source_First + 1);
+            I         : constant Peek_Type  := To_Peek_Type (New_First);
+            J         : constant Peek_Type  := To_Peek_Type (Target.First - 1);
+         begin
+            if Target.Elements'First > I then
+               Grow (Target.Elements, I);
+            end if;
+            Target.Elements (I .. J) := Source.Elements (Source_I .. Source_J);
+            Target.First := New_First;
+         end;
+      end if;
+   end Prepend;
+
+   procedure Insert
+     (Container : in out Vector;
+      Element   : in     Element_Type;
+      Before    : in     Index_Type)
+   is
+      use all type Ada.Containers.Count_Type;
+   begin
+      if Container.Length = 0 then
+         Container.Append (Element);
+      else
+         Container.Last := Container.Last + 1;
+
+         declare
+            J : constant Peek_Type := To_Peek_Type (Before);
+            K : constant Base_Peek_Type := To_Peek_Type (Container.Last);
+         begin
+            if K > Container.Elements'Last then
+               Grow (Container.Elements, K);
+            end if;
+
+            Container.Elements (J + 1 .. K) := Container.Elements (J .. K - 1);
+            Container.Elements (J) := Element;
+         end;
+      end if;
+   end Insert;
+
+   procedure Merge
+     (Target : in out Vector;
+      Source : in out Vector)
+   is
+      use all type Ada.Containers.Count_Type;
+   begin
+      if Source.Length = 0 then
+         Source.Clear;
+
+      elsif Target.Length = 0 then
+         Target := Source;
+         Source.Clear;
+
+      else
+         declare
+            New_First : constant Index_Type := Extended_Index'Min 
(Target.First, Source.First);
+            New_Last  : constant Index_Type := Extended_Index'Max 
(Target.Last, Source.Last);
+            New_I     : constant Peek_Type  := To_Peek_Type (New_First);
+            New_J     : constant Base_Peek_Type  := To_Peek_Type (New_Last);
+         begin
+            if New_I < Target.Elements'First then
+               Grow (Target.Elements, New_I);
+            end if;
+            if New_J > Target.Elements'Last then
+               Grow (Target.Elements, New_J);
+            end if;
+
+            Target.Elements (To_Peek_Type (Source.First) .. To_Peek_Type 
(Source.Last)) := Source.Elements
+              (To_Peek_Type (Source.First) .. To_Peek_Type (Source.Last));
+
+            Target.First := New_First;
+            Target.Last  := New_Last;
+
+            Source.Clear;
+         end;
+      end if;
+   end Merge;
+
+   function To_Vector (Item : in Element_Type; Count : in 
Ada.Containers.Count_Type := 1) return Vector
+   is begin
+      return Result : Vector do
+         for I in 1 .. Count loop
+            Result.Append (Item);
+         end loop;
+      end return;
+   end To_Vector;
+
+   function "+" (Element : in Element_Type) return Vector
+   is begin
+      return Result : Vector do
+         Result.Append (Element);
+      end return;
+   end "+";
+
+   function "&" (Left, Right : in Element_Type) return Vector
+   is begin
+      return Result : Vector do
+         Result.Append (Left);
+         Result.Append (Right);
+      end return;
+   end "&";
+
+   function "&" (Left : in Vector; Right : in Element_Type) return Vector
+   is begin
+      return Result : Vector := Left do
+         Result.Append (Right);
+      end return;
+   end "&";
+
+   procedure Set_First (Container : in out Vector; First : in Index_Type)
+   is
+      J : constant Peek_Type := To_Peek_Type (First);
+   begin
+      Container.First := First;
+      if Container.Last = No_Index then
+         Container.Last := First - 1;
+      end if;
+
+      if Container.Last >= First then
+         if Container.Elements = null then
+            Container.Elements := new Array_Type'(J .. To_Peek_Type 
(Container.Last) => <>);
+
+         elsif Container.Elements'First > J then
+            Grow (Container.Elements, J);
+         end if;
+      end if;
+   end Set_First;
+
+   procedure Set_Last (Container : in out Vector; Last : in Extended_Index)
+   is
+      J : constant Base_Peek_Type := To_Peek_Type (Last);
+   begin
+      Container.Last := Last;
+      if Container.First = No_Index then
+         Container.First := Last + 1;
+      end if;
+
+      if Last >= Container.First then
+         if Container.Elements = null then
+            Container.Elements := new Array_Type'(To_Peek_Type 
(Container.First) .. J => <>);
+
+         elsif Container.Elements'Last < J then
+            Grow (Container.Elements, J);
+         end if;
+      end if;
+   end Set_Last;
+
+   procedure Set_First_Last (Container : in out Vector; First : in Index_Type; 
Last : in Extended_Index)
+   is begin
+      Set_First (Container, First);
+      Set_Last (Container, Last);
+   end Set_First_Last;
+
+   procedure Set_Length (Container : in out Vector; Length : in 
Ada.Containers.Count_Type)
+   is
+      use all type Ada.Containers.Count_Type;
+   begin
+      if Container.First = No_Index then
+         Container.First := Index_Type'First;
+         Container.Last  := Container.First - 1;
+      end if;
+      if Length > 0 then
+         Container.Set_Last (Index_Type (Length) + Container.First - 1);
+      end if;
+   end Set_Length;
+
+   procedure Set_Length
+     (Container : in out Vector;
+      Length    : in     Ada.Containers.Count_Type;
+      Default   : in     Element_Type)
+   is
+      Old_First : constant Extended_Index := Container.First;
+      Old_Last  : constant Extended_Index := Container.Last;
+   begin
+      Set_Length (Container, Length);
+      if Old_First = No_Index then
+         Container.Elements.all := (others => Default);
+      else
+         Container.Elements (To_Peek_Type (Old_Last + 1) .. To_Peek_Type 
(Container.Last)) := (others => Default);
+      end if;
+   end Set_Length;
+
+   procedure Delete (Container : in out Vector; Index : in Index_Type)
+   is
+      J : constant Peek_Type := To_Peek_Type (Index);
+   begin
+      Container.Elements (J .. J) := (J => <>);
+      if Index = Container.Last then
+         Container.Last := Container.Last - 1;
+      end if;
+   end Delete;
+
+   function Contains (Container : in Vector; Element : in Element_Type) return 
Boolean
+   is
+      use all type Ada.Containers.Count_Type;
+   begin
+      if Container.Length = 0 then
+         return False;
+      else
+         for It of Container.Elements.all loop
+            if It = Element then
+               return True;
+            end if;
+         end loop;
+         return False;
+      end if;
+   end Contains;
+
+   function Has_Element (Position : Cursor) return Boolean is
+   begin
+      return Position.Index /= Invalid_Peek_Index;
+   end Has_Element;
+
+   function Element (Position : Cursor) return Element_Type
+   is begin
+      return Position.Container.Elements (Position.Index);
+   end Element;
+
+   function First (Container : aliased in Vector) return Cursor
+   is
+      use all type Ada.Containers.Count_Type;
+   begin
+      if Container.Length = 0 then
+         return No_Element;
+      else
+         return (Container'Access, To_Peek_Type (Container.First));
+      end if;
+   end First;
+
+   function Next (Position : in Cursor) return Cursor
+   is begin
+      if Position = No_Element then
+         return No_Element;
+      elsif Position.Index < To_Peek_Type (Position.Container.Last) then
+         return (Position.Container, Position.Index + 1);
+      else
+         return No_Element;
+      end if;
+   end Next;
+
+   procedure Next (Position : in out Cursor)
+   is begin
+      if Position = No_Element then
+         null;
+      elsif Position.Index < To_Peek_Type (Position.Container.Last) then
+         Position.Index := Position.Index + 1;
+      else
+         Position := No_Element;
+      end if;
+   end Next;
+
+   function To_Cursor
+     (Container : aliased in Vector;
+      Index     :         in Extended_Index)
+     return Cursor
+   is begin
+      if Index not in Container.First .. Container.Last then
+         return No_Element;
+      else
+         return (Container'Access, To_Peek_Type (Index));
+      end if;
+   end To_Cursor;
+
+   function To_Index (Position : in Cursor) return Extended_Index
+   is begin
+      if Position = No_Element then
+         return No_Index;
+      else
+         return To_Index_Type (Position.Index);
+      end if;
+   end To_Index;
+
+   function Constant_Ref (Container : aliased Vector; Index : in Index_Type) 
return Constant_Reference_Type
+   is
+      J : constant Peek_Type := To_Peek_Type (Index);
+   begin
+      return (Element => Container.Elements (J)'Access);
+   end Constant_Ref;
+
+   function Variable_Ref
+     (Container : aliased in Vector;
+      Index     :         in Index_Type)
+     return Variable_Reference_Type
+   is
+      J : constant Peek_Type := To_Peek_Type (Index);
+   begin
+      return (Element => Container.Elements (J)'Access);
+   end Variable_Ref;
+
+   overriding function First (Object : Iterator) return Cursor
+   is begin
+      if Object.Container.Elements = null then
+         return (null, Invalid_Peek_Index);
+      else
+         return (Object.Container, To_Peek_Type 
(Object.Container.First_Index));
+      end if;
+   end First;
+
+   overriding function Last  (Object : Iterator) return Cursor
+   is begin
+      if Object.Container.Elements = null then
+         return (null, Invalid_Peek_Index);
+      else
+         return (Object.Container, To_Peek_Type (Object.Container.Last_Index));
+      end if;
+   end Last;
+
+   overriding function Next (Object : in Iterator; Position : in Cursor) 
return Cursor
+   is begin
+      if Position.Index = To_Peek_Type (Object.Container.Last) then
+         return (null, Invalid_Peek_Index);
+      else
+         return (Object.Container, Position.Index + 1);
+      end if;
+   end Next;
+
+   overriding function Previous (Object : in Iterator; Position : in Cursor) 
return Cursor
+   is begin
+      if Position.Index = To_Peek_Type (Index_Type'First) then
+         return (null, Invalid_Peek_Index);
+      else
+         return (Object.Container, Position.Index - 1);
+      end if;
+   end Previous;
+
+   function Iterate (Container : aliased in Vector) return 
Iterator_Interfaces.Reversible_Iterator'Class
+   is begin
+      return Iterator'(Container => Container'Unrestricted_Access);
+   end Iterate;
+
+   function Constant_Ref (Container : aliased Vector; Position : in Cursor) 
return Constant_Reference_Type
+   is begin
+      return (Element => Container.Elements (Position.Index)'Access);
+   end Constant_Ref;
+
+   function Variable_Ref
+     (Container : aliased in Vector;
+      Position  :         in Cursor)
+     return Variable_Reference_Type
+   is begin
+      return (Element => Container.Elements (Position.Index)'Access);
+   end Variable_Ref;
+
+end SAL.Gen_Unbounded_Definite_Vectors;
diff --git a/sal-gen_unbounded_definite_vectors.ads 
b/sal-gen_unbounded_definite_vectors.ads
new file mode 100644
index 0000000..799e73c
--- /dev/null
+++ b/sal-gen_unbounded_definite_vectors.ads
@@ -0,0 +1,226 @@
+--  Abstract :
+--
+--  A simple unbounded vector of definite items, intended to be faster
+--  than Ada.Containers.Vectors.
+--
+--  Prepend is as fast (in amortized time) as Append.
+--
+--  It provides no checking of cursor tampering; higher level code
+--  must ensure that.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Finalization;
+with Ada.Iterator_Interfaces;
+with Ada.Unchecked_Deallocation;
+generic
+   type Index_Type is range <>;
+   type Element_Type is private;
+package SAL.Gen_Unbounded_Definite_Vectors is
+
+   subtype Extended_Index is Index_Type'Base
+     range Index_Type'First - 1 ..
+           Index_Type'Min (Index_Type'Base'Last - 1, Index_Type'Last) + 1;
+
+   No_Index : constant Extended_Index := Extended_Index'First;
+
+   type Vector is new Ada.Finalization.Controlled with private with
+      Constant_Indexing => Constant_Ref,
+      Variable_Indexing => Variable_Ref,
+      Default_Iterator  => Iterate,
+      Iterator_Element  => Element_Type;
+
+   Empty_Vector : constant Vector;
+
+   overriding procedure Finalize (Container : in out Vector);
+   overriding procedure Adjust (Container : in out Vector);
+
+   overriding function "=" (Left, Right : in Vector) return Boolean is
+     (raise Programmer_Error);
+   --  Use Gen_Comparable child.
+
+   function Length (Container : in Vector) return Ada.Containers.Count_Type;
+   function Capacity (Container : in Vector) return Ada.Containers.Count_Type;
+
+   procedure Clear (Container : in out Vector)
+   renames Finalize;
+
+   function First_Index (Container : Vector) return Extended_Index;
+   --  No_Index + 1 when Container is empty, so "for I in C.First_Index
+   --  .. C.Last_Index loop" works.
+
+   function Last_Index (Container : Vector) return Extended_Index;
+   --  No_Index when Container is empty.
+
+   function Element (Container : Vector; Index : Index_Type) return 
Element_Type
+   with Pre => Index >= Container.First_Index and Index <= 
Container.Last_Index;
+
+   procedure Replace_Element (Container : Vector; Index : Index_Type; New_Item 
: in Element_Type);
+
+   procedure Append (Container : in out Vector; New_Item : in Element_Type);
+   --  Insert New_Item at end of Container.
+   --
+   --  Raises Constraint_Error if index of new item would be greater than
+   --  Index_Type'Last.
+
+   procedure Append (Container : in out Vector; New_Items : in Vector);
+   --  Insert all elements of New_Items at end of Container.
+
+   procedure Prepend (Container : in out Vector; New_Item : in Element_Type);
+   --  Insert New_Item at beginning of Container.
+   --
+   --  Raises Constraint_Error if index of new item would be less than
+   --  Index_Type'First.
+
+   procedure Prepend
+     (Target       : in out Vector;
+      Source       : in     Vector;
+      Source_First : in     Index_Type;
+      Source_Last  : in     Index_Type);
+   --  Copy Source (Source_First .. Source_Last) to Target, before
+   --  Target.First_Index.
+
+   procedure Insert
+     (Container : in out Vector;
+      Element   : in     Element_Type;
+      Before    : in     Index_Type);
+   --  Existing elements at Before and after are slid to higher indices.
+
+   procedure Merge
+     (Target : in out Vector;
+      Source : in out Vector);
+   --  Copy all elements from Source to Target, to the same index range,
+   --  deleting them from Source, and overwriting overlapping ranges.
+
+   function To_Vector (Item : in Element_Type; Count : in 
Ada.Containers.Count_Type := 1) return Vector;
+
+   function "+" (Element : in Element_Type) return Vector;
+
+   function "&" (Left, Right : in Element_Type) return Vector;
+   function "&" (Left : in Vector; Right : in Element_Type) return Vector;
+
+   procedure Set_First (Container : in out Vector; First : in Index_Type);
+   procedure Set_Last (Container : in out Vector; Last : in Extended_Index);
+   procedure Set_First_Last (Container : in out Vector; First : in Index_Type; 
Last : in Extended_Index);
+   --  Default First is Index_Type'First.
+   --  Elements with First <= index <= Last that have not been set have
+   --  Element_Type default value.
+
+   procedure Set_Length (Container : in out Vector; Length : in 
Ada.Containers.Count_Type);
+   --  Set Last so Container.Length returns Length. New elements have
+   --  Element_Type default value.
+
+   procedure Set_Length
+     (Container : in out Vector;
+      Length    : in     Ada.Containers.Count_Type;
+      Default   : in     Element_Type);
+   --  Set Last so Container.Length returns Length. New elements have
+   --  Default value.
+
+   procedure Delete (Container : in out Vector; Index : in Index_Type);
+   --  Replace Index element contents with default. If Index =
+   --  Container.Last_Index, Container.Last_Index is decremented.
+
+   function Contains (Container : in Vector; Element : in Element_Type) return 
Boolean;
+   --  Return True if Element is in Container, False if not.
+
+   type Constant_Reference_Type (Element : not null access constant 
Element_Type) is null record
+   with Implicit_Dereference => Element;
+
+   function Constant_Ref (Container : aliased in Vector; Index : in 
Index_Type) return Constant_Reference_Type
+   with Pre => Index >= Container.First_Index and Index <= 
Container.Last_Index;
+
+   type Variable_Reference_Type (Element : not null access Element_Type) is 
null record
+   with Implicit_Dereference => Element;
+
+   function Variable_Ref (Container : aliased in Vector; Index : in 
Index_Type) return Variable_Reference_Type
+   with Pre => Index >= Container.First_Index and Index <= 
Container.Last_Index;
+
+   type Cursor is private;
+
+   No_Element : constant Cursor;
+
+   function Has_Element (Position : Cursor) return Boolean;
+   function Element (Position : Cursor) return Element_Type
+   with Pre => Position /= No_Element;
+   function First (Container : aliased in Vector) return Cursor;
+   function Next (Position : in Cursor) return Cursor;
+   procedure Next (Position : in out Cursor);
+
+   function To_Cursor
+     (Container : aliased in Vector;
+      Index     :         in Extended_Index)
+     return Cursor;
+
+   function To_Index (Position : in Cursor) return Extended_Index;
+
+   package Iterator_Interfaces is new Ada.Iterator_Interfaces (Cursor, 
Has_Element);
+
+   function Iterate (Container : aliased in Vector) return 
Iterator_Interfaces.Reversible_Iterator'Class;
+
+   function Constant_Ref (Container : aliased in Vector; Position : in Cursor) 
return Constant_Reference_Type
+   with Pre => Has_Element (Position);
+
+   function Variable_Ref (Container : aliased in Vector; Position  : in 
Cursor) return Variable_Reference_Type
+   with Pre => Has_Element (Position);
+
+private
+
+   type Array_Type is array (SAL.Peek_Type range <>) of aliased Element_Type;
+   type Array_Access is access Array_Type;
+   procedure Free is new Ada.Unchecked_Deallocation (Array_Type, Array_Access);
+
+   type Vector is new Ada.Finalization.Controlled with
+   record
+      Elements : Array_Access;
+      First    : Extended_Index := No_Index;
+      Last     : Extended_Index := No_Index;
+   end record;
+
+   type Vector_Access is access constant Vector;
+   for Vector_Access'Storage_Size use 0;
+
+   type Cursor is record
+      Container : Vector_Access  := null;
+      Index     : Base_Peek_Type := Invalid_Peek_Index;
+   end record;
+
+   type Iterator is new Iterator_Interfaces.Reversible_Iterator with
+   record
+      Container : Vector_Access;
+   end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+   overriding function Last  (Object : Iterator) return Cursor;
+
+   overriding function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
+   overriding function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
+   Empty_Vector : constant Vector := (Ada.Finalization.Controlled with others 
=> <>);
+
+   No_Element : constant Cursor := (others => <>);
+
+   ----------
+   --  Visible for child package
+
+   function To_Peek_Type (Item : in Extended_Index) return Base_Peek_Type with 
Inline;
+
+end SAL.Gen_Unbounded_Definite_Vectors;
diff --git a/sal.adb b/sal.adb
new file mode 100644
index 0000000..6c5013e
--- /dev/null
+++ b/sal.adb
@@ -0,0 +1,32 @@
+--  Abstract:
+--
+--  See spec.
+--
+--  Copyright (C) 1997 - 2004, 2006, 2009 Stephen Leake.  All Rights Reserved.
+--
+--  SAL is free software; you can redistribute it and/or modify it
+--  under terms of the GNU General Public License as published by the
+--  Free Software Foundation; either version 3, or (at your option) any
+--  later version. SAL 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 distributed with SAL; see
+--  file COPYING. If not, write to the Free Software Foundation, 59
+--  Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+--
+--  As a special exception, if other files instantiate generics from
+--  SAL, or you link SAL object files with other files to produce
+--  an executable, that does not by itself cause the resulting
+--  executable to be covered by the GNU General Public License. This
+--  exception does not however invalidate any other reasons why the
+--  executable file might be covered by the GNU Public License.
+--
+package body SAL is
+
+   function Version return String is
+   begin
+      return "SAL 2.01";
+   end Version;
+
+end SAL;
diff --git a/sal.ads b/sal.ads
new file mode 100644
index 0000000..0d5a4e6
--- /dev/null
+++ b/sal.ads
@@ -0,0 +1,75 @@
+--  Abstract:
+--
+--  Root package for Stephe's Ada Library packages.
+--
+--  See sal.html for more information.
+--
+--  See http://stephe-leake.org/ada/sal.html for the
+--  latest version.
+--
+--  Contact Stephe at stephen_leake@stephe-leake.org.
+--
+--  Copyright (C) 1997 - 2004, 2008, 2009, 2015, 2017, 2018 Stephen Leake.  
All Rights Reserved.
+--
+--  SAL is free software; you can redistribute it and/or modify it
+--  under terms of the GNU General Public License as published by the
+--  Free Software Foundation; either version 3, or (at your option) any
+--  later version. SAL 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 distributed with SAL; see
+--  file COPYING. If not, write to the Free Software Foundation, 59
+--  Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+--
+--  As a special exception, if other files instantiate generics from
+--  SAL, or you link SAL object files with other files to produce
+--  an executable, that does not by itself cause the resulting
+--  executable to be covered by the GNU General Public License. This
+--  exception does not however invalidate any other reasons why the
+--  executable file might be covered by the GNU Public License.
+
+pragma License (Modified_GPL);
+
+with Ada.Containers;
+
+package SAL is
+   pragma Pure;
+
+   function Version return String;
+   --  Returns string with format "SAL x.xx".
+
+   Container_Empty                  : exception;
+   Container_Full                   : exception;
+   Config_File_Error                : exception;
+   Domain_Error                     : exception;
+   Duplicate_Key                    : exception;
+   Initialization_Error             : exception;
+   Invalid_Format                   : exception;
+   Invalid_Limit                    : exception;
+   Invalid_Operation                : exception;
+   Invalid_Range                    : exception;
+   Iterator_Error                   : exception;
+   Not_Found                        : exception;
+   Not_Implemented                  : exception;
+   Parameter_Error                  : exception;
+   Programmer_Error                 : exception;
+   Range_Error                      : exception;
+
+   --------------
+   --  General options
+
+   type Direction_Type is (Forward, Backward);
+
+   type Duplicate_Action_Type is (Allow, Ignore, Error);
+
+   type Overflow_Action_Type is (Overwrite, Error);
+
+   --  We use a new type for Peek_Type, not just
+   --  Ada.Containers.Count_Type, to enforce Peek_Type'First = top/first.
+   type Base_Peek_Type is new Ada.Containers.Count_Type range 0 .. 
Ada.Containers.Count_Type'Last;
+   subtype Peek_Type is Base_Peek_Type range 1 .. Base_Peek_Type'Last;
+   Invalid_Peek_Index : constant Base_Peek_Type := 0;
+
+   type Compare_Result is (Less, Equal, Greater);
+end SAL;
diff --git a/standard_common.gpr b/standard_common.gpr
new file mode 100644
index 0000000..82e2fc9
--- /dev/null
+++ b/standard_common.gpr
@@ -0,0 +1,118 @@
+-- Standard settings for all of Stephe's Ada projects.
+project Standard_Common is
+   for Source_Dirs use ();
+
+   type Build_Type is ("Debug", "Normal");
+   Build : Build_Type := External ("Standard_Common_Build", "Normal");
+
+   type Profile_Type is ("On", "Off");
+   Profile : Profile_Type := External ("Standard_Common_Profile", "Off");
+
+   type Mem_Check_Type is ("On", "Off");
+   Mem_Check : Profile_Type := External ("Standard_Common_Mem_Check", "Off");
+
+   package Compiler is
+      -- Switches for gcc
+
+      Base_Style_Checks := "-gnaty3abcefhiklnOprtx";
+      Line_Length := "-gnatyM120";
+
+      Style_Checks := (Base_Style_Checks, Line_Length);
+
+      Common_Switches :=
+        (
+         "-fstack-check",
+         "-g",
+         "-gnat2012",
+         "-gnatfoqQ",
+         "-gnatw.d",
+         "-gnatwaBCeJL",
+         "-gnatyO"
+        );
+
+      --  -gnatVa causes some inline procedures to be non-inlineable;
+      --  suppress that warning with -gnatwP.
+      Debug_Switches := Common_Switches &
+        (
+         "-O0",
+         "-gnata",  -- assertions, pre/post-conditions
+         "-gnatVa", -- validity checks
+         "-gnateE", -- extra info in exceptions
+         "-gnatwaP"
+        );
+
+      --  -O3 is measurably faster than -O2 for wisitoken generate
+      --  LR1. We include -fstack-check because it catches
+      --  hard-to-find bugs, and the processors are so fast.
+      --  -fno-var-tracking-assignments speeds compiling of large
+      --  files; var tracking is only useful for debugging.
+      Base_Release_Switches := Common_Switches &
+        (
+         "-O3",
+         "-fno-var-tracking-assignments",
+         "-gnatyO"
+        );
+
+      Inlining := ("-gnatn");
+
+      Release_Switches := Base_Release_Switches & Inlining;
+
+      -- No -ansi; GNAT 7.1 compiler C header files are mingw 64, which don't 
support -ansi
+      Debug_Switches_C := ("-Wall", "-Wstrict-prototypes", "-pedantic", 
"-Werror", "-g", "-O0", "-funwind-tables");
+      Debug_Switches_C_Non_Pedantic := ("-Wall", "-Wstrict-prototypes", 
"-Werror", "-g", "-O0", "-funwind-tables");
+      Release_Switches_C := ("-Wall", "-Wstrict-prototypes", "-pedantic", 
"-Werror", "-g", "-O2", "-funwind-tables");
+      Release_Switches_C_Non_Pedantic := ("-Wall", "-Wstrict-prototypes", 
"-Werror", "-g", "-O2", "-funwind-tables");
+
+   end Compiler;
+
+   --  In project files, normally use this:
+   --  package Compiler is
+   --  for Default_Switches ("Ada") use
+   --     Standard_Common.Compiler.Release_Switches &
+   --     Standard_Common.Compiler.Style_Checks;
+   --  end Compiler;
+
+   package Builder is
+      --  Switches for gnatmake
+      for Default_Switches ("Ada") use ("-C");
+   end Builder;
+
+   --  In project files, normally use this:
+   --  package Builder is
+   --     for Default_Switches ("Ada") use 
Standard_Common.Builder'Default_Switches ("Ada");
+   --  end Builder;
+
+   package Binder is
+      --  Switches for gnatbind
+      for Default_Switches ("Ada") use ("-E");
+
+      Debug_Configuration_Pragmas := "Normalize_Scalars";
+   end Binder;
+
+   --  In project files, normally use this:
+   --  package Binder is
+   --     for Default_Switches ("Ada") use 
Standard_Common.Binder'Default_Switches ("Ada");
+   --  end Binder;
+
+   package Linker is
+      case Profile is
+      when "On" =>
+         case Mem_Check is
+         when "On" =>
+            for Linker_Options use ("-pg", "-lgmem");
+         when "Off" =>
+            for Linker_Options use ("-pg");
+         end case;
+
+      when "Off" =>
+         case Mem_Check is
+         when "On" =>
+            for Linker_Options use ("-lgmem");
+         when "Off" =>
+            null;
+         end case;
+      end case;
+   end Linker;
+
+   --  In project files, no linker package is needed.
+end Standard_Common;
diff --git a/wisi-compat-24.2.el b/wisi-compat-24.2.el
deleted file mode 100644
index 03bae80..0000000
--- a/wisi-compat-24.2.el
+++ /dev/null
@@ -1,34 +0,0 @@
-;;; wisi-compat-24.2.el --- Implement current Emacs features not present in 
Emacs 24.2  -*- lexical-binding:t -*-
-
-;; Copyright (C) 2014-2015 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/>.
-
-;; using cl-lib 0.4 from Gnu ELPA
-
-(when (not (boundp 'defvar-local))
-  (defmacro defvar-local (var val &optional docstring)
-    "Define VAR as a buffer-local variable with default value VAL.
-Like `defvar' but additionally marks the variable as being automatically
-buffer-local wherever it is set."
-    (declare (debug defvar) (doc-string 3))
-    ;; Can't use backquote here, it's too early in the bootstrap.
-    (list 'progn (list 'defvar var val docstring)
-         (list 'make-variable-buffer-local (list 'quote var))))
-  )
-
-(provide 'wisi-compat-24.2)
-;;; wisi-compat-24.2.el ends here
diff --git a/wisi-compile.el b/wisi-compile.el
index 420621a..9788938 100644
--- a/wisi-compile.el
+++ b/wisi-compile.el
@@ -1,6 +1,6 @@
 ;; wisi-compile.el --- Grammar compiler for the wisi parser, integrating Wisi 
OpenToken output.  -*- lexical-binding:t -*-
 ;;
-;; Copyright (C) 2012-2013, 2015-2017 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
 ;;
 ;; Author: Stephen Leake <stephen_leake@member.fsf.org>
 ;;
@@ -117,7 +117,7 @@ NONTERM is the nonterminal left hand side.
 IACTN is the index of the production in the NTERM rule.
 
 The semantic action function accepts two arguments;
-- $nterm      : the nonterminal
+- wisi-nterm  : the nonterminal
 - wisi-tokens : the list of tokens to be reduced.
 
 It returns nil; it is called for the semantic side-effects only."
@@ -126,16 +126,14 @@ It returns nil; it is called for the semantic 
side-effects only."
         (action-symbol (intern name symbol-obarray)))
 
     (fset action-symbol
-         `(lambda ($nterm wisi-tokens)
+         `(lambda (wisi-nterm wisi-tokens)
             ,form
             nil))
     (byte-compile action-symbol)))
 
 (defun wisi-compile-grammar (grammar)
   "Compile the LALR(1) GRAMMAR; return the automaton for wisi-parse.
-GRAMMAR is a list TERMINALS NONTERMS ACTIONS GOTOS, where:
-
-TERMINALS is a list of terminal token symbols.
+GRAMMAR is a list NONTERMS ACTIONS GOTOS, where:
 
 NONTERMS is a list of productions; each production is a
 list (nonterm (tokens semantic-action) ...) where `semantic-action' is
@@ -151,10 +149,10 @@ terminal tokens. The value of each item in the alists is 
one of:
 
 integer - shift; gives new state
 
-(nonterm . index) - reduce by nonterm production index.
+ (nonterm . index) - reduce by nonterm production index.
 
-(integer (nonterm . index)) - a shift/reduce conflict
-((nonterm . index) (nonterm . index)) - a reduce/reduce conflict
+ (integer (nonterm . index)) - a shift/reduce conflict
+ ((nonterm . index) (nonterm . index)) - a reduce/reduce conflict
 
 The first item in the alist must have the key `default' (not a
 terminal token); it is used when no other item matches the
@@ -185,14 +183,8 @@ implement the semantic action for each nonterminal; the 
function
 names have the format nonterm:index."
   ;; We store named symbols for semantic actions, not just lambda
   ;; functions, so we have a name for debug trace.
-  ;;
-  ;; FIXME: TERMINALS is not used. Eliminating it requires decoupling
-  ;; from OpenToken; we'll do that in the move to FastToken.
-  ;;
-  ;; FIXME: eliminate use of semantic-lex-* in *-wy.el. Similarly
-  ;; requires decoupling from OpenToken
-
-  (let ((defs (nth 1 grammar))
+
+  (let ((defs (nth 0 grammar))
        (symbol-obarray (make-vector 13 0));; for parse actions
         (byte-compile-warnings '(not free-vars)) ;; for "wisi-test-success" in 
test/wisi/*
        def nonterm rhs-list rule
@@ -216,16 +208,16 @@ names have the format nonterm:index."
        ))
 
     ;; replace semantic actions in ACTIONS with symbols from symbol-obarray
-    (let ((nactions (length (nth 2 grammar)))
-         (actions (nth 2 grammar))
+    (let ((nactions (length (nth 1 grammar)))
+         (actions (nth 1 grammar))
          (i 0))
       (while (< i nactions)
        (aset actions i
-             (wisi-replace-actions (aref actions i) symbol-obarray (nth 1 
grammar)))
+             (wisi-replace-actions (aref actions i) symbol-obarray (nth 0 
grammar)))
        (setq i (1+ i)))
       (vector
        actions
-       (nth 3 grammar)
+       (nth 2 grammar)
        symbol-obarray)
       )))
 
diff --git a/wisi-elisp-lexer.el b/wisi-elisp-lexer.el
new file mode 100644
index 0000000..b0d1e3c
--- /dev/null
+++ b/wisi-elisp-lexer.el
@@ -0,0 +1,393 @@
+;;; wisi-elisp-lexer.el --- A lexer for wisi, implemented in elisp -*- 
lexical-binding:t -*-
+;;
+;; Copyright (C) 2017, 2018  Free Software Foundation, Inc.
+;;
+;; Author: Stephen Leake <stephen_leake@stephe-leake.org>
+;;
+;; 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: see NEWS-wisi.text
+
+(require 'cl-lib)
+(require 'semantic/lex)
+(require 'wisi-parse-common)
+
+(cl-defstruct wisi-elisp-lexer
+  id-alist ;; alist mapping strings to token ids; used by repair error
+  keyword-table ;; obarray holding keyword tokens
+  punctuation-table ;; obarray holding punctuation tokens
+  punctuation-table-max-length ;; max string length in punctuation-table
+  string-double-term ;; non-nil if strings delimited by double quotes
+  string-quote-escape-doubled ;; Non-nil if a string delimiter is escaped by 
doubling it
+  string-quote-escape
+  ;; Cons (delim . character) where `character' escapes quotes in strings 
delimited by `delim'.
+  string-single-term ;; non-nil if strings delimited by single quotes
+  symbol-term ;; symbol for a terminal symbol token
+  number-term ;; symbol for a terminal number literal token
+  number-p ;; function that determines if argument is a number literal
+  line-begin ;; vector of beginning-of-line positions in buffer
+  last-line ;; index into line-begin of line containing last lexed token
+  )
+
+(defun wisi-elisp-lexer-reset (line-count lexer)
+  "Reset lexer to start a new parse. LINE-COUNT is the count of lines in the 
current buffer."
+  (setf (wisi-elisp-lexer-line-begin lexer) (wisi--set-line-begin line-count))
+  (setf (wisi-elisp-lexer-last-line lexer) nil))
+
+(defvar-local wisi--lexer nil
+  "A `wisi-elisp-lexer' struct defining the lexer for the current buffer.")
+
+(defun wisi-elisp-lexer--safe-intern (name obtable)
+  (let ((var (intern-soft name obtable)))
+    (and (boundp var) (symbol-value var))))
+
+(cl-defun wisi-make-elisp-lexer (&key token-table-raw keyword-table-raw 
string-quote-escape-doubled string-quote-escape)
+  "Return a ‘wisi-elisp-lexer’ object."
+  (let* ((token-table (semantic-lex-make-type-table token-table-raw))
+        (keyword-table (semantic-lex-make-keyword-table keyword-table-raw))
+        (left-paren (cadr (wisi-elisp-lexer--safe-intern "left-paren" 
token-table)))
+        (right-paren (cadr (wisi-elisp-lexer--safe-intern "right-paren" 
token-table)))
+        (punctuation-table (wisi-elisp-lexer--safe-intern "punctuation" 
token-table))
+        (punct-max-length 0)
+        (number (cadr (wisi-elisp-lexer--safe-intern "number" token-table)))
+        (symbol (cadr (wisi-elisp-lexer--safe-intern "symbol" token-table)))
+        (string-double (cadr (wisi-elisp-lexer--safe-intern "string-double" 
token-table)))
+        (string-single (cadr (wisi-elisp-lexer--safe-intern "string-single" 
token-table)))
+        id-alist
+        fail)
+    (dolist (item punctuation-table)
+      ;; 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))
+
+      ;; accumulate max length
+      (when (< punct-max-length (length (cdr item)))
+       (setq punct-max-length (length (cdr item))))
+
+      ;; build id-alist
+      (push item id-alist)
+      )
+
+    (when fail
+      (error "aborting due to punctuation errors"))
+
+    (when number
+      (push (cons (nth 0 number) "1234") id-alist)
+      (when (nth 2 number)
+       (require (nth 2 number)))) ;; for number-p
+
+    (when left-paren
+      (push left-paren id-alist)
+      (set (intern (cdr left-paren) keyword-table) (car left-paren)))
+    (when right-paren
+      (push right-paren id-alist)
+      (set (intern (cdr right-paren) keyword-table) (car right-paren)))
+
+    (when symbol
+      (push (cons (car symbol) "a_bogus_identifier") id-alist))
+
+    (when string-double
+      (push (cons (car string-double) "\"\"") id-alist))
+
+    (when string-single
+      (push (cons (car string-single) "''") id-alist))
+
+    (dolist (item keyword-table-raw)
+      (push (cons (cdr item) (car item)) id-alist))
+
+    (make-wisi-elisp-lexer
+     :id-alist id-alist
+     :keyword-table keyword-table
+     :punctuation-table punctuation-table
+     :punctuation-table-max-length punct-max-length
+     :string-double-term (car string-double)
+     :string-quote-escape-doubled string-quote-escape-doubled
+     :string-quote-escape string-quote-escape
+     :string-single-term (car string-single)
+     :symbol-term (car symbol)
+     :number-term (nth 0 number)
+     :number-p (nth 1 number)
+     )
+    ))
+
+(defun wisi-number-p (token-text)
+  ;; Not ’wisi-elisp-lexer-number-p’, because this can appear in grammar files.
+  "Return t if TOKEN-TEXT plus text after point matches the
+syntax for a real literal; otherwise nil.  Point is after
+TOKEN-TEXT; move point to just past token."
+  ;; Typical literals:
+  ;; 1234
+  ;; 1234.5678
+  ;; _not_ including non-decimal base, or underscores (see ada-wisi-number-p)
+  ;;
+  ;; Starts with a simple integer
+  (when (string-match "^[0-9]+$" token-text)
+    (when (looking-at "\\.[0-9]+")
+      ;; real number
+      (goto-char (match-end 0))
+      (when (looking-at  "[Ee][+-][0-9]+")
+        ;; exponent
+        (goto-char (match-end 0))))
+
+    t
+    ))
+
+(defun wisi-forward-token ()
+  ;; Not ’wisi-elisp-lexer-forward-token’, for backward compatibility
+  "Move point forward across one token, then skip whitespace and comments.
+Return the corresponding token as a `wisi-tok'.
+If at whitespace or comment, throw an error.
+If at end of buffer, return `wisi-eoi-term'."
+  (let ((start (point))
+       ;; (info "(elisp)Syntax Table Internals" "*info elisp syntax*")
+       end
+       (syntax (syntax-class (syntax-after (point))))
+       (first nil)
+       (comment-line nil)
+       (comment-end nil)
+       token-id token-text line)
+    (cond
+     ((eobp)
+      (setq token-id wisi-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-elisp-lexer-punctuation-table wisi--lexer))))
+         (when temp-id
+           (setq token-id temp-id
+                 next-point (point)))
+         (if (or
+              (eobp)
+              (= (- (point) start) 
(wisi-elisp-lexer-punctuation-table-max-length wisi--lexer)))
+             (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-elisp-lexer-keyword-table wisi--lexer)))))
+
+     ((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))
+       (condition-case err
+           (progn
+             (forward-sexp)
+
+             ;; point is now after the end quote; check for an escaped quote
+             (while (or
+                     (and (wisi-elisp-lexer-string-quote-escape-doubled 
wisi--lexer)
+                          (eq (char-after (point)) delim))
+                     (and (eq delim (car (wisi-elisp-lexer-string-quote-escape 
wisi--lexer)))
+                          (eq (char-before (1- (point))) (cdr 
(wisi-elisp-lexer-string-quote-escape wisi--lexer)))))
+               (forward-sexp))
+             (setq token-id (if (= delim ?\")
+                                (wisi-elisp-lexer-string-double-term 
wisi--lexer)
+                              (wisi-elisp-lexer-string-single-term 
wisi--lexer))))
+         (scan-error
+          ;; Something screwed up; we should not get here if
+          ;; syntax-propertize works properly.
+          (signal 'wisi-parse-error (format "wisi-forward-token: forward-sexp 
failed %s" err))
+          ))))
+
+     ((memq syntax '(2 3 6)) ;; word, symbol, expression prefix (includes 
numbers)
+      (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-elisp-lexer-keyword-table wisi--lexer)))
+               (and (functionp (wisi-elisp-lexer-number-p wisi--lexer))
+                    (funcall (wisi-elisp-lexer-number-p wisi--lexer) 
token-text)
+                    (setq token-text (buffer-substring-no-properties start 
(point)))
+                    (wisi-elisp-lexer-number-term wisi--lexer))
+               (wisi-elisp-lexer-symbol-term wisi--lexer)))
+      )
+
+     (t
+      (signal 'wisi-parse-error (format "wisi-forward-token: unsupported 
syntax %s" syntax)))
+
+     );; cond
+
+    (unless token-id
+      (signal 'wisi-parse-error
+             (wisi-error-msg "unrecognized token '%s'" 
(buffer-substring-no-properties start (point)))))
+
+    (setq end (point))
+
+    (forward-comment (point-max))
+
+    (when (and (not (eq token-id wisi-eoi-term))
+              (eq wisi--parse-action 'indent))
+      ;; parsing for indent; track line numbers
+
+      (if (wisi-elisp-lexer-last-line wisi--lexer)
+         (progn
+           (setq line (wisi-elisp-lexer-last-line wisi--lexer))
+           (when (>= start (aref (wisi-elisp-lexer-line-begin wisi--lexer) 
line))
+             ;; first token on next non-blank line
+             (setq line (1+ line))
+             (setq first t))
+           ;; else other token on line
+           )
+
+       ;; First token on first non-comment line
+       (setq line (line-number-at-pos start))
+       (setq first t)
+       )
+      (setf (wisi-elisp-lexer-last-line wisi--lexer) line)
+
+      ;; set comment-line, comment-end
+      (when (and (< (1+ (wisi-elisp-lexer-last-line wisi--lexer)) (length 
(wisi-elisp-lexer-line-begin wisi--lexer)))
+                (>= (point) (aref (wisi-elisp-lexer-line-begin wisi--lexer)
+                                (1+ (wisi-elisp-lexer-last-line 
wisi--lexer)))))
+       (setq comment-line (1+ (wisi-elisp-lexer-last-line wisi--lexer)))
+       (setf (wisi-elisp-lexer-last-line wisi--lexer) comment-line)
+       (setq comment-end (line-end-position 0)))
+
+      ;; count blank or comment lines following token
+      (when comment-end
+       (while (and (< (1+ (wisi-elisp-lexer-last-line wisi--lexer)) (length 
(wisi-elisp-lexer-line-begin wisi--lexer)))
+                   (>= comment-end (aref (wisi-elisp-lexer-line-begin 
wisi--lexer) (wisi-elisp-lexer-last-line wisi--lexer))))
+         (setf (wisi-elisp-lexer-last-line wisi--lexer) (1+ 
(wisi-elisp-lexer-last-line wisi--lexer))))
+
+      ))
+
+    (make-wisi-tok
+     :token token-id
+     :region (cons start end)
+     :line line
+     :first first
+     :comment-end comment-end
+     :comment-line comment-line)
+    ))
+
+(defun wisi-backward-token ()
+  ;; Not ’wisi-elisp-lexer-backward-token’, for backward compatibility
+  "Move point backward across one token, skipping whitespace and comments.
+Does _not_ handle numbers with wisi-number-p; just sees
+lower-level syntax.  Return a `wisi-tok' - same structure as
+wisi-forward-token, but only sets token-id and region."
+  (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)))))
+       token-id token-text)
+    (cond
+     ((bobp) nil)
+
+     ((eq syntax 1)
+      ;; punctuation. Find the longest matching string in 
wisi-lex-punctuation-table
+      (backward-char 1)
+      (let ((next-point (point))
+           temp-text temp-id done)
+       (while (not done)
+         (setq temp-text (buffer-substring-no-properties (point) end))
+         (when (setq temp-id (car (rassoc temp-text 
(wisi-elisp-lexer-punctuation-table wisi--lexer))))
+           (setq token-id temp-id)
+           (setq next-point (point)))
+         (if (or
+              (bobp)
+              (= (- end (point)) 
(wisi-elisp-lexer-punctuation-table-max-length wisi--lexer)))
+             (setq done t)
+           (backward-char 1))
+         )
+       (goto-char next-point))
+      )
+
+     ((memq syntax '(4 5)) ;; open, close parenthesis
+      (backward-char 1)
+      (setq token-id
+           (symbol-value
+            (intern-soft (buffer-substring-no-properties (point) end)
+                         (wisi-elisp-lexer-keyword-table wisi--lexer)))))
+
+     ((eq syntax 7)
+      ;; a string quote. we assume we are after the end quote, not the start 
quote
+      (let ((delim (char-after (1- (point))))
+           (forward-sexp-function nil))
+       (forward-sexp -1)
+       (setq token-id (if (= delim ?\")
+                          (wisi-elisp-lexer-string-double-term wisi--lexer)
+                        (wisi-elisp-lexer-string-single-term wisi--lexer)))
+       ))
+
+     (t ;; assuming word or symbol syntax
+      (if (zerop (skip-syntax-backward "."))
+         (skip-syntax-backward "w_'"))
+      (setq token-text (buffer-substring-no-properties (point) end))
+      (setq token-id
+           (or (symbol-value (intern-soft (downcase token-text) 
(wisi-elisp-lexer-keyword-table wisi--lexer)))
+               (and (functionp (wisi-elisp-lexer-number-p wisi--lexer))
+                    (funcall (wisi-elisp-lexer-number-p wisi--lexer) 
token-text)
+                    (setq token-text (buffer-substring-no-properties (point) 
end))
+                    (wisi-elisp-lexer-number-term wisi--lexer))
+               (wisi-elisp-lexer-symbol-term wisi--lexer))))
+     )
+
+    (make-wisi-tok
+     :token token-id
+     :region (cons (point) end))
+    ))
+
+;;;; Debugging
+
+(defun wisi-lex-buffer (&optional parse-action)
+  ;; for timing the lexer
+  (interactive)
+  (when (< emacs-major-version 25) (syntax-propertize (point-max)))
+
+  (let* ((wisi--parse-action (or parse-action 'indent))
+        (line-count (1+ (count-lines (point-min) (point-max))))
+        )
+
+    (cl-case wisi--parse-action
+      (indent
+       (setf (wisi-elisp-lexer-last-line wisi--lexer) nil)
+       (setf (wisi-elisp-lexer-line-begin wisi--lexer) (wisi--set-line-begin 
line-count)))
+      (t nil))
+
+    (goto-char (point-min))
+    (while (forward-comment 1))
+    (while (not (eq wisi-eoi-term (wisi-tok-token (wisi-forward-token)))))
+    ))
+
+(defun wisi-show-token ()
+  "Move forward across one keyword, show token."
+  (interactive)
+  (let* ((wisi--parse-action nil)
+        (token (wisi-forward-token)))
+    (message "%s" token)))
+
+
+(provide 'wisi-elisp-lexer)
+;;; end of file
diff --git a/wisi-elisp-parse.el b/wisi-elisp-parse.el
new file mode 100644
index 0000000..83ddba2
--- /dev/null
+++ b/wisi-elisp-parse.el
@@ -0,0 +1,1682 @@
+;; 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
diff --git a/wisi-fringe.el b/wisi-fringe.el
new file mode 100644
index 0000000..7f1c10b
--- /dev/null
+++ b/wisi-fringe.el
@@ -0,0 +1,146 @@
+;;; wisi-fringe.el --- show approximate error locations in the fringe
+;;
+;; Copyright (C) 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/>.
+;;
+;; Design:
+;;
+;; Bitmaps are displayed in the fringe by putting a 'display property
+;; on buffer text. However, just doing that also hides the buffer
+;; text. To avoid that, we put the ’display property on a string, and
+;; then an overlay containing that string as ’before-string or
+;; ’after-string on the newline of a buffer line.
+;;
+;; We show approximate error positions in the entire buffer with
+;; single-pixel lines in the right fringe, and mark error lines with
+;; ’!!’ in the left fringe.
+
+(defun wisi-fringe-create-bitmaps ()
+  "Return an array of bitmap symbols containing the fringe bitmaps."
+  ;; First create the ’!!’ bitmap.
+  (define-fringe-bitmap 'wisi-fringe--double-exclaim-bmp
+    (vector
+     #b00000000
+     #b01100110
+     #b01100110
+     #b01100110
+     #b01100110
+     #b01100110
+     #b00000000
+     #b01100110
+     #b01010110
+     #b00000000))
+
+  ;; In condensing the entire buffer to the current window height, we
+  ;; assume a 10 point font, which allows 6 distinct line positions
+  ;; each one pixel high, with one blank pixel between.
+
+  (let ((result (make-vector 64 nil))
+       (i 1))
+    (while (<= i (length result))
+      (aset result (1- i)
+           (define-fringe-bitmap (intern (format "wisi-fringe--line-%d-bmp" i))
+             (vector
+              (if (>= i 32) #b11111111 #b00000000)
+              #b00000000
+              (if (>= (% i 32) 16) #b11111111 #b00000000)
+              #b00000000
+              (if (>= (% i 16) 8) #b11111111 #b00000000)
+              #b00000000
+              (if (>= (% i 8) 4) #b11111111 #b00000000)
+              #b00000000
+              (if (>= (% i 4) 2) #b11111111 #b00000000)
+              #b00000000
+              (if (>= (% i 2) 1) #b11111111 #b00000000)
+              )))
+      (setq i (1+ i)))
+    result))
+
+(defconst wisi-fringe-bitmaps (wisi-fringe-create-bitmaps)
+  "Array of 64 bitmap symbols.")
+
+(defun wisi-fringe--put-right (line bitmap-index)
+  (save-excursion
+    (goto-char (point-min))
+    (forward-line (1- line))
+    (let* ((endpos (line-end-position))
+          (ov (make-overlay endpos (1+ endpos)))
+          (bmp (aref wisi-fringe-bitmaps bitmap-index)))
+      (overlay-put ov 'after-string (propertize "-" 'display (list 
'right-fringe bmp 'compilation-error)))
+      (overlay-put ov 'wisi-fringe t)
+      )))
+
+(defun wisi-fringe--put-left (line)
+  (save-excursion
+    (goto-char (point-min))
+    (forward-line (1- line))
+    (let* ((endpos (line-end-position))
+          (ov (make-overlay endpos (1+ endpos)))
+          (bmp 'wisi-fringe--double-exclaim-bmp))
+      (overlay-put ov 'before-string (propertize "-" 'display (list 
'left-fringe bmp 'compilation-error)))
+      (overlay-put ov 'wisi-fringe t)
+      )))
+
+(defun wisi-fringe--scale (error-line buffer-lines window-line-first 
window-lines)
+  "Return a cons (LINE . BIN) for ERROR-LINE,
+where LINE is the line to display the error bar on, and BIN is a
+6-bit bit vector giving the relative position in that line.
+BUFFER-LINES is the count of lines in the buffer.
+WINDOW-LINE-FIRST is the first and last lines of the buffer
+visible in the window. WINDOW-LINES is the count of lines visible
+in the window."
+  ;; If the end of buffer is inside the window, and this calculation
+  ;; puts a mark after that, it will actually be put on the last real
+  ;; line. That’s good enough for our purposes.
+
+  ;; partial-lines / window-line = 6
+  ;; buffer-lines / window-line = 1/scale
+  ;; buffer-lines / partial-line  = (window-line / partial-lines) * 
(buffer-lines / window-line) = 1/6 * 1/scale
+  (let* ((scale (/ window-lines (float buffer-lines)))
+        (line (floor (* scale error-line)))
+        (rem (- error-line (floor (/ line scale)))))
+    (cons (+ window-line-first line) (lsh 1 (min 5 (floor (* rem (* 6 
scale))))))))
+
+(defun wisi-fringe-display-errors (positions)
+  "Display a bar in the right fringe for each buffer position in POSITIONS.
+The buffer containing POSITIONS must be current, and the window
+displaying that buffer must be current."
+  ;; FIXME: recompute fringe display on scroll!
+  (remove-overlays (point-min) (point-max) 'wisi-fringe t)
+  (let (scaled-posns
+       (buffer-lines (line-number-at-pos (point-max)))
+       (window-lines (window-height))
+       (window-pos-first (window-start))
+       (window-pos-last  (window-end))
+       (window-line-first (line-number-at-pos (window-start))))
+    (dolist (pos positions)
+      (let* ((line (line-number-at-pos pos))
+            (scaled-pos (wisi-fringe--scale line buffer-lines 
window-line-first window-lines)))
+       (when (and (>= pos window-pos-first)
+                  (<= pos window-pos-last))
+         (wisi-fringe--put-left line))
+       (if (and scaled-posns
+                (= (caar scaled-posns) (car scaled-pos)))
+           (setcdr (car scaled-posns) (logior (cdar scaled-posns) (cdr 
scaled-pos)))
+         (push scaled-pos scaled-posns))
+       ))
+
+    (dolist (pos scaled-posns)
+      (wisi-fringe--put-right (car pos) (1- (cdr pos))))
+    ))
+
+(provide 'wisi-fringe)
diff --git a/wisi-parse-common.el b/wisi-parse-common.el
new file mode 100644
index 0000000..3aa2c92
--- /dev/null
+++ b/wisi-parse-common.el
@@ -0,0 +1,341 @@
+;;; wisi-parse-common.el --- declarations used by wisi-parse.el, 
wisi-ada-parse.el, and wisi.el
+;;
+;; Copyright (C) 2014, 2015, 2017, 2018  Free Software Foundation, Inc.
+;;
+;; Author: Stephen Leake <stephen_leake@member.fsf.org>
+;;
+;; 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/>.
+
+;;; Code:
+
+(cl-defstruct (wisi--lexer-error)
+  pos ;; position (integer) in buffer where error was detected.
+  message  ;; string error message
+  inserted ;; char inserted after pos.
+  )
+
+(cl-defstruct (wisi--parse-error-repair)
+  pos ;; position (integer) in buffer where insert/delete is done.
+  inserted ;; list of token IDs that were inserted before pos
+  deleted  ;; list of token IDs that were deleted after pos
+  )
+
+(cl-defstruct (wisi--parse-error)
+  ;; Includes information derived from compiler error recovery to edit
+  ;; text to fix one error. Used by ’wisi-repair-error’ to edit buffer.
+  pos      ;; position (integer or marker) in buffer where error was detected.
+  message  ;; string error message
+  repair   ;; list of wisi--parse-error-repair.
+  )
+
+(cl-defstruct wisi-parser
+  ;; Separate lists for lexer and parse errors, because lexer errors
+  ;; must be repaired first, before parse errors can be repaired. And
+  ;; they have different structures.
+  lexer-errors
+  ;; list of wisi--lexer-errors from last parse.  Can be more than one if
+  ;; lexer supports error recovery.
+  parse-errors
+  ;; List of wisi--parse-errors from last parse. Can be more than one if
+  ;; parser supports error recovery.
+)
+
+(cl-defgeneric wisi-parse-format-language-options ((parser wisi-parser))
+  "Return a string to be sent to the parser, containing settings
+for the language-specific parser options."
+  ;; not needed for the elisp parser, which can see the options directly.
+  )
+
+(cl-defgeneric wisi-parse-current ((parser wisi-parser))
+  "Parse current buffer.")
+
+(cl-defgeneric wisi-parse-kill ((parser wisi-parser))
+  "Kill any external process associated with parser.")
+
+(cl-defgeneric wisi-parse-find-token ((parser wisi-parser) token-symbol)
+  "Find token with TOKEN-SYMBOL on current parser stack, return token struct.
+For use in grammar actions.")
+
+(cl-defgeneric wisi-parse-stack-peek ((parser wisi-parser) n)
+  "Return the Nth token on the parse stack.
+For use in grammar actions.")
+
+(cl-defstruct
+  (wisi-cache
+   (:constructor wisi-cache-create)
+   (:copier nil))
+  nonterm;; nonterminal from parse
+
+  token
+  ;; terminal symbol from wisi-keyword-table or
+  ;; wisi-punctuation-table, or lower-level nonterminal from parse
+
+  last ;; pos of last char in token, relative to first (0 indexed)
+
+  class ;; one of wisi-class-list
+
+  containing
+  ;; Marker at the start of the containing statement for this token.
+  ;; 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
+  )
+
+(defun wisi-get-cache (pos)
+  "Return `wisi-cache' struct from the `wisi-cache' text property at POS."
+  (get-text-property pos 'wisi-cache))
+
+(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."
+  ;; If point is not near cache, p-s-p-c will return pos just after
+  ;; cache, so 1- is the beginning of cache.
+  ;;
+  ;; If point is just after end of cache, p-s-p-c will return pos at
+  ;; start of cache.
+  ;;
+  ;; So we test for the property before subtracting 1.
+  (let ((pos (previous-single-property-change (point) 'wisi-cache))
+       cache)
+    (cond
+     ((null pos)
+      (goto-char (point-min))
+      nil)
+
+     ((setq cache (get-text-property pos 'wisi-cache))
+      (goto-char pos)
+      cache)
+
+     (t
+      (setq pos (1- pos))
+      (setq cache (get-text-property pos 'wisi-cache))
+      (goto-char pos)
+      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-cache-region (cache &optional start)
+  "Return region designated by START (default point) to cache last."
+  (unless start (setq start (point)))
+  (cons start (+ start (wisi-cache-last cache))))
+
+(defvar wisi-debug 0
+  "wisi debug mode:
+0 : normal - ignore parse errors, for indenting new code
+1 : report parse errors (for running tests)
+2 : show parse states, position point at parse errors
+3 : also show top 10 items of parser stack.")
+
+;; The following parameters are easily changeable for debugging.
+(defvar wisi-action-disable nil
+  "If non-nil, disable all elisp actions during parsing.
+Allows timing parse separate from actions.")
+
+(defvar-local wisi-trace-mckenzie 0
+  "McKenzie trace level; 0 for none")
+
+(defvar-local wisi-trace-action 0
+  "Parse action trace level; 0 for none")
+
+(defvar-local wisi-mckenzie-disable nil
+  "If non-nil, disable McKenzie error recovery. Otherwise, use parser 
default.")
+
+(defcustom wisi-mckenzie-task-count nil
+  "If integer, sets McKenzie error recovery task count.
+Higher value (up to system processor limit) runs error recovery
+faster, but may encounter race conditions.  Using only one task
+makes error recovery repeatable; useful for tests.  If nil, uses
+value from grammar file."
+  :type 'integer
+  :group 'wisi
+  :safe 'integerp)
+(make-variable-buffer-local 'wisi-mckenzie-task-count)
+
+(defcustom wisi-mckenzie-cost-limit nil
+  "If integer, sets McKenzie error recovery algorithm cost limit.
+Higher value has more recover power, but takes longer.  If nil,
+uses value from grammar file."
+  :type 'integer
+  :group 'wisi
+  :safe 'integerp)
+(make-variable-buffer-local 'wisi-mckenzie-cost-limit)
+
+(defcustom wisi-mckenzie-check-limit nil
+  "If integer, sets McKenzie error recovery algorithm token check limit.
+This sets the number of tokens past the error point that must be
+parsed successfully for a solution to be deemed successful.
+Higher value gives better solutions, but may fail if there are
+two errors close together.  If nil, uses value from grammar
+file."
+  :type 'integer
+  :group 'wisi
+  :safe 'integerp)
+(make-variable-buffer-local 'wisi-mckenzie-check-limit)
+
+(defcustom wisi-mckenzie-enqueue-limit nil
+  "If integer, sets McKenzie error recovery algorithm enqueue limit.
+This sets the maximum number of solutions that will be considered.
+Higher value has more recover power, but will be slower to fail.
+If nil, uses value from grammar file."
+  :type 'integer
+  :group 'wisi
+  :safe 'integerp)
+(make-variable-buffer-local 'wisi-mckenzie-enqueue-limit)
+
+(defvar wisi-parse-max-parallel 15
+  "Maximum number of parallel parsers during regular parsing.
+Parallel parsers are used to resolve redundancy in the grammar.
+If a file needs more than this, it's probably an indication that
+the grammar is excessively redundant.")
+
+(defvar wisi-parse-max-stack-size 500
+  "Maximum parse stack size.
+Larger stack size allows more deeply nested constructs.")
+;; end of easily changeable parameters
+
+(defvar wisi--parse-action nil
+  ;; not buffer-local; only let-bound in wisi-indent-region, 
wisi-validate-cache
+  "Reason current parse is begin run; one of
+{indent, face, navigate}.")
+
+(defvar-local wisi-indent-comment-col-0 nil
+  "If non-nil, comments currently starting in column 0 are left in column 0.
+Otherwise, they are indented with previous comments or code.
+Normally set from a language-specific option.")
+
+(defvar-local wisi-end-caches nil
+  "List of buffer positions of caches in current statement that need 
wisi-cache-end set.")
+
+(defconst wisi-eoi-term 'Wisi_EOI
+  ;; must match FastToken wisi-output_elisp.adb EOI_Name, which must
+  ;; be part of a valid Ada identifer.
+  "End Of Input token.")
+
+(defconst wisi-class-list
+  [motion ;; motion-action
+   name ;; for which-function
+   statement-end
+   statement-override
+   statement-start
+   misc ;; other stuff
+   ]
+  "array of valid token classes; checked in wisi-statement-action, used in 
wisi-process-parse.")
+
+(defun wisi-error-msg (message &rest args)
+  (let ((line (line-number-at-pos))
+       (col (- (point) (line-beginning-position))))
+    (format
+     "%s:%d:%d: %s"
+       (buffer-name) ;; buffer-file-name is sometimes nil here!?
+       line col
+       (apply 'format message args))))
+
+(defvar wisi-parse-error nil)
+(put 'wisi-parse-error
+     'error-conditions
+     '(error wisi-parse-error))
+(put 'wisi-parse-error
+     'error-message
+     "wisi parse error")
+
+(cl-defstruct wisi-tok
+  token  ;; symbol from a token table ;; IMPROVEME: rename to ’id’?
+  region ;; cons giving buffer region containing token text
+
+  nonterminal ;; t if a nonterminal
+
+  line ;; Line number at start of token. Nil for empty nonterminals
+
+  first
+  ;; For terminals, t if token is the first token on a line.
+  ;;
+  ;; For nonterminals, line number of first contained line (not
+  ;; including trailing comments) that needs indenting; it is a
+  ;; comment, or begins with a contained token.
+  ;;
+  ;; Otherwise nil.
+
+  ;; The following are non-nil if token (terminal or non-terminal) is
+  ;; followed by blank or comment lines
+  comment-line ;; first blank or comment line following token
+  comment-end ;; position at end of blank or comment lines
+  )
+
+(defun wisi-token-text (token)
+  "Return buffer text from token range."
+  (let ((region (wisi-tok-region token)))
+    (and region
+       (buffer-substring-no-properties (car region) (cdr region)))))
+
+(defun wisi-and-regions (left right)
+  "Return region enclosing both LEFT and RIGHT."
+  (if left
+      (if right
+         (cons (min (car left) (car right))
+               (max (cdr left) (cdr right)))
+       left)
+    right))
+
+(defun wisi--set-line-begin (line-count)
+  "Return a vector of line-beginning positions, with length LINE-COUNT."
+  (let ((result (make-vector line-count 0)))
+    (save-excursion
+      (goto-char (point-min))
+
+      (dotimes (i line-count)
+       (aset result i (point))
+       (forward-line 1)))
+    result))
+
+;;;; debugging
+(defun wisi-tok-debug-image (tok)
+  "Return id and region from TOK, as string."
+  (cond
+   ((wisi-tok-region tok)
+    (format "(%s %d . %d)"
+           (wisi-tok-token tok)
+           (car (wisi-tok-region tok))
+           (cdr (wisi-tok-region tok))))
+   (t
+    (format "(%s)" (wisi-tok-token tok)))
+   ))
+
+(provide 'wisi-parse-common)
diff --git a/wisi-parse.el b/wisi-parse.el
deleted file mode 100755
index 0076fe5..0000000
--- a/wisi-parse.el
+++ /dev/null
@@ -1,549 +0,0 @@
-;;; wisi-parse.el --- Wisi parser  -*- lexical-binding:t -*-
-
-;; Copyright (C) 2013-2015  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 'semantic/wisent)
-
-;; WORKAROUND: for some reason, this condition doesn't work in batch mode!
-;; (when (and (= emacs-major-version 24)
-;;        (= emacs-minor-version 2))
-  (require 'wisi-compat-24.2)
-;;)
-
-(defvar wisi-parse-max-parallel 15
-  "Maximum number of parallel parsers for acceptable performance.
-If a file needs more than this, it's probably an indication that
-the grammar is excessively redundant.")
-
-(defvar wisi-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 0
-  "wisi debug mode:
-0 : normal - ignore parse errors, for indenting new code
-1 : report parse errors (for running tests)
-2 : show parse states, position point at parse errors, debug-on-error works in 
parser
-3 : also show top 10 items of parser stack.")
-
-(cl-defstruct (wisi-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; see wisi-parse
-
-  stack
-  ;; Each stack item takes two slots: (token-symbol token-text (token-start . 
token-end)), state
-  ;; token-text is nil for nonterminals.
-  ;; this is _not_ the same as the wisent-parse stack; that leaves out 
token-symbol.
-
-  sp ;; stack pointer
-
-  pending
-  ;; list of (action-symbol stack-fragment)
-  )
-
-(defun wisi-error-msg (message &rest args)
-  (let ((line (line-number-at-pos))
-       (col (- (point) (line-beginning-position))))
-    (format
-     "%s:%d:%d: %s"
-       (file-name-nondirectory (buffer-name)) ;; buffer-file-name is sometimes 
nil here!?
-       line col
-       (apply 'format message args))))
-
-(defvar wisi-parse-error nil)
-(put 'wisi-parse-error
-     'error-conditions
-     '(error wisi-parse-error))
-(put 'wisi-parse-error
-     'error-message
-     "wisi parse error")
-
-(defvar-local wisi-cache-max 0
-  "Maximimum position in buffer where wisi-cache text properties are valid.")
-
-(defun wisi-token-text (token)
-  "Return buffer text from token range."
-  (let ((region (cdr token)))
-    (and region
-       (buffer-substring-no-properties (car region) (cdr region)))))
-
-(defun wisi-parse (automaton lexer)
-  "Parse current buffer from bob using the automaton specified in AUTOMATON.
-
-- AUTOMATON is the parse table generated by `wisi-compile-grammar'.
-
-- LEXER is a function with no argument called by the parser to
-  obtain the next token from the current buffer after point, as a
-  list (symbol text start . end), where `symbol' is the terminal
-  symbol, `text' is the token string, `start . end' is the range
-  in the buffer."
-
-  (let* ((actions (aref automaton 0))
-        (gotos   (aref automaton 1))
-        (parser-states ;; vector of parallel parser states
-         (vector
-          (make-wisi-parser-state
-           :label 0
-           :active  'shift
-           :stack   (make-vector wisent-parse-max-stack-size nil)
-           :sp      0
-           :pending nil)))
-        (active-parser-count 1)
-        active-parser-count-prev
-        (active 'shift)
-        (token nil)
-        some-pending
-        )
-
-    (goto-char (point-min))
-    (aset (wisi-parser-state-stack (aref parser-states 0)) 0 0)
-
-    (setq token (funcall lexer))
-    (setq wisi-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-parser-state-active (aref parser-states 
parser-index)))
-         (let* ((parser-state (aref parser-states parser-index))
-                (result (wisi-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)
-               (signal 'wisi-parse-error
-                       (let ((state (aref (wisi-parser-state-stack 
parser-state)
-                                          (wisi-parser-state-sp 
parser-state))))
-                         (wisi-error-msg (concat "too many parallel parsers 
required in grammar state %d;"
-                                                 " simplify grammar, or 
increase `wisi-parse-max-parallel'")
-                                                 state))))
-
-             (let ((j (wisi-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-parser-state-active result)
-                       (cl-case (wisi-parser-state-active result)
-                         (shift 'pending-shift)
-                         (reduce 'pending-reduce)
-                        )))
-                 )
-               (setq active-parser-count (1+ active-parser-count))
-               (when (> active-parser-count (car 
wisi-parse-max-parallel-current))
-                 (setq wisi-parse-max-parallel-current (cons 
active-parser-count (point))))
-               (setf (wisi-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-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; report the error.
-                  (let ((state (aref (wisi-parser-state-stack parser-state)
-                                      (wisi-parser-state-sp parser-state))))
-                    (signal 'wisi-parse-error
-                            (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))))
-                    ))
-                 (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-parser-state-stack 
parser-state)
-                                          (wisi-parser-state-sp 
parser-state))))
-                        (when (eq 'error (wisi-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)))))
-                          )))
-                    (signal 'wisi-parse-error msg)))
-                 ))
-
-               (1
-                (setf (wisi-parser-state-active parser-state) nil); Don't save 
error for later.
-                (let ((parser-state (aref parser-states (wisi-active-parser 
parser-states))))
-                  (wisi-execute-pending (wisi-parser-state-label parser-state)
-                                        (wisi-parser-state-pending 
parser-state))
-                  (setf (wisi-parser-state-pending parser-state) nil)
-                  ))
-               (t
-                ;; We were in a parallel parse, and this parser
-                ;; failed; mark it inactive, don't save error for
-                ;; later.
-                (setf (wisi-parser-state-active parser-state) nil)
-                )))
-           )));; end dotimes
-
-      (when some-pending
-       ;; Change pending-* parsers to *.
-       (dotimes (parser-index (length parser-states))
-         (cond
-          ((eq (wisi-parser-state-active (aref parser-states parser-index)) 
'pending-shift)
-           (setf (wisi-parser-state-active (aref parser-states parser-index)) 
'shift))
-          ((eq (wisi-parser-state-active (aref parser-states parser-index)) 
'pending-reduce)
-           (setf (wisi-parser-state-active (aref parser-states parser-index)) 
'reduce))
-          )))
-
-      (setq active (wisi-parsers-active parser-states active-parser-count))
-      (when (eq active 'shift)
-       (when (> active-parser-count 1)
-         (setq active-parser-count (wisi-parse-elim-identical parser-states 
active-parser-count)))
-
-       (setq token (funcall lexer)))
-    )
-    (when (> active-parser-count 1)
-      (error "ambiguous parse result"))))
-
-(defun wisi-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-parser-state-active (aref parser-states i))
-       (setq result i))
-      (setq i (1+ i)))
-    result))
-
-(defun wisi-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-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-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-parser-state-active (aref parser-states i)))
-       (setq result i))
-      (setq i (1+ i)))
-    (if result result -1)))
-
-(defun wisi-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-parser-state-active (aref parser-states i))
-       (setq result i))
-      (setq i (1+ i)))
-    (unless result
-      (error "no active parsers"))
-    result))
-
-(defun wisi-parse-elim-identical (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-parser-state-active (aref parser-states parser-i))
-      (dotimes (parser-j (- (length parser-states) parser-i 1))
-       (when (wisi-parser-state-active (aref parser-states (+ parser-i 
parser-j 1)))
-         (when (eq (wisi-parser-state-sp (aref parser-states parser-i))
-                    (wisi-parser-state-sp (aref parser-states (+ parser-i 
parser-j 1))))
-           (let ((compare t))
-             (dotimes (stack-i (wisi-parser-state-sp (aref parser-states 
parser-i)))
-               (setq
-                compare
-                (and compare ;; bypass expensive 'arefs' after first stack 
item compare fail
-                     (equal (aref (wisi-parser-state-stack (aref parser-states 
parser-i)) stack-i)
-                            (aref (wisi-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))
-               (setf (wisi-parser-state-active (aref parser-states (+ parser-i 
parser-j 1))) nil)
-               (when (= active-parser-count 1)
-                 ;; the actions for the two parsers are not
-                 ;; identical, but either is good enough for
-                 ;; indentation and navigation, so we just do the
-                 ;; actions for the one that is not terminating.
-                 (let ((parser-state (aref parser-states parser-i)))
-                   (wisi-execute-pending (wisi-parser-state-label parser-state)
-                                         (wisi-parser-state-pending 
parser-state))
-                   (setf (wisi-parser-state-pending parser-state) nil)
-                   ))
-               ))))
-       )))
-  active-parser-count)
-
-(defun wisi-parse-max-pos (tokens)
-  "Return max position in tokens, or point if tokens nil."
-  (let ((result (if tokens 0 (point))))
-    (mapc
-     (lambda (token)
-       (when (cddr token)
-        (setq result (max (cddr token) result))))
-     tokens)
-    result)
-  )
-
-(defun wisi-parse-exec-action (func nonterm tokens)
-  "Execute action if all tokens past wisi-cache-max."
-  ;; We don't execute actions if all tokens are before wisi-cache-max,
-  ;; because later actions can update existing caches, and if the
-  ;; parse fails that won't happen. It also saves time.
-  ;;
-  ;; Also skip if no tokens; nothing to do. This can happen when all
-  ;; tokens in a grammar statement are optional.
-  (if (< 0 (length tokens))
-      (if (>= (wisi-parse-max-pos tokens) wisi-cache-max)
-
-         (funcall func nonterm tokens)
-
-       (when (> wisi-debug 1)
-         (message "... action skipped; before wisi-cache-max %d" 
wisi-cache-max)))
-
-    (when (> wisi-debug 1)
-      (message "... action skipped; no tokens"))
-    ))
-
-(defun wisi-execute-pending (parser-label pending)
-  (when (> wisi-debug 1) (message "%d: pending actions:" parser-label))
-  (while pending
-    (when (> wisi-debug 1) (message "%s" (car pending)))
-
-    (let ((func-args (pop pending)))
-      (wisi-parse-exec-action (nth 0 func-args) (nth 1 func-args) (cl-caddr 
func-args)))
-    ))
-
-(defun wisi-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-parse' for full details.
-Return nil or new parser (a wisi-parse-state struct)."
-  (let* ((state (aref (wisi-parser-state-stack parser-state)
-               (wisi-parser-state-sp parser-state)))
-        (parse-action (wisent-parse-action (car 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-parser-state-sp parser-state)))
-                  (msg (make-vector (+ 1 count) nil)))
-             (dotimes (i count)
-               (aset msg (- count i)
-                     (aref (wisi-parser-state-stack parser-state) (- 
(wisi-parser-state-sp parser-state) i)))
-               )
-             (message "%d: %s: %d: %s"
-                      (wisi-parser-state-label parser-state)
-                      (wisi-parser-state-active parser-state)
-                      (wisi-parser-state-sp parser-state)
-                      msg))
-           (message "   %d: %s: %s" state token parse-action))
-       (message "%d: %d: %s: %s" (wisi-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-parser-state
-            :active  nil
-            :stack   (vconcat (wisi-parser-state-stack parser-state))
-            :sp      (wisi-parser-state-sp parser-state)
-            :pending (wisi-parser-state-pending parser-state)))
-
-      (wisi-parse-2 (cadr parse-action) token new-parser-state t gotos)
-      (setq pendingp t)
-      (setq parse-action (car parse-action))
-      );; when
-
-    ;; current parser
-    (wisi-parse-2 parse-action token parser-state pendingp gotos)
-
-    new-parser-state))
-
-(defun wisi-parse-2 (action token parser-state pendingp gotos)
-  "Execute parser ACTION (must not be a conflict).
-Return nil."
-  (cond
-   ((eq action 'accept)
-    (setf (wisi-parser-state-active parser-state) 'accept))
-
-   ((eq action 'error)
-    (setf (wisi-parser-state-active parser-state) 'error))
-
-   ((natnump action)
-    ;; Shift token and new state (= action) onto stack
-    (let ((stack (wisi-parser-state-stack parser-state)); reference
-         (sp (wisi-parser-state-sp parser-state))); copy
-      (setq sp (+ sp 2))
-      (aset stack (1- sp) token)
-      (aset stack sp action)
-      (setf (wisi-parser-state-sp parser-state) sp))
-    (setf (wisi-parser-state-active parser-state) 'shift))
-
-   (t
-    (wisi-parse-reduce action parser-state pendingp gotos)
-    (setf (wisi-parser-state-active parser-state) 'reduce))
-   ))
-
-(defun wisi-nonterm-bounds (stack i j)
-  "Return a pair (START . END), the buffer region for a nonterminal.
-STACK is the parser stack.  I and J are the indices in STACK of
-the first and last tokens of the nonterminal."
-  (let ((start (cadr (aref stack i)))
-        (end   (cddr (aref stack j))))
-    (while (and (or (not start) (not end))
-               (/= i j))
-      (cond
-       ((not start)
-       ;; item i is an empty production
-       (setq start (cadr (aref stack (setq i (+ i 2))))))
-
-       ((not end)
-       ;; item j is an empty production
-       (setq end (cddr (aref stack (setq j (- j 2))))))
-
-       (t (setq i j))))
-    (and start end (cons start end))))
-
-(defun wisi-parse-reduce (action parser-state pendingp gotos)
-  "Reduce PARSER-STATE.stack, and execute or pend ACTION."
-  (let* ((stack (wisi-parser-state-stack parser-state)); reference
-        (sp (wisi-parser-state-sp parser-state)); copy
-        (token-count (nth 2 action))
-        (nonterm (nth 0 action))
-        (nonterm-region (when (> token-count 0)
-                          (wisi-nonterm-bounds stack (- sp (* 2 (1- 
token-count)) 1) (1- sp))))
-        (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)))
-
-    (when (not new-state)
-      (error "no goto for %s %d" nonterm post-reduce-state))
-
-    (when (nth 1 action)
-      ;; don't need wisi-tokens for a null user action
-      (dotimes (i token-count)
-       (aset tokens (- token-count i 1) (aref stack (- sp (* 2 i) 1)))))
-
-    (setq sp (+ 2 (- sp (* 2 token-count))))
-    (aset stack (1- sp) (cons nonterm nonterm-region))
-    (aset stack sp new-state)
-    (setf (wisi-parser-state-sp parser-state) sp)
-
-    (when (nth 1 action)
-      ;; nothing to do for a null user action
-      (if pendingp
-         (if (wisi-parser-state-pending parser-state)
-             (setf (wisi-parser-state-pending parser-state)
-                   (append (wisi-parser-state-pending parser-state)
-                           (list (list (nth 1 action) nonterm tokens))))
-           (setf (wisi-parser-state-pending parser-state)
-                 (list (list (nth 1 action) nonterm tokens))))
-
-       ;; Not pending.
-       (wisi-parse-exec-action (nth 1 action) nonterm tokens)
-       ))
-    ))
-
-(provide 'wisi-parse)
-;;; wisi-parse.el ends here
diff --git a/wisi-process-parse.el b/wisi-process-parse.el
new file mode 100644
index 0000000..cfc98eb
--- /dev/null
+++ b/wisi-process-parse.el
@@ -0,0 +1,691 @@
+;;; wisi-process-parse.el --- interface to external parse program
+;;
+;; Copyright (C) 2014, 2017, 2018 Free Software Foundation, Inc.
+;;
+;; Author: Stephen Leake <stephen_leake@member.fsf.org>
+;;
+;; 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/>.
+
+(require 'cl-lib)
+(require 'wisi-parse-common)
+
+(defconst wisi-process-parse-prompt "^;;> "
+  "Regexp matching executable prompt; indicates previous command is complete.")
+
+(defconst wisi-process-parse-quit-cmd "004quit\n"
+  "Command to external process telling it to quit.")
+
+(defvar wisi-process-parse-debug 0)
+
+;;;;; sessions
+
+;; The executable builds internal parser structures on startup,
+;; then runs a loop, waiting for parse requests.
+;;
+;; We only need one process per language; there is no persistent state
+;; in the process between parses, and processes are too heavy-weight
+;; to have one per buffer. We use a global alist of parser objects to
+;; find the right one for the current buffer.
+
+(cl-defstruct (wisi-process--parser (:include wisi-parser))
+  (label nil)             ;; string uniquely identifying parser
+  (exec-file nil)        ;; absolute file name of executable
+  (exec-opts nil)         ;; list of process start options for executable
+  (token-table nil)       ;; vector of token symbols, indexed by integer
+  (face-table nil)       ;; vector of face symbols, indexed by integer
+  (busy nil)              ;; t while parser is active
+  (process nil)          ;; running *_wisi_parse executable
+  (buffer nil)                   ;; receives output of executable
+  line-begin              ;; vector of beginning-of-line positions in buffer
+  (total-wait-time 0.0)   ;; total time during last parse spent waiting for 
subprocess output.
+  (response-count 0)      ;; responses received from subprocess during last 
parse; for profiling.
+  )
+
+(defvar wisi-process--alist nil
+  "Alist mapping string label to ‘wisi-process--session’ struct")
+
+(defgroup wisi nil
+  "Options for Wisi package."
+  :group 'programming)
+
+(defcustom wisi-process-time-out 1.0
+  "Time out waiting for parser response. An error occurs if there
+  is no response from the parser after waiting this amount 5
+  times."
+  :type 'float
+  :safe 'floatp)
+(make-variable-buffer-local 'wisi-process-time-out)
+
+;;;###autoload
+(defun wisi-process-parse-get (parser)
+  "Return a ‘wisi-process--parser’ object matching PARSER label.
+If label found in ‘wisi-process--alist’, return that.
+Otherwise add PARSER to ‘wisi-process--alist’, return it."
+  (or (cdr (assoc (wisi-process--parser-label parser) wisi-process--alist))
+      (let ((exec-file (locate-file (wisi-process--parser-exec-file parser) 
exec-path '("" ".exe"))))
+
+       (unless exec-file
+         (error "%s not found on `exec-path'" (wisi-process--parser-exec-file 
parser)))
+
+       (push (cons (wisi-process--parser-label parser) parser) 
wisi-process--alist)
+
+       parser
+     )))
+
+(defun wisi-process-parse-set-exec (label exec-file)
+  "Change the EXEC-FILE for parsers with LABEL."
+  (let ((parser (cdr (assoc label wisi-process--alist))))
+    (when parser
+      (wisi-parse-kill parser)
+      (setf (wisi-process--parser-exec-file parser) exec-file))))
+
+(defun wisi-process-parse--require-process (parser)
+  "Start the process for PARSER if not already started."
+  (unless (process-live-p (wisi-process--parser-process parser))
+    (let ((process-connection-type nil) ;; use a pipe, not a pty; avoid 
line-by-line reads
+         (process-name (format " *%s_wisi_parse*" (wisi-process--parser-label 
parser))))
+
+      (unless (buffer-live-p (wisi-process--parser-buffer parser))
+       ;; User may have killed buffer to kill parser.
+       (setf (wisi-process--parser-buffer parser)
+             (get-buffer-create process-name)))
+
+      (with-current-buffer (wisi-process--parser-buffer parser)
+       (erase-buffer)); delete any previous messages, prompt
+
+      (setf (wisi-process--parser-process parser)
+           (if (fboundp 'make-process)
+               ;; emacs >= 25
+               (make-process
+                :name process-name
+                :buffer (wisi-process--parser-buffer parser)
+                :command (append (list (wisi-process--parser-exec-file parser))
+                                 (wisi-process--parser-exec-opts parser)))
+             ;; emacs < 25
+             (start-process
+              process-name
+              (wisi-process--parser-buffer parser)
+              (wisi-process--parser-exec-file parser)
+              (wisi-process--parser-exec-opts parser)
+              )))
+
+      (set-process-query-on-exit-flag (wisi-process--parser-process parser) 
nil)
+      (setf (wisi-process--parser-busy parser) nil)
+
+      ;; IMPROVEME: check protocol and version numbers
+      (wisi-process-parse--wait parser)
+      )))
+
+(defun wisi-process-parse--wait (parser)
+  "Wait for the current command to complete."
+  (let ((process (wisi-process--parser-process parser))
+       (search-start (point-min))
+       (wait-count 0)
+       (found nil))
+
+    (with-current-buffer (wisi-process--parser-buffer parser)
+      (while (and (process-live-p process)
+                 (progn
+                   ;; process output is inserted before point, so move back 
over it to search it
+                   (goto-char search-start)
+                   (not (setq found (re-search-forward 
wisi-process-parse-prompt (point-max) t)))))
+       (setq search-start (point));; don't search same text again
+       (setq wait-count (1+ wait-count))
+       (when (> wisi-process-parse-debug 0)
+           (message "wisi-process-parse--wait: %d" wait-count))
+       (accept-process-output process 0.1))
+
+      (if found
+         (when (> wisi-process-parse-debug 0)
+           (message "wisi-process-parse--wait: %d" wait-count)
+           (when (> wisi-process-parse-debug 2)
+             (message "'%s'" (buffer-substring-no-properties (point-min) 
(point-max)))))
+
+       (wisi-process-parse-show-buffer parser)
+       (error "%s process died" (wisi-process--parser-exec-file parser)))
+      )))
+
+(defun wisi-process-parse-show-buffer (parser)
+  "Show PARSER buffer."
+  (if (buffer-live-p (wisi-process--parser-buffer parser))
+      (pop-to-buffer (wisi-process--parser-buffer parser))
+    (error "wisi-process-parse process not active")))
+
+(defun wisi-process-parse--send-parse (parser line-count)
+  "Send a parse command to PARSER external process, followed by
+the content of the current buffer.  Does not wait for command to
+complete."
+  ;; Must match "parse" command arguments in gen_emacs_wisi_parse.adb
+  (let* ((cmd (format "parse %d \"%s\" %d %d %d %d %d %d %d %d %d %d %d %s"
+                     (cl-ecase wisi--parse-action
+                       (navigate 0)
+                       (face 1)
+                       (indent 2))
+                     (if (buffer-file-name) (file-name-nondirectory 
(buffer-file-name)) "")
+                     line-count
+                     (if (> wisi-debug 0) 1 0) ;; debug-mode
+                     (1- wisi-debug) ;; trace_parse
+                     wisi-trace-mckenzie
+                     wisi-trace-action
+                     (if wisi-mckenzie-disable 1 0)
+                     (if wisi-mckenzie-task-count wisi-mckenzie-task-count -1)
+                     (if wisi-mckenzie-cost-limit wisi-mckenzie-cost-limit -1)
+                     (if wisi-mckenzie-check-limit wisi-mckenzie-check-limit 
-1)
+                     (if wisi-mckenzie-enqueue-limit 
wisi-mckenzie-enqueue-limit -1)
+                     (1- (position-bytes (point-max)))
+                     (wisi-parse-format-language-options parser)
+                     ))
+        (msg (format "%03d%s" (length cmd) cmd))
+        (process (wisi-process--parser-process parser)))
+    (when (> wisi-process-parse-debug 0)
+      (message msg))
+    (with-current-buffer (wisi-process--parser-buffer parser)
+      (erase-buffer))
+
+    (process-send-string process msg)
+    (process-send-string process (buffer-substring-no-properties (point-min) 
(point-max)))
+
+    ;; We don’t wait for the send to complete; the external process
+    ;; may start parsing and send an error message.
+    ))
+
+(defun wisi-process-parse--send-noop (parser)
+  "Send a noop command to PARSER external process, followed by
+the content of the current buffer.  Does not wait for command to
+complete."
+  (let* ((cmd (format "noop %d" (1- (position-bytes (point-max)))))
+        (msg (format "%03d%s" (length cmd) cmd))
+        (process (wisi-process--parser-process parser)))
+    (when (> wisi-process-parse-debug 0)
+      (message msg))
+    (with-current-buffer (wisi-process--parser-buffer parser)
+      (erase-buffer))
+
+    (process-send-string process msg)
+    (process-send-string process (buffer-substring-no-properties (point-min) 
(point-max)))
+    ))
+
+(defun wisi-process-parse--marker-or-nil (item)
+  (if (= -1 item) nil (copy-marker item t)))
+
+(defun wisi-process-parse--Navigate_Cache (parser sexp)
+  ;; sexp is [Navigate_Cache pos statement_id id length class containing_pos 
prev_pos next_pos end_pos]
+  ;; see ‘wisi-process-parse--execute’
+  (let ((pos (aref sexp 1)))
+    (with-silent-modifications
+      (put-text-property
+       pos
+       (1+ pos)
+       'wisi-cache
+       (wisi-cache-create
+       :nonterm    (aref (wisi-process--parser-token-table parser) (aref sexp 
2))
+       :token      (aref (wisi-process--parser-token-table parser) (aref sexp 
3))
+       :last       (aref sexp 4)
+       :class      (aref wisi-class-list (aref sexp 5))
+       :containing (wisi-process-parse--marker-or-nil (aref sexp 6))
+       :prev       (wisi-process-parse--marker-or-nil (aref sexp 7))
+       :next       (wisi-process-parse--marker-or-nil (aref sexp 8))
+       :end        (wisi-process-parse--marker-or-nil (aref sexp 9))
+       )))
+    ))
+
+(defun wisi-process-parse--Face_Property (parser sexp)
+  ;; sexp is [Face_Property first-pos last-pos face-index]
+  ;; see ‘wisi-process-parse--execute’
+  ;; implements wisi--face-action-1
+  (with-silent-modifications
+    (add-text-properties
+     (aref sexp 1)
+     (1+ (aref sexp 2))
+     (list 'font-lock-face (aref (wisi-process--parser-face-table parser) 
(aref sexp 3))
+          'fontified t)
+     )))
+
+(defun wisi-process-parse--Indent (parser sexp)
+  ;; sexp is [Indent line-number indent]
+  ;; see ‘wisi-process-parse--execute’
+  (let ((pos (aref (wisi-process--parser-line-begin parser) (1- (aref sexp 
1)))))
+    (with-silent-modifications
+      (put-text-property
+       (1- pos)
+       pos
+       'wisi-indent
+       (aref sexp 2)))
+    ))
+
+(defun wisi-process-parse--Lexer_Error (parser sexp)
+  ;; sexp is [Lexer_Error char-position <message> <repair-char>]
+  ;; see ‘wisi-process-parse--execute’
+  (let ((pos (aref sexp 1))
+       err)
+
+    (goto-char pos);; for current-column
+
+    (setq err
+         (make-wisi--lexer-error
+          :pos (copy-marker pos)
+          :message
+          (format "%s:%d:%d: %s"
+                  (if (buffer-file-name) (file-name-nondirectory 
(buffer-file-name)) "")
+                  ;; file-name can be nil during vc-resolve-conflict
+                  (line-number-at-pos pos)
+                  (current-column)
+                  (aref sexp 2))
+          :inserted (when (= 4 (length sexp)) (aref sexp 3))))
+
+    (push err (wisi-parser-lexer-errors parser))
+    ))
+
+(defun wisi-process-parse--Parser_Error (parser sexp)
+  ;; sexp is [Parser_Error char-position <string>]
+  ;; see ‘wisi-process-parse--execute’
+  (let ((pos (aref sexp 1))
+       err)
+
+    (goto-char pos);; for current-column
+
+    (setq err
+         (make-wisi--parse-error
+          :pos (copy-marker pos)
+          :message
+          (format "%s:%d:%d: %s"
+                  (if (buffer-file-name) (file-name-nondirectory 
(buffer-file-name)) "")
+                  ;; file-name can be nil during vc-resolve-conflict
+                  (line-number-at-pos pos)
+                  (1+ (current-column))
+                  (aref sexp 2))))
+
+    (push err (wisi-parser-parse-errors parser))
+    ))
+
+(defun wisi-process-parse--Check_Error (parser sexp)
+  ;; sexp is [Check_Error code name-1-pos name-2-pos <string>]
+  ;; see ‘wisi-process-parse--execute’
+  (let* ((name-1-pos (aref sexp 2))
+       (name-1-col (1+ (progn (goto-char name-1-pos)(current-column)))) ;; 
gnat columns are 1 + emacs columns
+       (name-2-pos (aref sexp 3))
+       (name-2-col (1+ (progn (goto-char name-2-pos)(current-column))))
+       (file-name (if (buffer-file-name) (file-name-nondirectory 
(buffer-file-name)) ""))
+       ;; file-name can be nil during vc-resolve-conflict
+       (err (make-wisi--parse-error
+             :pos (copy-marker name-1-pos)
+             :message
+             (format "%s:%d:%d: %s %s:%d:%d"
+                     file-name (line-number-at-pos name-1-pos) name-1-col
+                     (aref sexp 4)
+                     file-name (line-number-at-pos name-2-pos) name-2-col)))
+       )
+
+    (push err (wisi-parser-parse-errors parser))
+    ))
+
+(defun wisi-process-parse--Recover (parser sexp)
+  ;; sexp is [Recover [pos [inserted] [deleted]]...]
+  ;; see ‘wisi-process-parse--execute’
+  ;; convert to list of wisi--parse-error-repair, add to last error
+  (let* ((token-table (wisi-process--parser-token-table parser))
+        (last-error (car (wisi-parser-parse-errors parser))))
+    (unless (= 1 (length sexp))
+      (cl-do ((i 1 (1+ i))) ((= i (length sexp)))
+       (push
+        (make-wisi--parse-error-repair
+         :pos (aref (aref sexp i) 0)
+         :inserted (mapcar (lambda (id) (aref token-table id)) (aref (aref 
sexp i) 1))
+         :deleted  (mapcar (lambda (id) (aref token-table id)) (aref (aref 
sexp i) 2)))
+        (wisi--parse-error-repair last-error)))
+      )))
+
+(defun wisi-process-parse--execute (parser sexp)
+  "Execute encoded SEXP sent from external process."
+  ;; sexp is [action arg ...]; an encoded instruction that we need to execute
+  ;;
+  ;; Actions:
+  ;;
+  ;; [Navigate_Cache pos statement_id id length class containing_pos prev_pos 
next_pos end_pos]
+  ;;    Set a wisi-cache text-property.
+  ;;    *pos          : integer buffer position; -1 if nil (not set)
+  ;;    *id           : integer index into parser-token-table
+  ;;    length        : integer character count
+  ;;    class         : integer index into wisi-class-list
+  ;;
+  ;; [Face_Property first-pos last-pos face-index]
+  ;;    Set a font-lock-face text-property
+  ;;    face-index: integer index into parser-elisp-face-table
+  ;;
+  ;; [Indent line-number indent]
+  ;;    Set an indent text property
+  ;;
+  ;; [Lexer_Error char-position <message> <repair-char>]
+  ;;    The lexer detected an error at char-position.
+  ;;
+  ;;    If <repair-char> is not ASCII NUL, it was inserted immediately
+  ;;    after char-position to fix the error.
+  ;;
+  ;; [Parser_Error char-position <message>]
+  ;;    The parser detected a syntax error; save information for later
+  ;;    reporting.
+  ;;
+  ;;    If error recovery is successful, there can be more than one
+  ;;    error reported during a parse.
+  ;;
+  ;; [Check_Error code name-1-pos name-2-pos <string>]
+  ;;    The parser detected a semantic check error; save information
+  ;;    for later reporting.
+  ;;
+  ;;    If error recovery is successful, there can be more than one
+  ;;    error reported during a parse.
+  ;;
+  ;; [Recover [pos [inserted] [deleted]]...]
+  ;;    The parser finished a successful error recovery.
+  ;;
+  ;;    pos: Buffer position
+  ;;
+  ;;    inserted: Virtual tokens (terminal or non-terminal) inserted before 
pos.
+  ;;
+  ;;    deleted: Tokens deleted after pos.
+  ;;
+  ;;    Args are token ids; index into parser-token-table. Save the information
+  ;;    for later use by ’wisi-repair-error’.
+  ;;
+  ;;
+  ;; Numeric action codes are given in the case expression below
+
+  (cl-ecase (aref sexp 0)
+    (1  (wisi-process-parse--Navigate_Cache parser sexp))
+    (2  (wisi-process-parse--Face_Property parser sexp))
+    (3  (wisi-process-parse--Indent parser sexp))
+    (4  (wisi-process-parse--Lexer_Error parser sexp))
+    (5  (wisi-process-parse--Parser_Error parser sexp))
+    (6  (wisi-process-parse--Check_Error parser sexp))
+    (7  (wisi-process-parse--Recover parser sexp))
+    ))
+
+;;;;; main
+
+(cl-defmethod wisi-parse-kill ((parser wisi-process--parser))
+  (when (process-live-p (wisi-process--parser-process parser))
+    (process-send-string (wisi-process--parser-process parser) 
wisi-process-parse-quit-cmd)
+    (sit-for 1.0)
+    (when (process-live-p (wisi-process--parser-process parser))
+      (kill-process (wisi-process--parser-process parser)))
+    )
+  (setf (wisi-process--parser-busy parser) nil))
+
+(defvar wisi--lexer nil) ;; wisi-elisp-lexer.el
+(declare-function wisi-elisp-lexer-reset "wisi-elisp-lexer")
+
+(cl-defmethod wisi-parse-current ((parser wisi-process--parser))
+  "Run the external parser on the current buffer."
+  (wisi-process-parse--require-process parser)
+
+  ;; font-lock can trigger a face parse while navigate or indent parse
+  ;; is active, due to ‘accept-process-output’ below. font-lock must
+  ;; not hang (it is called from an idle timer), so don’t
+  ;; wait. Signaling an error tells font-lock to try again later.
+  ;;
+  ;; If the parser is left busy due to some error, that is a bug. In
+  ;; order to detect such bugs, and avoid weird errors from
+  ;; wisi-indent-region, we signal an error here.
+  (if (wisi-process--parser-busy parser)
+      (progn
+       (setf (wisi-parser-parse-errors parser)
+             (list
+              (make-wisi--parse-error
+               :pos 0
+               :message (format "%s:%d:%d: parser busy (try 
’wisi-kill-parser’)"
+                                (if (buffer-file-name) (file-name-nondirectory 
(buffer-file-name)) "") 1 1))
+              ))
+       (error "%s parse abandoned; parser busy" wisi--parse-action)
+       )
+
+    ;; It is not possible for a background elisp function (ie
+    ;; font-lock) to interrupt this code between checking and setting
+    ;; parser-busy; background elisp can only run when we call
+    ;; accept-process-output below.
+    (setf (wisi-process--parser-busy parser) t)
+
+    (condition-case-unless-debug err
+       (let* ((source-buffer (current-buffer))
+              (response-buffer (wisi-process--parser-buffer parser))
+              (process (wisi-process--parser-process parser))
+              (w32-pipe-read-delay 0) ;; fastest subprocess read
+              response
+              response-end
+              (response-count 0)
+              (sexp-start (point-min))
+              (wait-count 0)
+              (need-more nil) ;; point-max if need more, to check for new input
+              (done nil)
+              start-wait-time)
+
+         (setf (wisi-process--parser-total-wait-time parser) 0.0)
+
+         (setf (wisi-parser-lexer-errors parser) nil)
+         (setf (wisi-parser-parse-errors parser) nil)
+
+         (let ((line-count (1+ (count-lines (point-min) (point-max)))))
+           (setf (wisi-process--parser-line-begin parser) 
(wisi--set-line-begin line-count))
+           (wisi-process-parse--send-parse parser line-count)
+
+           ;; We reset the elisp lexer, because post-parse actions may use it.
+           (when wisi--lexer
+             (wisi-elisp-lexer-reset line-count wisi--lexer))
+           )
+
+         (set-buffer response-buffer)
+
+         ;; process responses until prompt received
+         (while (not done)
+
+           ;; process all complete responses currently in buffer
+           (while (and (not need-more)
+                       (not done))
+
+             (goto-char sexp-start)
+
+             (cond
+              ((eobp)
+               (setq need-more (point-max)))
+
+              ((looking-at wisi-process-parse-prompt)
+               (setq done t))
+
+              ((or (looking-at "\\[") ;; encoded action
+                   (looking-at "(")) ;; error or other elisp expression to eval
+               (condition-case nil
+                   (setq response-end (scan-sexps (point) 1))
+                 (error
+                  ;; incomplete response
+                  (setq need-more (point-max))
+                  nil))
+
+               (unless need-more
+                 (setq response-count (1+ response-count))
+                 (setq response (car (read-from-string 
(buffer-substring-no-properties (point) response-end))))
+                 (goto-char response-end)
+                 (forward-line 1)
+                 (setq sexp-start (point))
+
+                 (set-buffer source-buffer) ;; for put-text-property in actions
+                 (if (listp response)
+                     ;; error of some sort
+                     (cond
+                      ((equal '(parse_error) response)
+                       ;; Parser detected a syntax error, and recovery failed, 
so signal it.
+                       (if (wisi-parser-parse-errors parser)
+                           (signal 'wisi-parse-error
+                                   (wisi--parse-error-message (car 
(wisi-parser-parse-errors parser))))
+
+                         ;; can have no errors when testing a new parser
+                         (push
+                          (make-wisi--parse-error :pos 0 :message "parser 
failed with no message")
+                          (wisi-parser-parse-errors parser))
+                         (signal 'wisi-parse-error "parser failed with no 
message")))
+
+                      ((equal 'parse_error (car response))
+                       ;; Parser detected some other error non-fatal error, so 
signal it.
+                       (signal 'wisi-parse-error (cdr response)))
+
+                      ((and (eq 'error (car response))
+                            (string-prefix-p "bad command:" (cadr response)))
+                       ;; Parser dropped bytes, is treating buffer
+                       ;; content bytes as commands. Kill the process
+                       ;; to kill the pipes; there is no other way to
+                       ;; flush them.
+                       (kill-process (wisi-process--parser-process parser))
+                       (signal 'wisi-parse-error "parser lost sync; killed"))
+
+                      (t
+                       ;; Some other error
+                       (condition-case-unless-debug err
+                           (eval response)
+                         (error
+                          (push (make-wisi--parse-error :pos (point) :message 
(cadr err)) (wisi-parser-parse-errors parser))
+                          (signal (car err) (cdr err)))))
+                      )
+
+                   ;; else encoded action
+                   (condition-case-unless-debug err
+                       (wisi-process-parse--execute parser response)
+                     (wisi-parse-error
+                      (push (make-wisi--parse-error :pos (point) :message 
(cadr err)) (wisi-parser-parse-errors parser))
+                      (signal (car err) (cdr err)))))
+
+                 (set-buffer response-buffer)
+                 ))
+
+              (t
+               ;; debug output
+               (forward-line 1)
+               (setq sexp-start (point)))
+              )
+             )
+
+           (unless done
+             ;; end of response buffer
+             (unless (process-live-p process)
+               (wisi-process-parse-show-buffer parser)
+               (error "wisi-process-parse process died"))
+
+             (setq wait-count (1+ wait-count))
+             (setq start-wait-time (float-time))
+
+             ;; If we specify no time-out here, we get messages about
+             ;; "blocking call with quit inhibited", when this is
+             ;; called by font-lock from the display engine.
+             ;;
+             ;; Specifying just-this-one t prevents C-q from
+             ;; interrupting this?
+             (accept-process-output
+              process
+              wisi-process-time-out
+              nil ;; milliseconds
+              nil)  ;; just-this-one
+
+             (setf (wisi-process--parser-total-wait-time parser)
+                   (+ (wisi-process--parser-total-wait-time parser)
+                      (- (float-time) start-wait-time)))
+
+             (when (and (= (point-max) need-more)
+                      (> wait-count 5))
+               (error "wisi-process-parse not getting more text (or bad syntax 
in process output)"))
+
+             (setq need-more nil))
+           );; while not done
+
+         ;; got command prompt
+         (unless (process-live-p process)
+           (wisi-process-parse-show-buffer parser)
+           (error "wisi-process-parse process died"))
+
+         (setf (wisi-process--parser-response-count parser) response-count)
+
+         (setf (wisi-process--parser-busy parser) nil)
+         (set-buffer source-buffer)
+         ;; If we get here, the parse succeeded (possibly with error
+         ;; recovery); move point to end of buffer as the elisp
+         ;; parser does.
+         (goto-char (point-max))
+         )
+
+      (wisi-parse-error
+       (setf (wisi-process--parser-busy parser) nil)
+       (signal (car err) (cdr err)))
+
+      (error
+       (setf (wisi-process--parser-busy parser) nil)
+       (signal (car err) (cdr err))
+       ))))
+
+(defvar wisi--parser nil) ;; wisi.el
+
+(defun wisi-process-send-tokens-noop ()
+  "Run lexer, send tokens to subprocess; otherwise no operation.
+For use with ’wisi-time’."
+  (wisi-process-parse--require-process wisi--parser)
+  (if (wisi-process--parser-busy wisi--parser)
+      (error "%s parser busy" wisi--parse-action)
+
+    ;; not busy
+    (let* ((source-buffer (current-buffer))
+          (action-buffer (wisi-process--parser-buffer wisi--parser))
+          (process (wisi-process--parser-process wisi--parser))
+          (sexp-start (point-min))
+          (need-more nil)
+          (done nil))
+
+      (setf (wisi-process--parser-busy wisi--parser) t)
+      (wisi-process-parse--send-noop wisi--parser)
+
+      (set-buffer action-buffer)
+      (while (and (process-live-p process)
+                 (not done))
+       (goto-char sexp-start)
+       (cond
+        ((eobp)
+         (setq need-more t))
+
+        ((looking-at wisi-process-parse-prompt)
+         (setq done t))
+
+        (t
+         (forward-line 1)
+         (setq sexp-start (point)))
+        )
+
+       (unless done
+         ;; end of response buffer
+         (unless (process-live-p process)
+           (wisi-process-parse-show-buffer wisi--parser)
+           (error "wisi-process-parse process died"))
+
+         (accept-process-output process 1.0 nil nil)
+         (setq need-more nil))
+       )
+      (set-buffer source-buffer)
+      (setf (wisi-process--parser-busy wisi--parser) nil)
+      )))
+
+;;;;; debugging
+(defun wisi-process-parse-ids-to-enum (token-table &rest int-ids)
+  "Translate INT-IDS from process integer token ids to elisp enumeral ids.
+Returns reversed sequence."
+  (let ((enum-ids nil))
+    (cl-dolist (i int-ids)
+      (push (aref token-table i) enum-ids))
+    enum-ids))
+
+(provide 'wisi-process-parse)
diff --git a/wisi.adb b/wisi.adb
new file mode 100644
index 0000000..9b184b7
--- /dev/null
+++ b/wisi.adb
@@ -0,0 +1,1891 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2017, 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Strings.Bounded;
+with WisiToken.Semantic_Checks;
+package body Wisi is
+   use WisiToken;
+
+   Navigate_Cache_Code : constant String := "1 ";
+   Face_Property_Code  : constant String := "2 ";
+   Indent_Code         : constant String := "3 ";
+   Lexer_Error_Code    : constant String := "4";
+   Parser_Error_Code   : constant String := "5";
+   Check_Error_Code    : constant String := "6";
+   Recover_Code        : constant String := "7 ";
+
+   Chars_Per_Int : constant Integer := Integer'Width;
+
+   ----------
+   --  body subprogram specs (as needed), alphabetical
+
+   function Indent_Zero_P (Indent : in Indent_Type) return Boolean;
+
+   function Max_Anchor_ID
+     (Data       : in out Parse_Data_Type;
+      First_Line : in     Line_Number_Type;
+      Last_Line  : in     Line_Number_Type)
+     return Integer;
+
+   function Paren_In_Anchor_Line
+     (Data         : in out Parse_Data_Type'Class;
+      Anchor_Token : in     Augmented_Token;
+      Offset       : in     Integer)
+     return Integer;
+
+   ----------
+   --  body subprograms bodies, alphabetical
+
+   function Image (Anchor_IDs : in Anchor_ID_Vectors.Vector) return String
+   is
+      use Ada.Strings.Unbounded;
+      Result : Unbounded_String := +"(";
+   begin
+      for I in Anchor_IDs.First_Index .. Anchor_IDs.Last_Index loop
+         Result := Result & Integer'Image (Anchor_IDs (I));
+         if I /= Anchor_IDs.Last_Index then
+            Result := Result & ", ";
+         else
+            Result := Result & ")";
+         end if;
+      end loop;
+      return -Result;
+   end Image;
+
+   function Image (Indent : in Indent_Type) return String
+   is begin
+      case Indent.Label is
+      when Not_Set =>
+         return "(" & Indent_Label'Image (Indent.Label) & ")";
+
+      when Int =>
+         return "(" & Indent_Label'Image (Indent.Label) & Integer'Image 
(Indent.Int_Indent) & ")";
+
+      when Anchor =>
+         return "(" & Indent_Label'Image (Indent.Label) & Image 
(Indent.Anchor_IDs) & ", " & Integer'Image
+           (Indent.Anchor_Indent) & ")";
+
+      when Anchored =>
+         return "(" & Indent_Label'Image (Indent.Label) & Integer'Image 
(Indent.Anchored_ID) & ", " & Integer'Image
+           (Indent.Anchored_Delta) & ")";
+
+      when Anchor_Anchored =>
+         return "(" & Indent_Label'Image (Indent.Label) & Image 
(Indent.Anchor_Anchored_IDs) & Integer'Image
+           (Indent.Anchor_Anchored_ID) & ", " & Integer'Image 
(Indent.Anchor_Anchored_Delta) & ")";
+      end case;
+   end Image;
+
+   procedure Indent_Apply_Anchored
+     (Delta_Indent : in     Anchored_Delta;
+      Indent       : in out Indent_Type)
+   is begin
+      --  [2] wisi-elisp-parse--apply-anchored
+
+      case Indent.Label is
+      when Not_Set =>
+         Indent := (Anchored, Delta_Indent.Anchored_ID, 
Delta_Indent.Anchored_Delta);
+
+      when Int =>
+         if Indent.Int_Indent = 0 or Delta_Indent.Anchored_Accumulate then
+            Indent := (Anchored, Delta_Indent.Anchored_ID, Indent.Int_Indent + 
Delta_Indent.Anchored_Delta);
+         end if;
+
+      when Anchor =>
+         if Delta_Indent.Anchored_Accumulate or Indent.Anchor_Indent = 0 then
+            Indent :=
+              (Anchor_Anchored,
+               Indent.Anchor_IDs,
+               Delta_Indent.Anchored_ID,
+               Delta_Indent.Anchored_Delta + Indent.Anchor_Indent);
+         end if;
+
+      when Anchored | Anchor_Anchored =>
+         --  already anchored
+         null;
+      end case;
+   end Indent_Apply_Anchored;
+
+   procedure Indent_Apply_Int (Indent : in out Indent_Type; Offset : in 
Integer)
+   is begin
+      --  [2] wisi-elisp-parse--apply-int
+      case Indent.Label is
+      when Not_Set =>
+         Indent := (Int, Offset);
+
+      when Int =>
+         Indent.Int_Indent := Indent.Int_Indent + Offset;
+
+      when Anchor =>
+         Indent.Anchor_Indent := Indent.Anchor_Indent + Offset;
+
+      when Anchored | Anchor_Anchored =>
+         null;
+      end case;
+   end Indent_Apply_Int;
+
+   procedure Indent_Line
+     (Data         : in out Parse_Data_Type;
+      Line         : in     Line_Number_Type;
+      Delta_Indent : in     Delta_Type)
+   is
+      --  See note in Indent_Anchored_2 for why we can't use renames here.
+      Indent : Indent_Type := Data.Indents (Line);
+   begin
+      case Delta_Indent.Label is
+      when Simple =>
+         case Delta_Indent.Simple_Delta.Label is
+         when Int =>
+            Indent_Apply_Int (Indent, Delta_Indent.Simple_Delta.Int_Delta);
+
+         when Anchored =>
+            Indent_Apply_Anchored (Delta_Indent.Simple_Delta, Indent);
+         end case;
+
+      when Hanging =>
+         if Delta_Indent.Hanging_Accumulate or Indent_Zero_P (Data.Indents 
(Line)) then
+            if Line = Delta_Indent.Hanging_First_Line then
+               --  Apply delta_1
+               case Delta_Indent.Hanging_Delta_1.Label is
+               when Int =>
+                  Indent_Apply_Int (Indent, 
Delta_Indent.Hanging_Delta_1.Int_Delta);
+               when Anchored =>
+                  Indent_Apply_Anchored (Delta_Indent.Hanging_Delta_1, Indent);
+               end case;
+            else
+               if Delta_Indent.Hanging_Paren_State = Data.Line_Paren_State 
(Line) then
+                  case Delta_Indent.Hanging_Delta_2.Label is
+                  when Int =>
+                     Indent_Apply_Int (Indent, 
Delta_Indent.Hanging_Delta_2.Int_Delta);
+                  when Anchored =>
+                     Indent_Apply_Anchored (Delta_Indent.Hanging_Delta_2, 
Indent);
+                  end case;
+               end if;
+            end if;
+         end if;
+      end case;
+      Data.Indents.Replace_Element (Line, Indent);
+   end Indent_Line;
+
+   function Indent_Zero_P (Indent : in Indent_Type) return Boolean
+   is begin
+      --  wisi-elisp-parse--indent-zero-p
+      case Indent.Label is
+      when Not_Set =>
+         return True;
+
+      when Int =>
+         return Indent.Int_Indent = 0;
+
+      when Anchor =>
+         return Indent.Anchor_Indent = 0;
+
+      when Anchored =>
+         return Indent.Anchored_Delta = 0;
+
+      when Anchor_Anchored =>
+         return Indent.Anchor_Anchored_Delta = 0;
+      end case;
+   end Indent_Zero_P;
+
+   function Max_Anchor_ID
+     (Data       : in out Parse_Data_Type;
+      First_Line : in     Line_Number_Type;
+      Last_Line  : in     Line_Number_Type)
+     return Integer
+   is
+      Result : Integer := First_Anchor_ID - 1;
+   begin
+      for Line in First_Line .. Last_Line loop
+         declare
+            Indent : Indent_Type renames Data.Indents (Line);
+         begin
+            case Indent.Label is
+            when Not_Set | Int =>
+               null;
+            when Anchor =>
+               Result := Integer'Max (Result, Indent.Anchor_IDs 
(Indent.Anchor_IDs.First_Index));
+            when Anchored =>
+               Result := Integer'Max (Result, Indent.Anchored_ID);
+            when Anchor_Anchored =>
+               Result := Integer'Max (Result, Indent.Anchor_Anchored_ID);
+            end case;
+         end;
+      end loop;
+      return Result;
+   end Max_Anchor_ID;
+
+   function Paren_In_Anchor_Line
+     (Data         : in out Parse_Data_Type'Class;
+      Anchor_Token : in     Augmented_Token;
+      Offset       : in     Integer)
+     return Integer
+   is
+      Left_Paren_ID  : WisiToken.Token_ID renames 
Data.Descriptor.Left_Paren_ID;
+      Right_Paren_ID : WisiToken.Token_ID renames 
Data.Descriptor.Right_Paren_ID;
+
+      I              : Base_Token_Index := Anchor_Token.First_Terminals_Index;
+      Paren_Count    : Integer          := 0;
+      Paren_Char_Pos : Buffer_Pos       := Invalid_Buffer_Pos;
+      Text_Begin_Pos : Buffer_Pos       := Invalid_Buffer_Pos;
+   begin
+      --  [1] wisi-elisp-parse--paren-in-anchor-line. That uses elisp 
syntax-ppss; here
+      --  we search Terminals.
+      loop
+         declare
+            Tok : Augmented_Token renames Data.Terminals (I);
+         begin
+            if Tok.ID = Left_Paren_ID then
+               Paren_Count := Paren_Count + 1;
+               if Paren_Count = 1 then
+                  Paren_Char_Pos := Tok.Char_Region.First;
+               end if;
+
+            elsif Tok.ID = Right_Paren_ID then
+               Paren_Count := Paren_Count - 1;
+
+            end if;
+
+            if Tok.First then
+               Text_Begin_Pos := Tok.Char_Region.First;
+               exit;
+            end if;
+         end;
+         I := I - 1;
+      end loop;
+
+      if Paren_Char_Pos /= Invalid_Buffer_Pos and Text_Begin_Pos /= 
Invalid_Buffer_Pos then
+         return 1 + Offset + Integer (Paren_Char_Pos - Text_Begin_Pos);
+      else
+         return Offset;
+      end if;
+   end Paren_In_Anchor_Line;
+
+   procedure Put (Cache : in Navigate_Cache_Type)
+   is
+      package Bounded is new Ada.Strings.Bounded.Generic_Bounded_Length (Max 
=> 2 + 11 * Chars_Per_Int);
+      use Bounded;
+
+      Line : Bounded_String := To_Bounded_String ("[");
+
+      procedure Append (Item : in Nil_Buffer_Pos)
+      is begin
+         if Item.Set then
+            Append (Line, Buffer_Pos'Image (Item.Item));
+         else
+            Append (Line, " -1");
+         end if;
+      end Append;
+   begin
+      Append (Line, Navigate_Cache_Code);
+      Append (Line, Buffer_Pos'Image (Cache.Pos));
+      Append (Line, WisiToken.Token_ID'Image (Cache.Statement_ID));
+      Append (Line, WisiToken.Token_ID'Image (Cache.ID));
+      Append (Line, Integer'Image (Cache.Length));
+      Append (Line, Integer'Image (Navigate_Class_Type'Pos (Cache.Class)));
+      Append (Cache.Containing_Pos);
+      Append (Cache.Prev_Pos);
+      Append (Cache.Next_Pos);
+      Append (Cache.End_Pos);
+      Append (Line, ']');
+      Ada.Text_IO.Put_Line (To_String (Line));
+   end Put;
+
+   procedure Put (Cache : in Face_Cache_Type)
+   is
+      package Bounded is new Ada.Strings.Bounded.Generic_Bounded_Length (Max 
=> 2 + 4 * Chars_Per_Int);
+      use Bounded;
+
+      Line : Bounded_String := To_Bounded_String ("[");
+   begin
+      if Cache.Face.Set then
+         Append (Line, Face_Property_Code);
+         Append (Line, Buffer_Pos'Image (Cache.Region.First));
+         Append (Line, Buffer_Pos'Image (Cache.Region.Last));
+         Append (Line, Integer'Image (Cache.Face.Item));
+         Append (Line, ']');
+         Ada.Text_IO.Put_Line (To_String (Line));
+      end if;
+   end Put;
+
+   procedure Put (Line_Number : in Line_Number_Type; Item : in Indent_Type)
+   is begin
+      --  All Anchors must be resolved at this point, but not all lines have
+      --  an indent computed. A negative indent is an error in either the
+      --  grammar indent rules or the algorithms in this package.
+      case Item.Label is
+      when Not_Set =>
+         Ada.Text_IO.Put_Line
+           ('[' & Indent_Code & Trimmed_Image (Integer (Line_Number)) & " 0]");
+
+      when Int =>
+         declare
+            --  We can easily get negative indents when there are syntax 
errors.
+            Ind : constant Integer := Integer'Max (0, Item.Int_Indent);
+         begin
+            Ada.Text_IO.Put_Line
+              ('[' & Indent_Code & Trimmed_Image (Integer (Line_Number)) & 
Integer'Image (Ind) & ']');
+         end;
+
+      when Anchor | Anchored | Anchor_Anchored =>
+         raise SAL.Programmer_Error with "Indent item has non-int label: " & 
Indent_Label'Image (Item.Label);
+      end case;
+   end Put;
+
+   procedure Put
+     (Item       : in Parse.LR.Configuration;
+      Terminals  : in Augmented_Token_Arrays.Vector;
+      Descriptor : in WisiToken.Descriptor)
+   is
+      use Ada.Containers;
+      use Ada.Strings.Unbounded;
+      use WisiToken.Parse.LR;
+
+      Line    : Unbounded_String := To_Unbounded_String ("[");
+      Last_Op : Config_Op        := (Fast_Forward, Token_Index'Last);
+
+   begin
+      if Trace_Action > Detail then
+         Ada.Text_IO.Put_Line (Parse.LR.Image (Item.Ops, Descriptor));
+      end if;
+
+      Append (Line, Recover_Code);
+      if Item.Ops.Length = 0 then
+         Append (Line, "]");
+
+      else
+         for I in Item.Ops.First_Index .. Item.Ops.Last_Index loop
+            declare
+               Op : Config_Op renames Item.Ops (I);
+            begin
+               case Op.Op is
+               when Fast_Forward =>
+                  if Last_Op.Op in Insert then
+                     Append (Line, "][]]");
+                  elsif Last_Op.Op in Delete then
+                     Append (Line, "]]");
+                  end if;
+
+                  Last_Op := Op;
+
+               when Undo_Reduce | Push_Back =>
+                  null;
+
+               when Insert =>
+                  if Last_Op.Op = Fast_Forward then
+                     Append (Line, "[");
+                     Append (Line, Buffer_Pos'Image (Terminals 
(Op.Token_Index).Char_Region.First));
+                     Append (Line, "[");
+
+                  elsif Last_Op.Op = Delete then
+                     Append (Line, "]][");
+                     Append (Line, Buffer_Pos'Image (Terminals 
(Op.Token_Index).Char_Region.First));
+                     Append (Line, "[");
+
+                  else
+                     --  Last_Op.Op = Insert
+                     null;
+                  end if;
+                  Append (Line, Token_ID'Image (Op.ID));
+
+                  Last_Op := Op;
+
+               when Delete =>
+                  declare
+                     Skip : Boolean := False;
+                  begin
+                     if Last_Op.Op = Fast_Forward then
+                        Append (Line, "[");
+                        Append (Line, Buffer_Pos'Image (Terminals 
(Op.Token_Index).Char_Region.First));
+                        Append (Line, "[][");
+
+                     elsif Last_Op.Op = Insert then
+                        Append (Line, "][");
+
+                     elsif Last_Op.Op = Delete then
+                        if Descriptor.Embedded_Quote_Escape_Doubled and then
+                          ((Last_Op.ID = Descriptor.String_1_ID and Op.ID = 
Descriptor.String_1_ID) or
+                             (Last_Op.ID = Descriptor.String_2_ID and Op.ID = 
Descriptor.String_2_ID))
+                        then
+                           declare
+                              Tok_1 : Augmented_Token renames Terminals 
(Last_Op.Token_Index);
+                              Tok_2 : Augmented_Token renames Terminals 
(Op.Token_Index);
+                           begin
+                              if Tok_1.Char_Region.Last + 1 = 
Tok_2.Char_Region.First then
+                                 --  Buffer text was '"""', lexer repair 
changed it to '""""'. The
+                                 --  repaired text looks like a single string 
with an embedded quote.
+                                 --  But here, it is two STRING_LITERAL 
tokens. Don't send the second
+                                 --  delete to elisp. See 
test/ada_mode-recover_string_quote_1.adb
+                                 Skip := True;
+                              end if;
+                           end;
+                        end if;
+
+                     end if;
+
+                     if not Skip then
+                        Append (Line, Token_ID'Image (Op.ID));
+                     end if;
+                  end;
+                  Last_Op := Op;
+               end case;
+            end;
+         end loop;
+
+         case Last_Op.Op is
+         when Fast_Forward =>
+            Append (Line, "]");
+
+         when Undo_Reduce | Push_Back =>
+            null;
+
+         when Insert =>
+            Append (Line, "][]]]");
+         when Delete =>
+            Append (Line, "]]]");
+         end case;
+      end if;
+      Ada.Text_IO.Put_Line (To_String (Line));
+   end Put;
+
+   procedure Resolve_Anchors (Data : in out Parse_Data_Type)
+   is
+      Anchor_Indent : array (First_Anchor_ID .. Data.Max_Anchor_ID) of Integer;
+   begin
+      if Trace_Action > Outline then
+         Ada.Text_IO.New_Line;
+         for I in Data.Indents.First_Index .. Data.Indents.Last_Index loop
+            Ada.Text_IO.Put_Line (Line_Number_Type'Image (I) & ", " & Image 
(Data.Indents (I)));
+         end loop;
+      end if;
+
+      if Data.Max_Anchor_ID >= First_Anchor_ID then
+         for I in Data.Indents.First_Index .. Data.Indents.Last_Index loop
+            declare
+               Indent : constant Indent_Type := Data.Indents (I);
+            begin
+               case Indent.Label is
+               when Not_Set | Int =>
+                  null;
+
+               when Anchor =>
+                  for I of Indent.Anchor_IDs loop
+                     Anchor_Indent (I) := Indent.Anchor_Indent;
+                  end loop;
+                  Data.Indents.Replace_Element (I, (Int, 
Indent.Anchor_Indent));
+
+               when Anchored =>
+                  Data.Indents.Replace_Element (I, (Int, Anchor_Indent 
(Indent.Anchored_ID) + Indent.Anchored_Delta));
+
+               when Anchor_Anchored =>
+                  declare
+                     Temp : constant Integer :=
+                       Anchor_Indent (Indent.Anchor_Anchored_ID) + 
Indent.Anchor_Anchored_Delta;
+                  begin
+                     for I of Indent.Anchor_Anchored_IDs loop
+                        Anchor_Indent (I) := Temp;
+                     end loop;
+                     Data.Indents.Replace_Element (I, (Int, Temp));
+                  end;
+               end case;
+            end;
+         end loop;
+      end if;
+   end Resolve_Anchors;
+
+   procedure Set_End
+     (Data           : in out Parse_Data_Type;
+      Containing_Pos : in     Buffer_Pos;
+      End_Pos        : in     Buffer_Pos)
+   is
+      use Navigate_Cursor_Lists;
+      I            : Cursor := Data.End_Positions.First;
+      Delete_Cache : Boolean;
+      Temp         : Cursor;
+   begin
+      loop
+         exit when not Has_Element (I);
+         declare
+            Cache : Navigate_Cache_Type renames Data.Navigate_Caches (Element 
(I));
+         begin
+            if Cache.Pos in Containing_Pos .. End_Pos then
+               Cache.End_Pos := (True, End_Pos);
+               Delete_Cache := True;
+            else
+               Delete_Cache := False;
+            end if;
+         end;
+         if Delete_Cache then
+            Temp := Next (I);
+            Delete (Data.End_Positions, I);
+
+            I := Temp;
+         else
+            Next (I);
+         end if;
+
+      end loop;
+   end Set_End;
+
+   ----------
+   --  public subprograms (declaration order)
+
+   procedure Initialize
+     (Data              : in out Parse_Data_Type;
+      Descriptor        : access constant WisiToken.Descriptor;
+      Source_File_Name  : in     String;
+      Post_Parse_Action : in     Post_Parse_Action_Type;
+      Line_Count        : in     Line_Number_Type;
+      Params            : in     String)
+   is
+      pragma Unreferenced (Params);
+   begin
+      --  + 1 for data on line following last line; see Lexer_To_Augmented.
+      Data.Line_Begin_Pos.Set_Length (Ada.Containers.Count_Type (Line_Count + 
1), Default => Invalid_Buffer_Pos);
+      Data.Line_Paren_State.Set_Length (Ada.Containers.Count_Type (Line_Count 
+ 1));
+
+      Data.Descriptor        := Descriptor;
+      Data.Source_File_Name  := +Source_File_Name;
+      Data.Post_Parse_Action := Post_Parse_Action;
+
+      case Post_Parse_Action is
+      when Navigate | Face =>
+         null;
+      when Indent =>
+         Data.Indents.Set_Length (Ada.Containers.Count_Type (Line_Count));
+      end case;
+
+      Data.Reset;
+   end Initialize;
+
+   overriding procedure Reset (Data : in out Parse_Data_Type)
+   is begin
+      Data.Terminals.Clear;
+      Data.Leading_Non_Grammar.Clear;
+      --  Data.Line_Begin_Pos  set in Initialize, overwritten in 
Lexer_To_Augmented
+      --  Data.Line_Begin_Token  ""
+
+      for S of Data.Line_Paren_State loop
+         S := 0;
+      end loop;
+      Data.Current_Paren_State := 0;
+
+      Data.Navigate_Caches.Finalize;
+      Data.Navigate_Caches.Initialize;
+      Data.End_Positions.Clear;
+
+      Data.Face_Caches.Finalize;
+      Data.Face_Caches.Initialize;
+
+      for I in Data.Indents.First_Index .. Data.Indents.Last_Index loop
+         Data.Indents.Replace_Element (I, (Label => Not_Set));
+      end loop;
+      Data.Max_Anchor_ID := First_Anchor_ID - 1;
+   end Reset;
+
+   function Source_File_Name (Data : in Parse_Data_Type) return String
+   is begin
+      return -Data.Source_File_Name;
+   end Source_File_Name;
+
+   function Post_Parse_Action (Data : in Parse_Data_Type) return 
Post_Parse_Action_Type
+   is begin
+      return Data.Post_Parse_Action;
+   end Post_Parse_Action;
+
+   overriding
+   procedure Lexer_To_Augmented
+     (Data  : in out          Parse_Data_Type;
+      Token : in              Base_Token;
+      Lexer : not null access WisiToken.Lexer.Instance'Class)
+   is
+      use all type Ada.Containers.Count_Type;
+   begin
+      if Lexer.First then
+         Data.Line_Begin_Pos (Token.Line) := Token.Char_Region.First;
+      end if;
+
+      if Token.ID < Data.Descriptor.First_Terminal then
+         --  Non-grammar token
+
+         if Token.ID = Data.Descriptor.New_Line_ID then
+            Data.Line_Paren_State (Token.Line + 1) := Data.Current_Paren_State;
+         end if;
+
+         if Data.Terminals.Length = 0 then
+            Data.Leading_Non_Grammar.Append (Token);
+         else
+            declare
+               Containing_Token : Augmented_Token renames Data.Terminals 
(Data.Terminals.Last_Index);
+
+               Trailing_Blank : constant Boolean :=
+                 Token.ID = Data.Descriptor.New_Line_ID and
+                 (Containing_Token.Non_Grammar.Length > 0 and then
+                    Containing_Token.Non_Grammar
+                      (Containing_Token.Non_Grammar.Last_Index).ID = 
Data.Descriptor.New_Line_ID);
+            begin
+               if Lexer.First and (Token.ID = Data.Descriptor.Comment_ID or 
Trailing_Blank) then
+                  Containing_Token.First := True;
+
+                  if Containing_Token.First_Trailing_Comment_Line = 
Invalid_Line_Number then
+                     Containing_Token.First_Trailing_Comment_Line := 
Token.Line;
+                  end if;
+                  Containing_Token.Last_Trailing_Comment_Line  := Token.Line;
+               end if;
+
+               Containing_Token.Non_Grammar.Append ((Token.ID, Token.Line, 
Token.Column, Lexer.First));
+            end;
+         end if;
+
+      else
+         --  grammar token
+         declare
+            Temp : constant Augmented_Token :=
+              (Token.ID,
+               Byte_Region                 => Token.Byte_Region,
+               Line                        => Token.Line,
+               Column                      => Token.Column,
+               Char_Region                 => Token.Char_Region,
+               Deleted                     => False,
+               First                       => Lexer.First,
+               Paren_State                 => Data.Current_Paren_State,
+               First_Terminals_Index       => Data.Terminals.Last_Index + 1,
+               Last_Terminals_Index        => Data.Terminals.Last_Index + 1,
+               First_Indent_Line           => (if Lexer.First then Token.Line 
else Invalid_Line_Number),
+               Last_Indent_Line            => (if Lexer.First then Token.Line 
else Invalid_Line_Number),
+               First_Trailing_Comment_Line => Invalid_Line_Number, -- Set by 
Reduce
+               Last_Trailing_Comment_Line  => Invalid_Line_Number,
+               Non_Grammar                 => <>);
+         begin
+            if Token.ID = Data.Descriptor.Left_Paren_ID then
+               Data.Current_Paren_State := Data.Current_Paren_State + 1;
+
+            elsif Token.ID = Data.Descriptor.Right_Paren_ID then
+               Data.Current_Paren_State := Data.Current_Paren_State - 1;
+            end if;
+
+            Data.Terminals.Append (Temp);
+         end;
+      end if;
+   end Lexer_To_Augmented;
+
+   overriding
+   procedure Delete_Token
+     (Data        : in out Parse_Data_Type;
+      Token_Index : in     WisiToken.Token_Index)
+   is
+      use all type Ada.Containers.Count_Type;
+      Deleted_Token    : Augmented_Token renames Data.Terminals (Token_Index);
+      Prev_Token_Index : WisiToken.Base_Token_Index := Token_Index - 1;
+   begin
+      pragma Assert (Deleted_Token.Deleted = False);
+      Deleted_Token.Deleted := True;
+      if Deleted_Token.Non_Grammar.Length = 0 then
+         return;
+      end if;
+
+      loop
+         if Prev_Token_Index = Base_Token_Index'First then
+            return;
+         end if;
+         exit when Data.Terminals (Prev_Token_Index).Deleted = False;
+         Prev_Token_Index := Prev_Token_Index - 1;
+      end loop;
+      declare
+         Prev_Token : Augmented_Token renames Data.Terminals 
(Prev_Token_Index);
+      begin
+         Prev_Token.Non_Grammar.Append (Deleted_Token.Non_Grammar);
+         if Deleted_Token.First_Trailing_Comment_Line /= Invalid_Line_Number 
then
+            if Prev_Token.First_Trailing_Comment_Line = Invalid_Line_Number 
then
+               if Deleted_Token.First then
+                  Prev_Token.First_Trailing_Comment_Line := 
Deleted_Token.First_Indent_Line;
+               else
+                  Prev_Token.First_Trailing_Comment_Line := 
Deleted_Token.First_Trailing_Comment_Line;
+               end if;
+            end if;
+            Prev_Token.Last_Trailing_Comment_Line  := 
Deleted_Token.Last_Trailing_Comment_Line;
+         end if;
+      end;
+   end Delete_Token;
+
+   overriding
+   procedure Reduce
+     (Data    : in out Parse_Data_Type;
+      Tree    : in out Syntax_Trees.Tree'Class;
+      Nonterm : in     Syntax_Trees.Valid_Node_Index;
+      Tokens  : in     Syntax_Trees.Valid_Node_Index_Array)
+   is
+      Aug_Nonterm : constant Augmented_Token_Access := new Augmented_Token'
+        (ID          => Tree.ID (Nonterm),
+         Byte_Region => Tree.Byte_Region (Nonterm),
+         others      => <>);
+
+      Trailing_Comment_Done : Boolean := False;
+   begin
+      Tree.Set_Augmented (Nonterm, Base_Token_Class_Access (Aug_Nonterm));
+
+      for I in reverse Tokens'Range loop
+         --  'reverse' to find token containing trailing comments; last
+         --  non-virtual and non-empty token.
+         if Tree.Byte_Region (Tokens (I)) /= Null_Buffer_Region then
+            --  Token not entirely virtual
+            declare
+               Aug_Token : constant Aug_Token_Ref := Get_Aug_Token (Data, 
Tree, Tokens (I));
+            begin
+
+               if Data.Post_Parse_Action = Indent then
+                  if Aug_Token.First_Terminals_Index /= 
Augmented_Token_Arrays.No_Index then
+                     Aug_Nonterm.First_Terminals_Index := 
Aug_Token.First_Terminals_Index;
+                  end if;
+
+                  if Aug_Nonterm.Last_Terminals_Index = 
Augmented_Token_Arrays.No_Index then
+                     Aug_Nonterm.Last_Terminals_Index := 
Aug_Token.Last_Terminals_Index;
+                  end if;
+
+                  Aug_Nonterm.First := Aug_Nonterm.First or Aug_Token.First;
+
+                  if Aug_Token.First then
+                     if Aug_Token.First_Indent_Line /= Invalid_Line_Number then
+                        Aug_Nonterm.First_Indent_Line := 
Aug_Token.First_Indent_Line;
+                     elsif Trailing_Comment_Done and 
Aug_Token.First_Trailing_Comment_Line /= Invalid_Line_Number then
+                        Aug_Nonterm.First_Indent_Line := 
Aug_Token.First_Trailing_Comment_Line;
+                     end if;
+
+                     if Aug_Nonterm.Last_Indent_Line = Invalid_Line_Number then
+                        if Trailing_Comment_Done and 
Aug_Token.Last_Trailing_Comment_Line /= Invalid_Line_Number then
+                           Aug_Nonterm.Last_Indent_Line := 
Aug_Token.Last_Trailing_Comment_Line;
+                        elsif Aug_Token.Last_Indent_Line /= 
Invalid_Line_Number then
+                           Aug_Nonterm.Last_Indent_Line := 
Aug_Token.Last_Indent_Line;
+                        end if;
+                     end if;
+                  end if;
+
+                  if not Trailing_Comment_Done then
+                     Aug_Nonterm.First_Trailing_Comment_Line := 
Aug_Token.First_Trailing_Comment_Line;
+                     Aug_Nonterm.Last_Trailing_Comment_Line  := 
Aug_Token.Last_Trailing_Comment_Line;
+                     Trailing_Comment_Done := True;
+                  end if;
+
+               end if; --  Compute_Indent
+
+               if Aug_Token.Line /= Invalid_Line_Number then
+                  Aug_Nonterm.Line   := Aug_Token.Line;
+                  Aug_Nonterm.Column := Aug_Token.Column;
+               end if;
+
+               if Aug_Nonterm.Char_Region.First > Aug_Token.Char_Region.First 
then
+                  Aug_Nonterm.Char_Region.First := Aug_Token.Char_Region.First;
+               end if;
+
+               if Aug_Nonterm.Char_Region.Last < Aug_Token.Char_Region.Last 
then
+                  Aug_Nonterm.Char_Region.Last := Aug_Token.Char_Region.Last;
+               end if;
+
+               Aug_Nonterm.Paren_State := Aug_Token.Paren_State;
+            end;
+         end if; -- Aug_Token not virtual
+      end loop;
+   end Reduce;
+
+   procedure Statement_Action
+     (Data    : in out Parse_Data_Type;
+      Tree    : in     Syntax_Trees.Tree;
+      Nonterm : in     Syntax_Trees.Valid_Node_Index;
+      Tokens  : in     Syntax_Trees.Valid_Node_Index_Array;
+      Params  : in     Statement_Param_Array)
+   is
+      First_Item         : Boolean     := True;
+      Override_Start_Set : Boolean     := False;
+      Override_Start     : Navigate_Class_Type;
+      Containing_Pos     : Nil_Buffer_Pos := Nil; --  wisi first-keyword-pos
+   begin
+      for Pair of Params loop
+         if Tree.Byte_Region (Tokens (Pair.Index)) /= Null_Buffer_Region then
+            declare
+               Token  : constant Aug_Token_Ref      := Get_Aug_Token (Data, 
Tree, Tokens (Pair.Index));
+               Cursor : Navigate_Cache_Trees.Cursor := 
Navigate_Cache_Trees.Find
+                 (Data.Navigate_Caches.Iterate, Token.Char_Region.First,
+                  Direction => Navigate_Cache_Trees.Unknown);
+            begin
+               if Navigate_Cache_Trees.Has_Element (Cursor) then
+                  declare
+                     Cache : Navigate_Cache_Type renames Data.Navigate_Caches 
(Cursor);
+                  begin
+                     Cache.Class          := (if Override_Start_Set then 
Override_Start else Pair.Class);
+                     Cache.Statement_ID   := Tree.ID (Nonterm);
+                     Cache.Containing_Pos := Containing_Pos;
+                  end;
+               else
+                  Cursor := Data.Navigate_Caches.Insert
+                    ((Pos            => Token.Char_Region.First,
+                      Statement_ID   => Tree.ID (Nonterm),
+                      ID             => Token.ID,
+                      Length         => Length (Token.Char_Region),
+                      Class          => (if Override_Start_Set then 
Override_Start else Pair.Class),
+                      Containing_Pos => Containing_Pos,
+                      others         => Nil));
+               end if;
+
+               Data.End_Positions.Append (Cursor);
+
+               if First_Item then
+                  First_Item := False;
+                  if Override_Start_Set or Pair.Class = Statement_Start then
+                     Override_Start_Set := False;
+                     Containing_Pos     := (True, Token.Char_Region.First);
+                  end if;
+               end if;
+
+               if Pair.Class = Statement_End and Containing_Pos.Set then
+                  Set_End (Data, Containing_Pos.Item, Token.Char_Region.First);
+               end if;
+            end;
+
+         else
+            --  Token.Byte_Region is null
+            if First_Item and Pair.Class = Statement_Start then
+               --  We don't reset First_Item here; next token may also be a 
start, if
+               --  this one is empty.
+               Override_Start_Set := True;
+               Override_Start     := Pair.Class;
+            end if;
+         end if;
+      end loop;
+   end Statement_Action;
+
+   procedure Containing_Action
+     (Data       : in out Parse_Data_Type;
+      Tree       : in     Syntax_Trees.Tree;
+      Nonterm    : in     Syntax_Trees.Valid_Node_Index;
+      Tokens     : in     Syntax_Trees.Valid_Node_Index_Array;
+      Containing : in     Positive_Index_Type;
+      Contained  : in     Positive_Index_Type)
+   is
+      use all type WisiToken.Syntax_Trees.Node_Label;
+      pragma Unreferenced (Nonterm);
+
+      --  [2] wisi-containing-action.
+      --
+      --  Compute as much as possible with virtual tokens; see
+      --  test/format_paramlist.adb
+   begin
+      if Tree.Label (Tokens (Containing)) = Syntax_Trees.Virtual_Terminal or
+        Tree.Label (Tokens (Contained)) = Syntax_Trees.Virtual_Terminal
+      then
+         return;
+      end if;
+
+      declare
+         use Navigate_Cache_Trees;
+         Containing_Tok    : constant Aug_Token_Ref := Get_Aug_Token (Data, 
Tree, Tokens (Containing));
+         Containing_Region : Buffer_Region renames Containing_Tok.Char_Region;
+         Contained_Tok     : constant Aug_Token_Ref := Get_Aug_Token (Data, 
Tree, Tokens (Contained));
+         Contained_Region  : Buffer_Region renames Contained_Tok.Char_Region;
+         Iterator          : constant Navigate_Cache_Trees.Iterator := 
Data.Navigate_Caches.Iterate;
+         Cursor            : Navigate_Cache_Trees.Cursor;
+         Mark              : constant Buffer_Pos                    := 
Containing_Region.First;
+      begin
+         if Containing_Region = Null_Buffer_Region then
+            if Tree.Is_Virtual (Tokens (Containing)) then
+               return;
+            else
+               raise Fatal_Error with Error_Message
+                 (File_Name => -Data.Source_File_Name,
+                  Line      => Containing_Tok.Line,
+                  Column    => Containing_Tok.Column,
+                  Message   => "wisi-containing-action: containing-region " &
+                    Image (Containing_Tok.ID, Data.Descriptor.all) &
+                    " is empty. grammar error; bad action.");
+            end if;
+         end if;
+
+         if not Data.Navigate_Caches.Present (Containing_Region.First) then
+            raise Fatal_Error with Error_Message
+              (File_Name => -Data.Source_File_Name,
+               Line      => Containing_Tok.Line,
+               Column    => Containing_Tok.Column,
+               Message   => "wisi-containing-action: containing token " &
+                 Image (Containing_Tok.ID, Data.Descriptor.all) &
+                 " has no cache. grammar error; missing action.");
+         end if;
+
+         if Contained_Tok.Char_Region /= Null_Buffer_Region then
+            --  Contained region is nil in an empty production.
+            Cursor := Previous (Iterator, Contained_Tok.Char_Region.Last);
+
+            while Has_Element (Cursor) loop
+               declare
+                  Cache : Navigate_Cache_Type renames Variable_Ref 
(Data.Navigate_Caches, Cursor).Element.all;
+               begin
+
+                  exit when Cache.Pos < Contained_Region.First or
+                    (Containing_Region.First = Contained_Region.First and
+                       Cache.Pos <= Contained_Region.First);
+
+                  --  Skip blocks that are already marked.
+
+                  if Cache.Containing_Pos.Set then
+                     Cursor := Find (Iterator, Cache.Containing_Pos.Item, 
Direction => Descending);
+                  else
+                     Cache.Containing_Pos := (True, Mark);
+                     Cursor := Previous (Iterator, Cursor);
+                  end if;
+
+               end;
+            end loop;
+         end if;
+      end;
+   end Containing_Action;
+
+   function "+" (Item : in WisiToken.Token_ID) return Token_ID_Lists.List
+   is begin
+      return Result : Token_ID_Lists.List do
+         Result.Append (Item);
+      end return;
+   end "+";
+
+   function "&" (List : in Token_ID_Lists.List; Item : in WisiToken.Token_ID) 
return Token_ID_Lists.List
+   is begin
+      return Result : Token_ID_Lists.List := List do
+         Result.Append (Item);
+      end return;
+   end "&";
+
+   function "&" (Left, Right : in WisiToken.Token_ID) return 
Token_ID_Lists.List
+   is begin
+      return Result : Token_ID_Lists.List do
+         Result.Append (Left);
+         Result.Append (Right);
+      end return;
+   end "&";
+
+   procedure Motion_Action
+     (Data    : in out Parse_Data_Type;
+      Tree    : in     Syntax_Trees.Tree;
+      Nonterm : in     Syntax_Trees.Valid_Node_Index;
+      Tokens  : in     Syntax_Trees.Valid_Node_Index_Array;
+      Params  : in     Motion_Param_Array)
+   is
+      pragma Unreferenced (Nonterm);
+
+      --  [2] wisi-motion-action
+      use Navigate_Cache_Trees;
+      use all type Ada.Containers.Count_Type;
+
+      Start             : Nil_Buffer_Pos := (Set => False);
+      Prev_Keyword_Mark : Nil_Buffer_Pos := (Set => False);
+      Iter              : constant Iterator := Data.Navigate_Caches.Iterate;
+      Prev_Cache_Cur    : Cursor;
+      Cache_Cur         : Cursor;
+      Point             : Buffer_Pos;
+
+      function Match (IDs : in Token_ID_Lists.List) return Boolean
+      is
+         Cache : Navigate_Cache_Type renames Constant_Ref 
(Data.Navigate_Caches, Cache_Cur).Element.all;
+      begin
+         --  [2] wisi-elisp-parse--match-token
+         if (Start.Set and then Point = Start.Item) or else
+           Cache.Containing_Pos = Start
+         then
+            for ID of IDs loop
+               if ID = Cache.ID then
+                  return True;
+               end if;
+            end loop;
+         end if;
+         return False;
+      end Match;
+
+   begin
+      for Param of Params loop
+         if Tree.Byte_Region (Tokens (Param.Index)) /= Null_Buffer_Region then
+            declare
+               Token  : constant Aug_Token_Ref := Get_Aug_Token (Data, Tree, 
Tokens (Param.Index));
+               Region : constant Buffer_Region := Token.Char_Region;
+            begin
+               if not Start.Set then
+                  Start := (True, Region.First);
+               end if;
+
+               Cache_Cur := Find (Iter, Region.First, Direction => Ascending);
+               if not Has_Element (Cache_Cur) then
+                  if Tree.Is_Virtual (Tokens (Param.Index)) then
+                     return;
+                  else
+                     raise Fatal_Error with Error_Message
+                       (File_Name => -Data.Source_File_Name,
+                        Line      => Token.Line,
+                        Column    => Token.Column,
+                        Message   => "wisi-motion-action: token " &
+                          Token.Image (Data.Descriptor.all) &
+                          " has no cache; add to statement-action.");
+                  end if;
+               end if;
+
+               if Param.IDs.Length = 0 then
+                  if Prev_Keyword_Mark.Set then
+                     Variable_Ref (Data.Navigate_Caches, 
Cache_Cur).Element.Prev_Pos      := Prev_Keyword_Mark;
+                     Variable_Ref (Data.Navigate_Caches, 
Prev_Cache_Cur).Element.Next_Pos := (True, Region.First);
+                  end if;
+
+                  Prev_Keyword_Mark := (True, Region.First);
+                  Prev_Cache_Cur    := Cache_Cur;
+
+               else
+                  Point := Region.First;
+                  loop
+                     exit when Point >= Region.Last;
+                     if Match (Param.IDs) then
+                        if Prev_Keyword_Mark.Set then
+                           if not Constant_Ref (Data.Navigate_Caches, 
Cache_Cur).Element.Prev_Pos.Set and
+                             not Constant_Ref (Data.Navigate_Caches, 
Prev_Cache_Cur).Element.Next_Pos.Set
+                           then
+                              Variable_Ref (Data.Navigate_Caches, 
Cache_Cur).Element.Prev_Pos      := Prev_Keyword_Mark;
+                              Variable_Ref (Data.Navigate_Caches, 
Prev_Cache_Cur).Element.Next_Pos := (True, Point);
+                              Prev_Keyword_Mark := (True, Point);
+                              Prev_Cache_Cur    := Cache_Cur;
+                           end if;
+                        else
+                           Prev_Keyword_Mark := (True, Point);
+                           Prev_Cache_Cur    := Cache_Cur;
+                        end if;
+                     end if;
+
+                     Cache_Cur := Next (Iter, Cache_Cur);
+                     exit when Cache_Cur = No_Element;
+
+                     Point := Constant_Ref (Data.Navigate_Caches, 
Cache_Cur).Element.Pos;
+                  end loop;
+               end if;
+            end;
+         end if;
+      end loop;
+   end Motion_Action;
+
+   procedure Face_Apply_Action
+     (Data    : in out Parse_Data_Type;
+      Tree    : in     Syntax_Trees.Tree;
+      Nonterm : in     Syntax_Trees.Valid_Node_Index;
+      Tokens  : in     Syntax_Trees.Valid_Node_Index_Array;
+      Params  : in     Face_Apply_Param_Array)
+   is
+      pragma Unreferenced (Nonterm);
+
+      --  [2] wisi-face-apply-action
+      use Face_Cache_Trees;
+
+      Iter       : constant Iterator := Data.Face_Caches.Iterate;
+      Cache_Cur  : Cursor;
+      Suffix_Cur : Cursor;
+   begin
+      for Param of Params loop
+         if Tree.Byte_Region (Tokens (Param.Index)) /= Null_Buffer_Region then
+            declare
+               Token : constant Aug_Token_Ref := Get_Aug_Token (Data, Tree, 
Tokens (Param.Index));
+            begin
+               Cache_Cur := Find (Iter, Token.Char_Region.First, Direction => 
Ascending);
+               if Has_Element (Cache_Cur) then
+                  declare
+                     Cache : Face_Cache_Type renames Variable_Ref 
(Data.Face_Caches, Cache_Cur).Element.all;
+                  begin
+                     case Cache.Class is
+                     when Prefix =>
+                        Cache.Face := (True, Param.Prefix_Face);
+
+                        --  Check for suffix
+                        Suffix_Cur := Next (Iter, Cache_Cur);
+                        if Has_Element (Suffix_Cur) then
+                           declare
+                              Suf_Cache : Face_Cache_Type renames Variable_Ref
+                                (Data.Face_Caches, Suffix_Cur).Element.all;
+                           begin
+                              if Suffix = Suf_Cache.Class and
+                                Inside (Suf_Cache.Region.First, 
Token.Char_Region)
+                              then
+                                 Suf_Cache.Face := (True, Param.Suffix_Face);
+                              end if;
+                           end;
+                        end if;
+
+                     when Suffix =>
+                        Cache.Face := (True, Param.Suffix_Face);
+                     end case;
+                  end;
+               else
+                  Data.Face_Caches.Insert ((Token.Char_Region, Suffix, (True, 
Param.Suffix_Face)));
+               end if;
+            end;
+         end if;
+      end loop;
+   end Face_Apply_Action;
+
+   procedure Face_Apply_List_Action
+     (Data    : in out Parse_Data_Type;
+      Tree    : in     Syntax_Trees.Tree;
+      Nonterm : in     Syntax_Trees.Valid_Node_Index;
+      Tokens  : in     Syntax_Trees.Valid_Node_Index_Array;
+      Params  : in     Face_Apply_Param_Array)
+   is
+      pragma Unreferenced (Nonterm);
+
+      --  [2] wisi-face-apply-list-action
+      use Face_Cache_Trees;
+
+      Iter      : constant Iterator := Data.Face_Caches.Iterate;
+      Cache_Cur : Cursor;
+   begin
+      for Param of Params loop
+         if Tree.Byte_Region (Tokens (Param.Index)) /= Null_Buffer_Region then
+            declare
+               Token : constant Aug_Token_Ref := Get_Aug_Token (Data, Tree, 
Tokens (Param.Index));
+            begin
+               Cache_Cur := Find_In_Range (Iter, Ascending, 
Token.Char_Region.First, Token.Char_Region.Last);
+               loop
+                  exit when not Has_Element (Cache_Cur) or else
+                    Constant_Ref (Data.Face_Caches, 
Cache_Cur).Element.Region.First > Token.Char_Region.Last;
+                  declare
+                     Cache : Face_Cache_Type renames Variable_Ref 
(Data.Face_Caches, Cache_Cur).Element.all;
+                  begin
+                     case Cache.Class is
+                     when Prefix =>
+                        Cache.Face := (True, Param.Prefix_Face);
+
+                     when Suffix =>
+                        Cache.Face := (True, Param.Suffix_Face);
+                     end case;
+                  end;
+                  Cache_Cur := Next (Iter, Cache_Cur);
+               end loop;
+            end;
+         end if;
+      end loop;
+   end Face_Apply_List_Action;
+
+   procedure Face_Mark_Action
+     (Data    : in out Parse_Data_Type;
+      Tree    : in     Syntax_Trees.Tree;
+      Nonterm : in     Syntax_Trees.Valid_Node_Index;
+      Tokens  : in     Syntax_Trees.Valid_Node_Index_Array;
+      Params  : in     Face_Mark_Param_Array)
+   is
+      pragma Unreferenced (Nonterm);
+
+      --  [2] wisi-face-apply-action
+      use Face_Cache_Trees;
+
+      Iter      : constant Iterator := Data.Face_Caches.Iterate;
+      Cache_Cur : Cursor;
+   begin
+      for Param of Params loop
+         if Tree.Byte_Region (Tokens (Param.Index)) /= Null_Buffer_Region then
+            declare
+               Token : constant Aug_Token_Ref := Get_Aug_Token (Data, Tree, 
Tokens (Param.Index));
+            begin
+               Cache_Cur := Find (Iter, Token.Char_Region.First, Direction => 
Ascending);
+               if Has_Element (Cache_Cur) then
+                  declare
+                     Cache : Face_Cache_Type renames Variable_Ref 
(Data.Face_Caches, Cache_Cur).Element.all;
+                     Other_Cur : Cursor := Find_In_Range
+                       (Iter, Ascending, Cache.Region.Last + 1, 
Token.Char_Region.Last);
+                     Temp : Cursor;
+                  begin
+                     loop
+                        exit when not Has_Element (Other_Cur) or else
+                          Constant_Ref (Data.Face_Caches, 
Other_Cur).Element.Region.First > Token.Char_Region.Last;
+                        Temp := Other_Cur;
+                        Other_Cur := Next (Iter, Other_Cur);
+                        Delete (Data.Face_Caches, Temp);
+                     end loop;
+
+                     Cache.Class       := Param.Class;
+                     Cache.Region.Last := Token.Char_Region.Last;
+                  end;
+               else
+                  Data.Face_Caches.Insert ((Token.Char_Region, Param.Class, 
(Set => False)));
+               end if;
+            end;
+         end if;
+      end loop;
+   end Face_Mark_Action;
+
+   procedure Face_Remove_Action
+     (Data    : in out Parse_Data_Type;
+      Tree    : in     Syntax_Trees.Tree;
+      Nonterm : in     Syntax_Trees.Valid_Node_Index;
+      Tokens  : in     Syntax_Trees.Valid_Node_Index_Array;
+      Params  : in     Face_Remove_Param_Array)
+   is
+      pragma Unreferenced (Nonterm);
+
+      --  [2] wisi-face-remove-action
+      use Face_Cache_Trees;
+
+      Iter      : constant Iterator := Data.Face_Caches.Iterate;
+      Cache_Cur : Cursor;
+      Temp      : Cursor;
+   begin
+      for I of Params loop
+         if Tree.Byte_Region (Tokens (I)) /= Null_Buffer_Region then
+            declare
+               Token : constant Aug_Token_Ref := Get_Aug_Token (Data, Tree, 
Tokens (I));
+            begin
+               Cache_Cur := Find_In_Range (Iter, Ascending, 
Token.Char_Region.First, Token.Char_Region.Last);
+               loop
+                  exit when not Has_Element (Cache_Cur) or else
+                    Constant_Ref (Data.Face_Caches, 
Cache_Cur).Element.Region.First > Token.Char_Region.Last;
+                  Temp := Cache_Cur;
+                  Cache_Cur := Next (Iter, Cache_Cur);
+                  Delete (Data.Face_Caches, Temp);
+               end loop;
+            end;
+         end if;
+      end loop;
+   end Face_Remove_Action;
+
+   function "+" (Item : in Integer) return Indent_Arg_Arrays.Vector
+   is begin
+      return Result : Indent_Arg_Arrays.Vector do
+         Result.Append (Item);
+      end return;
+   end "+";
+
+   function "&" (List : in Indent_Arg_Arrays.Vector; Item : in Integer) return 
Indent_Arg_Arrays.Vector
+   is begin
+      return Result : Indent_Arg_Arrays.Vector := List do
+         Result.Append (Item);
+      end return;
+   end "&";
+
+   function "&" (Left, Right : in Integer) return Indent_Arg_Arrays.Vector
+   is begin
+      return Result : Indent_Arg_Arrays.Vector do
+         Result.Append (Left);
+         Result.Append (Right);
+      end return;
+   end "&";
+
+   function Image (Item : in Simple_Indent_Param) return String
+   is begin
+      return "(" & Simple_Indent_Param_Label'Image (Item.Label) &
+        (case Item.Label is
+         when Int => Integer'Image (Item.Int_Delta),
+         when Anchored_Label => WisiToken.Positive_Index_Type'Image 
(Item.Anchored_Index) & "," &
+              Integer'Image (Item.Anchored_Delta),
+         when Language => "<language_function>") & ")";
+   end Image;
+
+   function Image (Item : in Indent_Param) return String
+   is begin
+      return "(" & Indent_Param_Label'Image (Item.Label) & ", " &
+        (case Item.Label is
+         when Simple => Image (Item.Param),
+         when Hanging_Label =>
+            Image (Item.Hanging_Delta_1) & ", "  & Image 
(Item.Hanging_Delta_2) & ")");
+   end Image;
+
+   function Image (Item : in Indent_Pair) return String
+   is begin
+      return "(" & Image (Item.Code_Delta) &
+        (if Item.Comment_Present
+         then ", " & Image (Item.Comment_Delta)
+         else "") & ")";
+   end Image;
+
+   procedure Indent_Action_0
+     (Data    : in out Parse_Data_Type'Class;
+      Tree    : in     Syntax_Trees.Tree;
+      Nonterm : in     Syntax_Trees.Valid_Node_Index;
+      Tokens  : in     Syntax_Trees.Valid_Node_Index_Array;
+      Params  : in     Indent_Param_Array)
+   is begin
+      if Trace_Action > Outline then
+         Ada.Text_IO.Put_Line ("indent_action_0: " & Tree.Image (Nonterm, 
Data.Descriptor.all));
+      end if;
+
+      --  [2] wisi-indent-action
+      for I in Tokens'Range loop
+         if Tree.Byte_Region (Tokens (I)) /= Null_Buffer_Region then
+            declare
+               use all type SAL.Base_Peek_Type;
+               Tree_Token : constant Syntax_Trees.Valid_Node_Index := Tokens 
(I);
+
+               Token             : constant Aug_Token_Ref := Get_Aug_Token 
(Data, Tree, Tree_Token);
+               Pair              : Indent_Pair renames Params (I);
+               Code_Delta        : Delta_Type;
+               Comment_Param     : Indent_Param;
+               Comment_Param_Set : Boolean                := False;
+               Comment_Delta     : Delta_Type;
+            begin
+               if Trace_Action > Detail then
+                  Ada.Text_IO.Put_Line
+                    ("indent_action_0 a: " & Tree.Image (Tree_Token, 
Data.Descriptor.all) & ": " & Image (Pair));
+               end if;
+
+               if Token.First_Indent_Line /= Invalid_Line_Number then
+                  Code_Delta := Indent_Compute_Delta
+                    (Data, Tree, Tokens, Pair.Code_Delta, Tree_Token, 
Indenting_Comment => False);
+
+                  if Code_Delta /= Null_Delta then
+                     Indent_Token_1 (Data, Token, Code_Delta, 
Indenting_Comment => False);
+                  end if;
+               end if;
+
+               if Token.First_Trailing_Comment_Line /= Invalid_Line_Number then
+                  if Pair.Comment_Present then
+                     Comment_Param     := Pair.Comment_Delta;
+                     Comment_Param_Set := True;
+
+                  elsif I < Tokens'Last then
+                     Comment_Param     := Params (I + 1).Code_Delta;
+                     Comment_Param_Set := True;
+                  end if;
+
+                  if Comment_Param_Set then
+                     Comment_Delta := Indent_Compute_Delta
+                       (Data, Tree, Tokens, Comment_Param, Tree_Token, 
Indenting_Comment => True);
+
+                     if Comment_Delta /= Null_Delta then
+                        Indent_Token_1 (Data, Token, Comment_Delta, 
Indenting_Comment => True);
+                     end if;
+                  end if;
+               end if;
+            end;
+         end if;
+      end loop;
+   end Indent_Action_0;
+
+   procedure Indent_Action_1
+     (Data    : in out Parse_Data_Type'Class;
+      Tree    : in     Syntax_Trees.Tree;
+      Nonterm : in     Syntax_Trees.Valid_Node_Index;
+      Tokens  : in     Syntax_Trees.Valid_Node_Index_Array;
+      N       : in     Positive_Index_Type;
+      Params  : in     Indent_Param_Array)
+   is
+      use all type WisiToken.Syntax_Trees.Node_Label;
+   begin
+      --  [2] wisi-indent-action*
+      for I in Tokens'First .. N loop
+         if Tree.Label (Tokens (I)) /= Virtual_Terminal and then
+           Get_Aug_Token (Data, Tree, Tokens (I)).First
+         then
+            Indent_Action_0 (Data, Tree, Nonterm, Tokens, Params);
+            return;
+         end if;
+      end loop;
+   end Indent_Action_1;
+
+   function Indent_Hanging_1
+     (Data              : in out Parse_Data_Type;
+      Tree              : in     Syntax_Trees.Tree;
+      Tokens            : in     Syntax_Trees.Valid_Node_Index_Array;
+      Tree_Indenting    : in     Syntax_Trees.Valid_Node_Index;
+      Indenting_Comment : in     Boolean;
+      Delta_1           : in     Simple_Indent_Param;
+      Delta_2           : in     Simple_Indent_Param;
+      Option            : in     Boolean;
+      Accumulate        : in     Boolean)
+     return Delta_Type
+   is
+      Indenting_Token : constant Aug_Token_Ref := Get_Aug_Token (Data, Tree, 
Tree_Indenting);
+   begin
+      --  [2] wisi-elisp-parse--hanging-1
+      if Indenting_Comment then
+         return Indent_Compute_Delta
+           (Data, Tree, Tokens, (Simple, Delta_1), Tree_Indenting, 
Indenting_Comment);
+      else
+         return
+           (Hanging,
+            Hanging_First_Line  => Indenting_Token.Line,
+            Hanging_Paren_State => Indenting_Token.Paren_State,
+            Hanging_Delta_1     => Indent_Compute_Delta
+              (Data, Tree, Tokens, (Simple, Delta_1), Tree_Indenting, 
Indenting_Comment).Simple_Delta,
+            Hanging_Delta_2     =>
+              (if (not Option) or
+                 Indenting_Token.Line = Indenting_Token.First_Indent_Line -- 
first token in tok is first on line
+               then Indent_Compute_Delta
+                 (Data, Tree, Tokens, (Simple, Delta_2), Tree_Indenting, 
Indenting_Comment).Simple_Delta
+               else Indent_Compute_Delta
+                 (Data, Tree, Tokens, (Simple, Delta_1), Tree_Indenting, 
Indenting_Comment).Simple_Delta),
+            Hanging_Accumulate => Accumulate);
+      end if;
+   end Indent_Hanging_1;
+
+   procedure Put (Data : in out Parse_Data_Type)
+   is begin
+      case Data.Post_Parse_Action is
+      when Navigate =>
+         for Cache of Data.Navigate_Caches loop
+            Put (Cache);
+         end loop;
+
+      when Face =>
+         for Cache of Data.Face_Caches loop
+            Put (Cache);
+         end loop;
+
+      when Indent =>
+         --  We don't need "Indent_Leading_Comments"; they are indented to 0,
+         --  which is the default.
+
+         Resolve_Anchors (Data);
+
+         --  Can't set indent for first line
+         for I in Data.Indents.First_Index + 1 .. Data.Indents.Last_Index loop
+            Put (I, Data.Indents (I));
+         end loop;
+      end case;
+   end Put;
+
+   procedure Put
+     (Data         : in Parse_Data_Type;
+      Lexer_Errors : in Lexer.Error_Lists.List;
+      Parse_Errors : in Parse.LR.Parse_Error_Lists.List;
+      Tree         : in Syntax_Trees.Tree)
+   is
+      use all type SAL.Base_Peek_Type;
+      use Ada.Text_IO;
+      use Semantic_Checks;
+
+      function Safe_Pos (Node : in Syntax_Trees.Valid_Node_Index) return 
Buffer_Pos
+      is
+         --  Return a reasonable position for the error at Node.
+         --
+         --  In a successful parse with error recovery, Node is a terminal with
+         --  an augmented token in Data.Terminals, so that is the first
+         --  choice.
+         --
+         --  If this is an error due to a bad recovery, Node may be a virtual
+         --  token, with no position information, so we try to get information
+         --  from its parent.
+         use Syntax_Trees;
+
+         N : Node_Index := Node;
+      begin
+         loop
+            if Tree.Label (N) /= Virtual_Terminal then
+               declare
+                  Ref : constant Aug_Token_Ref := Get_Aug_Token (Data, Tree, 
N);
+               begin
+                  if Ref.Char_Region /= Null_Buffer_Region then
+                     return Ref.Element.Char_Region.First;
+                  end if;
+
+               end;
+            end if;
+            N := Tree.Parent (N);
+            exit when N = Invalid_Node_Index;
+         end loop;
+         return Buffer_Pos'First;
+      end Safe_Pos;
+
+      function Safe_Pos (Token : in Recover_Token) return Buffer_Pos
+      is begin
+         if Token.Name /= Null_Buffer_Region then
+            return Token.Name.First;
+
+         elsif Token.Byte_Region = Null_Buffer_Region then
+            return Buffer_Pos'First;
+
+         else
+            return Token.Byte_Region.First;
+         end if;
+      end Safe_Pos;
+
+   begin
+      for Item of Lexer_Errors loop
+         Put_Line
+           ('[' & Lexer_Error_Code & Buffer_Pos'Image (Item.Char_Pos) &
+              " ""lexer error" &
+              (if Item.Recover_Char (1) = ASCII.NUL
+               then """"
+               elsif Item.Recover_Char (1) = '"'
+               then """ ?\"""
+               else """ ?" & Item.Recover_Char (1)) &
+              "]");
+         if Item.Recover_Char (2) /= ASCII.NUL then
+            raise SAL.Programmer_Error with "lexer error with non-ascii or 
multiple repair char";
+         end if;
+      end loop;
+
+      for Item of Parse_Errors loop
+         --  We don't include parser id here; not very useful.
+         case Item.Label is
+         when Parse.LR.Action =>
+            Put_Line
+              ('[' & Parser_Error_Code & Buffer_Pos'Image (Safe_Pos 
(Item.Error_Token)) &
+                 " ""syntax error: expecting " & Image (Item.Expecting, 
Data.Descriptor.all) &
+                 ", found '" & Image (Tree.ID (Item.Error_Token), 
Data.Descriptor.all) & "'""]");
+
+         when Parse.LR.Check =>
+            Put_Line
+              ('[' & Check_Error_Code & Integer'Image
+                 (Semantic_Checks.Check_Status_Label'Pos 
(Item.Check_Status.Label)) &
+                 (case Item.Check_Status.Label is
+                  when Ok => "",
+                  when Error =>
+                     Buffer_Pos'Image (Safe_Pos 
(Item.Check_Status.Begin_Name)) &
+                     Buffer_Pos'Image (Safe_Pos (Item.Check_Status.End_Name)) &
+                       " ""block name error""]"));
+
+         when Parse.LR.Message =>
+            Put_Line
+              ('[' & Parser_Error_Code & Buffer_Pos'Image (Buffer_Pos'First) &
+                 " """ & (-Item.Msg) & """]");
+         end case;
+
+         if Item.Recover.Stack.Depth > 0 then
+            Put (Item.Recover, Data.Terminals, Data.Descriptor.all);
+         end if;
+      end loop;
+   end Put;
+
+   procedure Put_Error (Data : in Parse_Data_Type; Line_Number : in 
Line_Number_Type; Message : in String)
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line ("(error """ & Error_Message (-Data.Source_File_Name, 
Line_Number, 0, Message) & """)");
+   end Put_Error;
+
+   ----------
+   --  Spec visible private subprograms, alphabetical
+
+   function Image (Item : in Simple_Delta_Type) return String
+   is begin
+      return "(" & Simple_Delta_Labels'Image (Item.Label) &
+        (case Item.Label is
+         when Int => Integer'Image (Item.Int_Delta),
+         when Anchored => Integer'Image (Item.Anchored_ID) & Integer'Image 
(Item.Anchored_Delta) & " " &
+              Boolean'Image (Item.Anchored_Accumulate) & ")");
+   end Image;
+
+   function Image (Item : in Delta_Type) return String
+   is begin
+      return "(" & Delta_Labels'Image (Item.Label) &
+        (case Item.Label is
+         when Simple => " " & Image (Item.Simple_Delta),
+         when Hanging => Line_Number_Type'Image (Item.Hanging_First_Line) & 
Integer'Image (Item.Hanging_Paren_State) &
+              " " & Image (Item.Hanging_Delta_1) & " " & Image 
(Item.Hanging_Delta_2) & " " &
+              Boolean'Image (Item.Hanging_Accumulate)) & ")";
+   end Image;
+
+   function Current_Indent_Offset
+     (Data         : in Parse_Data_Type;
+      Anchor_Token : in Augmented_Token'Class;
+      Offset       : in Integer)
+     return Integer
+   is begin
+      return Offset + Integer (Anchor_Token.Char_Region.First - 
Data.Line_Begin_Pos (Anchor_Token.Line));
+   end Current_Indent_Offset;
+
+   function Find
+     (Data  : in Parse_Data_Type;
+      ID    : in Token_ID;
+      Token : in Augmented_Token'Class)
+     return Base_Token_Index
+   is begin
+      --  linear search for ID.
+      for I in Token.First_Terminals_Index .. Token.Last_Terminals_Index loop
+         if Data.Terminals (I).ID = ID then
+            return I;
+         end if;
+      end loop;
+      return Augmented_Token_Arrays.No_Index;
+   end Find;
+
+   function First_Line
+     (Token             : in Augmented_Token;
+      Indenting_Comment : in Boolean)
+     return Line_Number_Type
+   is begin
+      return
+        (if Indenting_Comment then
+           (if Token.First_Trailing_Comment_Line = Invalid_Line_Number
+            then Token.Line
+            else Token.First_Trailing_Comment_Line)
+         else
+           (if Token.First_Indent_Line = Invalid_Line_Number
+            then Token.Line
+            else Token.First_Indent_Line));
+   end First_Line;
+
+   function Get_Aug_Token
+     (Data       : in Parse_Data_Type'Class;
+      Tree       : in Syntax_Trees.Tree'Class;
+      Tree_Index : in Syntax_Trees.Valid_Node_Index)
+     return Aug_Token_Ref
+   is
+      use all type Syntax_Trees.Node_Label;
+   begin
+      return
+        (case Tree.Label (Tree_Index) is
+         when Shared_Terminal => Data.Terminals.Variable_Ref (Tree.Terminal 
(Tree_Index)),
+         when Virtual_Terminal => raise SAL.Programmer_Error with 
"wisi_runtime.get_aug_token virtual terminal",
+         when Nonterm => (Element => Augmented_Token_Access (Tree.Augmented 
(Tree_Index))));
+   end Get_Aug_Token;
+
+   overriding
+   function Image
+     (Item       : in Augmented_Token;
+      Descriptor : in WisiToken.Descriptor)
+     return String
+   is
+      ID_Image : constant String := WisiToken.Image (Item.ID, Descriptor);
+   begin
+      if Item.Line /= Invalid_Line_Number and Trace_Action <= Detail then
+         return "(" & ID_Image &
+           Line_Number_Type'Image (Item.Line) & ":" & Trimmed_Image (Integer 
(Item.Column)) & ")";
+
+      elsif Item.Char_Region = Null_Buffer_Region then
+         return "(" & ID_Image & ")";
+
+      else
+         return "(" & ID_Image & ", " & Image (Item.Char_Region) & ")";
+      end if;
+   end Image;
+
+   function Image
+     (Item       : in Augmented_Token_Access_Array;
+      Descriptor : in WisiToken.Descriptor)
+     return String
+   is
+      use all type SAL.Base_Peek_Type;
+      use Ada.Strings.Unbounded;
+      Result : Unbounded_String := +"(";
+   begin
+      for I in Item'Range loop
+         Result := Result & Image (Item (I).all, Descriptor);
+         if I /= Item'Last then
+            Result := Result & ", ";
+         end if;
+      end loop;
+      Result := Result & ")";
+      return -Result;
+   end Image;
+
+   function Indent_Anchored_2
+     (Data        : in out Parse_Data_Type;
+      Anchor_Line : in     Line_Number_Type;
+      Last_Line   : in     Line_Number_Type;
+      Offset      : in     Integer;
+      Accumulate  : in     Boolean)
+     return Delta_Type
+   is
+      use Anchor_ID_Vectors;
+      --  We can't use a Reference here, because the Element in reference
+      --  types is constrained (as are all allocated objects of access
+      --  types; AARM 4.8 (6/3)), and we may need to change the Label.
+      Indent    : Indent_Type      := Data.Indents (Anchor_Line);
+      Anchor_ID : constant Integer := 1 + Max_Anchor_ID (Data, Anchor_Line, 
Last_Line);
+   begin
+      --  [2] wisi-elisp-parse--anchored-2
+      Data.Max_Anchor_ID := Integer'Max (Data.Max_Anchor_ID, Anchor_ID);
+
+      case Indent.Label is
+      when Not_Set =>
+         Indent := (Anchor, To_Vector (Anchor_ID, 1), 0);
+
+      when Int =>
+         Indent := (Anchor, To_Vector (Anchor_ID, 1), Indent.Int_Indent);
+
+      when Anchor =>
+         Indent.Anchor_IDs := Anchor_ID & Indent.Anchor_IDs;
+
+      when Anchored =>
+         Indent := (Anchor_Anchored, To_Vector (Anchor_ID, 1), 
Indent.Anchored_ID, Indent.Anchored_Delta);
+
+      when Anchor_Anchored =>
+         Indent.Anchor_Anchored_IDs := Anchor_ID & Indent.Anchor_Anchored_IDs;
+      end case;
+
+      Data.Indents.Replace_Element (Anchor_Line, Indent);
+
+      return (Simple, (Anchored, Anchor_ID, Offset, Accumulate));
+   end Indent_Anchored_2;
+
+   function Indent_Compute_Delta
+     (Data              : in out Parse_Data_Type'Class;
+      Tree              : in     Syntax_Trees.Tree;
+      Tokens            : in     Syntax_Trees.Valid_Node_Index_Array;
+      Param             : in     Indent_Param;
+      Tree_Indenting    : in     Syntax_Trees.Valid_Node_Index;
+      Indenting_Comment : in     Boolean)
+     return Delta_Type
+   is
+      Indenting_Token : constant Aug_Token_Ref := Get_Aug_Token (Data, Tree, 
Tree_Indenting);
+   begin
+      --  [2] wisi-elisp-parse--indent-compute-delta, which evals 
wisi-anchored*, wisi-hanging*.
+      case Param.Label is
+      when Simple =>
+         case Param.Param.Label is
+         when Int =>
+            return (Simple, (Int, Param.Param.Int_Delta));
+
+         when Anchored_Label =>
+            if Indenting_Token.Byte_Region = Null_Buffer_Region or
+              Tree.Byte_Region (Tokens (Param.Param.Anchored_Index)) = 
Null_Buffer_Region
+            then
+               --  One of these is an entirely virtual token
+               return Null_Delta;
+            else
+               declare
+                  Anchor_Token : constant Aug_Token_Ref := Get_Aug_Token
+                    (Data, Tree, Tokens (Param.Param.Anchored_Index));
+               begin
+                  case Anchored_Label'(Param.Param.Label) is
+                  when Anchored_0 =>
+                     --  [2] wisi-anchored, wisi-anchored-1
+                     return Indent_Anchored_2
+                       (Data,
+                        Anchor_Line => Anchor_Token.Line,
+                        Last_Line   => Indenting_Token.Last_Line 
(Indenting_Comment),
+                        Offset      => Current_Indent_Offset (Data, 
Anchor_Token, Param.Param.Anchored_Delta),
+                        Accumulate  => True);
+
+                  when Anchored_1 =>
+                     --  [2] wisi-anchored%
+                     return Indent_Anchored_2
+                       (Data,
+                        Anchor_Line => Anchor_Token.Line,
+                        Last_Line   => Indenting_Token.Last_Line 
(Indenting_Comment),
+                        Offset      => Paren_In_Anchor_Line (Data, 
Anchor_Token, Param.Param.Anchored_Delta),
+                        Accumulate  => True);
+
+                  when Anchored_2 =>
+                     --  [2] wisi-anchored%-
+                     return Indent_Anchored_2
+                       (Data,
+                        Anchor_Line => Anchor_Token.Line,
+                        Last_Line   => Indenting_Token.Last_Line 
(Indenting_Comment),
+                        Offset      => Paren_In_Anchor_Line (Data, 
Anchor_Token, Param.Param.Anchored_Delta),
+                        Accumulate  => False);
+
+                  when Anchored_3 =>
+                     --  [2] wisi-anchored*
+                     if Indenting_Token.First then
+                        return Indent_Anchored_2
+                          (Data,
+                           Anchor_Line => Anchor_Token.Line,
+                           Last_Line   => Indenting_Token.Last_Line 
(Indenting_Comment),
+                           Offset      => Current_Indent_Offset (Data, 
Anchor_Token, Param.Param.Anchored_Delta),
+                           Accumulate  => True);
+
+                     else
+                        return Null_Delta;
+                     end if;
+
+                  when Anchored_4 =>
+                     --  [2] wisi-anchored*-
+                     return Indent_Anchored_2
+                       (Data,
+                        Anchor_Line => Anchor_Token.Line,
+                        Last_Line   => Indenting_Token.Last_Line 
(Indenting_Comment),
+                        Offset      => Current_Indent_Offset (Data, 
Anchor_Token, Param.Param.Anchored_Delta),
+                        Accumulate  => False);
+
+                  end case;
+               end;
+            end if;
+
+         when Language =>
+            return Param.Param.Function_Ptr
+              (Data, Tree, Tokens, Tree_Indenting, Indenting_Comment, 
Param.Param.Args);
+         end case;
+
+      when Hanging_Label =>
+         case Hanging_Label'(Param.Label) is
+         when Hanging_0 => -- wisi-hanging
+            return Indent_Hanging_1
+              (Data, Tree, Tokens, Tree_Indenting, Indenting_Comment, 
Param.Hanging_Delta_1,
+               Param.Hanging_Delta_2,
+               Option => False, Accumulate => True);
+         when Hanging_1 => -- wisi-hanging%
+            return Indent_Hanging_1
+              (Data, Tree, Tokens, Tree_Indenting, Indenting_Comment, 
Param.Hanging_Delta_1,
+               Param.Hanging_Delta_2,
+               Option => True, Accumulate => True);
+         when Hanging_2 => -- wisi-hanging%-
+            return Indent_Hanging_1
+              (Data, Tree, Tokens, Tree_Indenting, Indenting_Comment, 
Param.Hanging_Delta_1,
+               Param.Hanging_Delta_2,
+               Option => True, Accumulate => False);
+         end case;
+      end case;
+   end Indent_Compute_Delta;
+
+   procedure Indent_Token_1
+     (Data              : in out Parse_Data_Type;
+      Indenting_Token   : in     Augmented_Token'Class;
+      Delta_Indent      : in     Delta_Type;
+      Indenting_Comment : in     Boolean)
+   is
+      First_Line : constant Line_Number_Type := Indenting_Token.First_Line 
(Indenting_Comment);
+      Last_Line  : constant Line_Number_Type := Indenting_Token.Last_Line 
(Indenting_Comment);
+   begin
+      if Trace_Action > Detail then
+         Ada.Text_IO.Put_Line
+           ("indent_token_1: " & Indenting_Token.Image (Data.Descriptor.all) & 
" " & Image (Delta_Indent) &
+              Line_Number_Type'Image (First_Line) & " .." & 
Line_Number_Type'Image (Last_Line) &
+              (if Indenting_Comment then " comment" else ""));
+      end if;
+
+      for Line in First_Line .. Last_Line loop
+         if Data.Indent_Comment_Col_0 then
+            declare
+               use all type Ada.Text_IO.Count;
+               Indent : Boolean := True;
+            begin
+               if Data.Line_Begin_Token.all (Line) /= 
Augmented_Token_Arrays.No_Index then
+                  for Tok of Data.Terminals (Data.Line_Begin_Token.all (Line - 
1)).Non_Grammar loop
+                     if Tok.Line = Line and then
+                       Tok.ID = Data.Descriptor.Comment_ID and then
+                       Tok.Col = 0
+                     then
+                        Indent := False;
+                        exit;
+                     end if;
+                  end loop;
+               end if;
+
+               if Indent then
+                  Indent_Line (Data, Line, Delta_Indent);
+               end if;
+            end;
+         else
+            Indent_Line (Data, Line, Delta_Indent);
+         end if;
+      end loop;
+   end Indent_Token_1;
+
+   function Last_Line
+     (Token             : in Augmented_Token;
+      Indenting_Comment : in Boolean)
+     return Line_Number_Type
+   is begin
+      return
+        (if Indenting_Comment then
+           (if Token.Last_Trailing_Comment_Line = Invalid_Line_Number
+            then Token.Line
+            else Token.Last_Trailing_Comment_Line)
+         else
+           (if Token.Last_Indent_Line = Invalid_Line_Number
+            then Token.Line
+            else Token.Last_Indent_Line));
+   end Last_Line;
+
+end Wisi;
diff --git a/wisi.ads b/wisi.ads
new file mode 100644
index 0000000..cfc61e1
--- /dev/null
+++ b/wisi.ads
@@ -0,0 +1,666 @@
+--  Abstract :
+--
+--  Ada implementation of wisi parser actions.
+--
+--  References
+--
+--  [1] wisi.el - defines parse action functions.
+--
+--  [2] wisi-elisp-parse.el - defines parse action functions.
+--
+--  [3] wisi-process-parse.el - defines elisp/process API
+--
+--  Copyright (C) 2017, 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Containers.Doubly_Linked_Lists;
+with Ada.Containers.Vectors;
+with Ada.Strings.Unbounded;
+with Ada.Text_IO;
+with Ada.Unchecked_Deallocation;
+with SAL.Gen_Unbounded_Definite_Red_Black_Trees;
+with SAL.Gen_Unbounded_Definite_Vectors;
+with WisiToken.Parse.LR;
+with WisiToken.Lexer;
+with WisiToken.Syntax_Trees;
+package Wisi is
+   use all type WisiToken.Base_Buffer_Pos;
+
+   type Post_Parse_Action_Type is (Navigate, Face, Indent);
+
+   type Parse_Data_Type
+     (Line_Begin_Token : not null access constant 
WisiToken.Line_Begin_Token_Vectors.Vector)
+     is new WisiToken.Syntax_Trees.User_Data_Type with private;
+
+   procedure Initialize
+     (Data              : in out Parse_Data_Type;
+      Descriptor        : access constant WisiToken.Descriptor;
+      Source_File_Name  : in     String;
+      Post_Parse_Action : in     Post_Parse_Action_Type;
+      Line_Count        : in     WisiToken.Line_Number_Type;
+      Params            : in     String);
+   --  Line_Count only used for Indent. Params contains language-specific
+   --  indent parameter values.
+   --
+   --  It is possible to do without the Line_Count parameter, and grow
+   --  the various vectors dynamically. However, doing that caused
+   --  intermittent problems with too many lines; the Ada code saw more
+   --  lines than the elisp code did. Using the elisp line count is more
+   --  reliable.
+
+   overriding procedure Reset (Data : in out Parse_Data_Type);
+   --  Reset for a new parse, with data from previous Initialize.
+
+   function Source_File_Name (Data : in Parse_Data_Type) return String;
+   function Post_Parse_Action (Data : in Parse_Data_Type) return 
Post_Parse_Action_Type;
+
+   overriding
+   procedure Lexer_To_Augmented
+     (Data  : in out          Parse_Data_Type;
+      Token : in              WisiToken.Base_Token;
+      Lexer : not null access WisiToken.Lexer.Instance'Class);
+
+   overriding
+   procedure Delete_Token
+     (Data        : in out Parse_Data_Type;
+      Token_Index : in     WisiToken.Token_Index);
+
+   overriding
+   procedure Reduce
+     (Data    : in out Parse_Data_Type;
+      Tree    : in out WisiToken.Syntax_Trees.Tree'Class;
+      Nonterm : in     WisiToken.Syntax_Trees.Valid_Node_Index;
+      Tokens  : in     WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+
+   type Navigate_Class_Type is (Motion, Name, Statement_End, 
Statement_Override, Statement_Start, Misc);
+   --  Matches [1] wisi-class-list.
+
+   type Index_Navigate_Class is record
+      Index : WisiToken.Positive_Index_Type; -- into Tokens
+      Class : Navigate_Class_Type;
+   end record;
+
+   type Statement_Param_Array is array (Natural range <>) of 
Index_Navigate_Class;
+
+   procedure Statement_Action
+     (Data    : in out Parse_Data_Type;
+      Tree    : in     WisiToken.Syntax_Trees.Tree;
+      Nonterm : in     WisiToken.Syntax_Trees.Valid_Node_Index;
+      Tokens  : in     WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+      Params  : in     Statement_Param_Array);
+
+   procedure Containing_Action
+     (Data       : in out Parse_Data_Type;
+      Tree       : in     WisiToken.Syntax_Trees.Tree;
+      Nonterm    : in     WisiToken.Syntax_Trees.Valid_Node_Index;
+      Tokens     : in     WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+      Containing : in     WisiToken.Positive_Index_Type;
+      Contained  : in     WisiToken.Positive_Index_Type);
+
+   package Token_ID_Lists is new Ada.Containers.Doubly_Linked_Lists 
(WisiToken.Token_ID, WisiToken."=");
+
+   Empty_IDs : constant Token_ID_Lists.List := Token_ID_Lists.Empty_List;
+
+   function "+" (Item : in WisiToken.Token_ID) return Token_ID_Lists.List;
+   function "&" (List : in Token_ID_Lists.List; Item : in WisiToken.Token_ID) 
return Token_ID_Lists.List;
+   function "&" (Left, Right : in WisiToken.Token_ID) return 
Token_ID_Lists.List;
+
+   type Index_IDs is record
+      Index : WisiToken.Positive_Index_Type; -- into Tokens
+      IDs   : Token_ID_Lists.List;
+   end record;
+
+   package Index_IDs_Vectors is new Ada.Containers.Vectors 
(Ada.Containers.Count_Type, Index_IDs);
+
+   subtype Motion_Param_Array is Index_IDs_Vectors.Vector;
+
+   procedure Motion_Action
+     (Data    : in out Parse_Data_Type;
+      Tree    : in     WisiToken.Syntax_Trees.Tree;
+      Nonterm : in     WisiToken.Syntax_Trees.Valid_Node_Index;
+      Tokens  : in     WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+      Params  : in     Motion_Param_Array);
+   --  Implements [2] wisi-motion-action.
+
+   type Index_Faces is record
+      Index       : WisiToken.Positive_Index_Type; -- into Tokens
+      Prefix_Face : Integer; -- into grammar.Face_List
+      Suffix_Face : Integer; -- into grammar.Face_List
+   end record;
+
+   type Face_Apply_Param_Array is array (Natural range <>) of Index_Faces;
+
+   procedure Face_Apply_Action
+     (Data    : in out Parse_Data_Type;
+      Tree    : in     WisiToken.Syntax_Trees.Tree;
+      Nonterm : in     WisiToken.Syntax_Trees.Valid_Node_Index;
+      Tokens  : in     WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+      Params  : in     Face_Apply_Param_Array);
+   --  Implements [2] wisi-face-apply-action.
+
+   procedure Face_Apply_List_Action
+     (Data    : in out Parse_Data_Type;
+      Tree    : in     WisiToken.Syntax_Trees.Tree;
+      Nonterm : in     WisiToken.Syntax_Trees.Valid_Node_Index;
+      Tokens  : in     WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+      Params  : in     Face_Apply_Param_Array);
+   --  Implements [2] wisi-face-apply-list-action.
+
+   type Face_Class_Type is (Prefix, Suffix);
+   --  Matches wisi-cache-class values set in [1] wisi-face-apply-action.
+
+   type Index_Face_Class is record
+      Index : WisiToken.Positive_Index_Type; -- into Tokens
+      Class : Face_Class_Type;
+   end record;
+
+   type Face_Mark_Param_Array is array (Natural range <>) of Index_Face_Class;
+
+   procedure Face_Mark_Action
+     (Data    : in out Parse_Data_Type;
+      Tree    : in     WisiToken.Syntax_Trees.Tree;
+      Nonterm : in     WisiToken.Syntax_Trees.Valid_Node_Index;
+      Tokens  : in     WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+      Params  : in     Face_Mark_Param_Array);
+   --  Implements [2] wisi-face-mark-action.
+
+   type Face_Remove_Param_Array is array (Natural range <>) of 
WisiToken.Positive_Index_Type;
+
+   procedure Face_Remove_Action
+     (Data    : in out Parse_Data_Type;
+      Tree    : in     WisiToken.Syntax_Trees.Tree;
+      Nonterm : in     WisiToken.Syntax_Trees.Valid_Node_Index;
+      Tokens  : in     WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+      Params  : in     Face_Remove_Param_Array);
+   --  Implements [2] wisi-face-remove-action.
+
+   ----------
+   --  Indent
+   --
+   --  elisp indent functions are represented by the Indent_Param type,
+   --  not Ada functions. This is to get the execution time right; in
+   --  elisp, the array of parameters to wisi-indent-action is not
+   --  evaluated when wisi-indent-action is called; each parameter is
+   --  evaluated by wisi-elisp-parse--indent-compute-delta.
+
+   type Simple_Indent_Param_Label is -- not hanging
+     (Int,
+      Anchored_0, -- wisi-anchored
+      Anchored_1, -- wisi-anchored%
+      Anchored_2, -- wisi-anchored%-
+      Anchored_3, -- wisi-anchored*
+      Anchored_4, -- wisi-anchored*-
+      Language    -- language-specific function
+     );
+   subtype Anchored_Label is Simple_Indent_Param_Label range Anchored_0 .. 
Anchored_4;
+
+   --  Arguments to language-specific functions are integers; one of
+   --  delta, Token_Number, or Token_ID - the syntax does not distinguish
+   --  among these three types.
+
+   package Indent_Arg_Arrays is new Ada.Containers.Vectors 
(WisiToken.Positive_Index_Type, Integer);
+
+   function "+" (Item : in Integer) return Indent_Arg_Arrays.Vector;
+   function "&" (List : in Indent_Arg_Arrays.Vector; Item : in Integer) return 
Indent_Arg_Arrays.Vector;
+   function "&" (Left, Right : in Integer) return Indent_Arg_Arrays.Vector;
+
+   type Delta_Type (<>) is private;
+
+   type Language_Indent_Function is access function
+     (Data              : in out Parse_Data_Type'Class;
+      Tree              : in     WisiToken.Syntax_Trees.Tree;
+      Tree_Tokens       : in     WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+      Tree_Indenting    : in     WisiToken.Syntax_Trees.Valid_Node_Index;
+      Indenting_Comment : in     Boolean;
+      Args              : in     Indent_Arg_Arrays.Vector)
+     return Delta_Type;
+
+   Null_Args : Indent_Arg_Arrays.Vector renames Indent_Arg_Arrays.Empty_Vector;
+
+   type Simple_Indent_Param (Label : Simple_Indent_Param_Label := Int) is
+   record
+      case Label is
+      when Int =>
+         Int_Delta : Integer;
+
+      when Anchored_Label =>
+         Anchored_Index : WisiToken.Positive_Index_Type;
+         Anchored_Delta : Integer;
+
+      when Language =>
+         Function_Ptr : Language_Indent_Function;
+         Args         : Indent_Arg_Arrays.Vector;
+      end case;
+   end record;
+
+   function Image (Item : in Simple_Indent_Param) return String;
+
+   type Indent_Param_Label is
+     (Simple,
+      Hanging_0, -- wisi-hanging
+      Hanging_1, -- wisi-hanging%
+      Hanging_2  -- wisi-hanging%-
+     );
+   subtype Hanging_Label is Indent_Param_Label range Hanging_0 .. Hanging_2;
+
+   type Indent_Param (Label : Indent_Param_Label := Simple) is
+   record
+      case Label is
+      when Simple =>
+         Param : Simple_Indent_Param;
+
+      when Hanging_Label =>
+         Hanging_Delta_1 : Simple_Indent_Param;
+         Hanging_Delta_2 : Simple_Indent_Param;
+
+      end case;
+   end record;
+
+   function Image (Item : in Indent_Param) return String;
+
+   type Indent_Pair (Comment_Present : Boolean := False) is
+   record
+      Code_Delta : Indent_Param;
+      case Comment_Present is
+      when True =>
+         Comment_Delta : Indent_Param;
+      when False =>
+         null;
+      end case;
+   end record;
+
+   function Image (Item : in Indent_Pair) return String;
+
+   type Indent_Param_Array is array (WisiToken.Positive_Index_Type range <>) 
of Indent_Pair;
+
+   procedure Indent_Action_0
+     (Data    : in out Parse_Data_Type'Class;
+      Tree    : in     WisiToken.Syntax_Trees.Tree;
+      Nonterm : in     WisiToken.Syntax_Trees.Valid_Node_Index;
+      Tokens  : in     WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+      Params  : in     Indent_Param_Array);
+   --  Implements [2] wisi-indent-action.
+
+   procedure Indent_Action_1
+     (Data    : in out Parse_Data_Type'Class;
+      Tree    : in     WisiToken.Syntax_Trees.Tree;
+      Nonterm : in     WisiToken.Syntax_Trees.Valid_Node_Index;
+      Tokens  : in     WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+      N       : in     WisiToken.Positive_Index_Type;
+      Params  : in     Indent_Param_Array);
+   --  Implements [2] wisi-indent-action*.
+
+   function Indent_Hanging_1
+     (Data              : in out Parse_Data_Type;
+      Tree              : in     WisiToken.Syntax_Trees.Tree;
+      Tokens            : in     WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+      Tree_Indenting    : in     WisiToken.Syntax_Trees.Valid_Node_Index;
+      Indenting_Comment : in     Boolean;
+      Delta_1           : in     Simple_Indent_Param;
+      Delta_2           : in     Simple_Indent_Param;
+      Option            : in     Boolean;
+      Accumulate        : in     Boolean)
+     return Delta_Type;
+   --  [2] wisi-elisp-parse--hanging-1
+   --
+   --  Language specific child packages override this to implement
+   --  wisi-elisp-parse-indent-hanging-function.
+
+   procedure Put (Data : in out Parse_Data_Type);
+   --  Perform post-parse actions, then put result to
+   --  Ada.Text_IO.Current_Output, as encoded responses as defined in [3]
+   --  wisi-process-parse--execute.
+
+   procedure Put
+     (Data         : in Parse_Data_Type;
+      Lexer_Errors : in WisiToken.Lexer.Error_Lists.List;
+      Parse_Errors : in WisiToken.Parse.LR.Parse_Error_Lists.List;
+      Tree         : in WisiToken.Syntax_Trees.Tree);
+   --  Put Lexer_Errors and Parse_Errors to Ada.Text_IO.Current_Output,
+   --  as encoded error responses as defined in [3]
+   --  wisi-process-parse--execute.
+
+   procedure Put_Error (Data : in Parse_Data_Type; Line_Number : in 
WisiToken.Line_Number_Type; Message : in String);
+   --  Put an error elisp form to Ada.Text_IO.Standard_Output.
+
+private
+
+   type Non_Grammar_Token is record
+      ID    : WisiToken.Token_ID         := WisiToken.Invalid_Token_ID;
+      Line  : WisiToken.Line_Number_Type := WisiToken.Invalid_Line_Number;
+      Col   : Ada.Text_IO.Count          := Ada.Text_IO.Count'Last;
+      First : Boolean                    := False;
+      --  Column is needed to detect comments in column 0.
+   end record;
+
+   package Non_Grammar_Token_Arrays is new SAL.Gen_Unbounded_Definite_Vectors
+     (WisiToken.Token_Index, Non_Grammar_Token);
+
+   type Augmented_Token is new WisiToken.Base_Token with record
+      --  Most fields are set by Lexer_To_Augmented at parse time; others
+      --  are set by Reduce for nonterminals.
+
+      Deleted : Boolean := False;
+      --  Set True by Parse_Data_Type.Delete_Token; Non_Grammar tokens are
+      --  moved to the previous non-deleted token.
+
+      --  The following fields are only needed for indent.
+
+      First : Boolean := False;
+      --  For a terminal, True if the token is not empty and it is first on
+      --  a line, or if it contains trailing blank or comment lines.
+      --
+      --  For a nonterminal, True if some contained token's First is True,
+      --  including trailing comments and blank lines.
+
+      Paren_State : Integer := 0;
+      --  Parenthesis nesting count, before token.
+
+      First_Terminals_Index : WisiToken.Base_Token_Index := 
WisiToken.Base_Token_Arrays.No_Index;
+      --  For virtual tokens, No_Index.
+      --
+      --  For terminal tokens, index of this token in Parser.Terminals.
+      --
+      --  For nonterminal tokens, index of first contained token in
+      --  Parser.Terminals.
+
+      Last_Terminals_Index : WisiToken.Base_Token_Index := 
WisiToken.Base_Token_Arrays.No_Index;
+      --  For non-virtual nonterminal tokens, index of last contained
+      --  token in Parser.Terminals.
+      --
+      --  For all others, same as First_Terminals_Index.
+
+      First_Indent_Line : WisiToken.Line_Number_Type := 
WisiToken.Invalid_Line_Number;
+      Last_Indent_Line  : WisiToken.Line_Number_Type := 
WisiToken.Invalid_Line_Number;
+      --  Lines that need indenting; first token on these lines is contained
+      --  in this token. If First is False, these are Invalid_Line_Number.
+      --
+      --  First_, Last_Indent_Line include blank and comment lines between
+      --  grammar tokens, but exclude trailing blanks and comments after the
+      --  last token, so they can be indented differently.
+
+      First_Trailing_Comment_Line : WisiToken.Line_Number_Type := 
WisiToken.Invalid_Line_Number;
+      Last_Trailing_Comment_Line  : WisiToken.Line_Number_Type := 
WisiToken.Invalid_Line_Number;
+      --  Trailing comment or blank lines (after the last contained grammar
+      --  token) that need indenting. Excludes comments following code on a
+      --  line. If there are no such lines, these are Invalid_Line_Number.
+
+      Non_Grammar : Non_Grammar_Token_Arrays.Vector;
+      --  For terminals, non-grammar tokens immediately following. For
+      --  nonterminals, empty.
+
+   end record;
+
+   overriding
+   function Image
+     (Item       : in Augmented_Token;
+      Descriptor : in WisiToken.Descriptor)
+     return String;
+   --  Return a string for debug/test messages
+
+   function First_Line
+     (Token             : in Augmented_Token;
+      Indenting_Comment : in Boolean)
+     return WisiToken.Line_Number_Type;
+   function Last_Line
+     (Token             : in Augmented_Token;
+      Indenting_Comment : in Boolean)
+     return WisiToken.Line_Number_Type;
+   --  Return first and last line in Token's region.
+
+   type Augmented_Token_Access is access all Augmented_Token;
+   procedure Free is new Ada.Unchecked_Deallocation (Augmented_Token, 
Augmented_Token_Access);
+
+   type Augmented_Token_Access_Array is array (WisiToken.Positive_Index_Type 
range <>) of Augmented_Token_Access;
+   --  1 indexed to match token numbers in grammar actions.
+
+   function Image
+     (Item       : in Augmented_Token_Access_Array;
+      Descriptor : in WisiToken.Descriptor)
+     return String;
+
+   package Augmented_Token_Arrays is new SAL.Gen_Unbounded_Definite_Vectors 
(WisiToken.Token_Index, Augmented_Token);
+   --  Index matches Base_Token_Arrays.
+
+   package Line_Paren_Vectors is new SAL.Gen_Unbounded_Definite_Vectors 
(WisiToken.Line_Number_Type, Integer);
+   package Line_Begin_Pos_Vectors is new SAL.Gen_Unbounded_Definite_Vectors
+     (WisiToken.Line_Number_Type, WisiToken.Buffer_Pos);
+
+   type Nil_Buffer_Pos (Set : Boolean := False) is record
+      case Set is
+      when True =>
+         Item : WisiToken.Buffer_Pos;
+      when False =>
+         null;
+      end case;
+   end record;
+
+   Nil : constant Nil_Buffer_Pos := (Set => False);
+
+   type Navigate_Cache_Type is record
+      Pos            : WisiToken.Buffer_Pos;          -- implicit in wisi-cache
+      Statement_ID   : WisiToken.Token_ID;  -- wisi-cache-nonterm
+      ID             : WisiToken.Token_ID;  -- wisi-cache-token
+      Length         : Natural;             -- wisi-cache-last
+      Class          : Navigate_Class_Type; -- wisi-cache-class; one of 
wisi-class-list
+      Containing_Pos : Nil_Buffer_Pos;      -- wisi-cache-containing
+      Prev_Pos       : Nil_Buffer_Pos;      -- wisi-cache-prev
+      Next_Pos       : Nil_Buffer_Pos;      -- wisi-cache-next
+      End_Pos        : Nil_Buffer_Pos;      -- wisi-cache-end
+   end record;
+
+   function Key (Cache : in Navigate_Cache_Type) return WisiToken.Buffer_Pos 
is (Cache.Pos);
+
+   function Key_Compare (Left, Right : in WisiToken.Buffer_Pos) return 
SAL.Compare_Result is
+     (if Left > Right then SAL.Greater
+      elsif Left = Right then SAL.Equal
+      else SAL.Less);
+
+   package Navigate_Cache_Trees is new 
SAL.Gen_Unbounded_Definite_Red_Black_Trees
+     (Navigate_Cache_Type, WisiToken.Buffer_Pos);
+
+   type Nil_Integer (Set : Boolean := False) is record
+      case Set is
+      when True =>
+         Item : Integer;
+      when False =>
+         null;
+      end case;
+   end record;
+
+   type Face_Cache_Type is record
+      Region : WisiToken.Buffer_Region;
+      Class  : Face_Class_Type; -- wisi-cache-class; one of {'prefix | 'suffix}
+      Face   : Nil_Integer;     -- not set, or index into *-process-faces-names
+   end record;
+
+   function Key (Cache : in Face_Cache_Type) return WisiToken.Buffer_Pos is 
(Cache.Region.First);
+
+   package Face_Cache_Trees is new SAL.Gen_Unbounded_Definite_Red_Black_Trees 
(Face_Cache_Type, WisiToken.Buffer_Pos);
+
+   type Indent_Label is (Not_Set, Int, Anchor, Anchored, Anchor_Anchored);
+
+   package Anchor_ID_Vectors is new Ada.Containers.Vectors (Natural, Positive);
+
+   type Indent_Type (Label : Indent_Label := Not_Set) is record
+      --  [2] wisi-elisp-parse--indent elements. Indent values may be
+      --  negative while indents are being computed.
+      case Label is
+      when Not_Set =>
+         null;
+
+      when Int =>
+         Int_Indent : Integer;
+
+      when Anchor =>
+         Anchor_IDs    : Anchor_ID_Vectors.Vector; --  Largest ID first.
+         Anchor_Indent : Integer;
+
+      when Anchored =>
+         Anchored_ID    : Positive;
+         Anchored_Delta : Integer; -- added to Anchor_Indent of Anchor_ID
+
+      when Anchor_Anchored =>
+         Anchor_Anchored_IDs   : Anchor_ID_Vectors.Vector;
+         Anchor_Anchored_ID    : Natural;
+         Anchor_Anchored_Delta : Integer;
+      end case;
+   end record;
+   First_Anchor_ID : constant Positive := Positive'First;
+
+   package Indent_Vectors is new Ada.Containers.Vectors 
(WisiToken.Line_Number_Type, Indent_Type);
+   package Navigate_Cursor_Lists is new Ada.Containers.Doubly_Linked_Lists
+     (Navigate_Cache_Trees.Cursor, Navigate_Cache_Trees."=");
+
+   type Parse_Data_Type
+     (Line_Begin_Token : not null access constant 
WisiToken.Line_Begin_Token_Vectors.Vector)
+     is new WisiToken.Syntax_Trees.User_Data_Type with
+   record
+      --  Data from parsing
+
+      Terminals : Augmented_Token_Arrays.Vector;
+      --  All terminal grammar tokens, in lexical order. Each contains any
+      --  immediately following non-grammar tokens. Does not contain
+      --  nonterminal or virtual tokens.
+
+      Leading_Non_Grammar : WisiToken.Base_Token_Arrays.Vector;
+      --  non-grammar tokens before first grammar token.
+
+      Line_Begin_Pos : Line_Begin_Pos_Vectors.Vector;
+      --  Character position at the start of the first token on each line.
+
+      Line_Paren_State : Line_Paren_Vectors.Vector;
+      --  Parenthesis nesting state at the start of each line; used by
+      --  Indent. Set by Lexer_To_Augmented on New_Line_ID.
+
+      Current_Paren_State : Integer;
+      --  Current parenthesis nesting state; used by Indent. Set by
+      --  Lexer_To_Augmented on Left_Paren_ID, Right_Paren_ID.
+
+      --  Data for post-parse actions
+
+      Descriptor        : access constant WisiToken.Descriptor;
+      Source_File_Name  : Ada.Strings.Unbounded.Unbounded_String;
+      Post_Parse_Action : Post_Parse_Action_Type;
+      Navigate_Caches   : Navigate_Cache_Trees.Tree;  -- Set by Navigate.
+      End_Positions     : Navigate_Cursor_Lists.List; -- Dynamic data for 
Navigate.
+      Face_Caches       : Face_Cache_Trees.Tree;      -- Set by Face.
+      Indents           : Indent_Vectors.Vector;      -- Set by Indent.
+
+      --  Copied from language-specific parameters
+      Indent_Comment_Col_0 : Boolean := False;
+
+      --  Dynamic data for Indent
+      Max_Anchor_ID : Integer;
+   end record;
+
+   type Simple_Delta_Labels is (Int, Anchored);
+
+   type Simple_Delta_Type (Label : Simple_Delta_Labels := Int) is
+   record
+      case Label is
+      when Int =>
+         Int_Delta : Integer;
+
+      when Anchored =>
+         Anchored_ID         : Natural;
+         Anchored_Delta      : Integer;
+         Anchored_Accumulate : Boolean;
+
+      end case;
+   end record;
+   subtype Anchored_Delta is Simple_Delta_Type (Anchored);
+
+   function Image (Item : in Simple_Delta_Type) return String;
+   --  For debugging
+
+   type Delta_Labels is (Simple, Hanging);
+
+   type Delta_Type (Label : Delta_Labels := Simple) is
+   record
+      --  Matches DELTA input to wisi--indent-token-1
+      case Label is
+      when Simple =>
+         Simple_Delta : Simple_Delta_Type;
+
+      when Hanging =>
+         Hanging_First_Line  : WisiToken.Line_Number_Type;
+         Hanging_Paren_State : Integer;
+         Hanging_Delta_1     : Simple_Delta_Type; -- indentation of first line
+         Hanging_Delta_2     : Simple_Delta_Type; -- indentation of 
continuation lines
+         Hanging_Accumulate  : Boolean;
+      end case;
+   end record;
+
+   Null_Delta : constant Delta_Type := (Simple, (Int, 0));
+
+   function Image (Item : in Delta_Type) return String;
+   --  For debugging
+
+   ----------
+   --  Utilities for language-specific child packages
+
+   subtype Aug_Token_Ref is Augmented_Token_Arrays.Variable_Reference_Type;
+
+   function Current_Indent_Offset
+     (Data         : in Parse_Data_Type;
+      Anchor_Token : in Augmented_Token'Class;
+      Offset       : in Integer)
+     return Integer;
+   --  Return offset from beginning of first token on line containing
+   --  Anchor_Token, to beginning of Anchor_Token, plus Offset.
+
+   function Find
+     (Data  : in Parse_Data_Type;
+      ID    : in WisiToken.Token_ID;
+      Token : in Augmented_Token'Class)
+     return WisiToken.Base_Token_Index;
+   --  Return index in Parser.Terminals of first token in
+   --  Token.Char_Region with ID. If not found, return
+   --  No_Index.
+
+   function Get_Aug_Token
+     (Data       : in Parse_Data_Type'Class;
+      Tree       : in WisiToken.Syntax_Trees.Tree'Class;
+      Tree_Index : in WisiToken.Syntax_Trees.Valid_Node_Index)
+     return Aug_Token_Ref;
+
+   function Indent_Anchored_2
+     (Data        : in out Parse_Data_Type;
+      Anchor_Line : in     WisiToken.Line_Number_Type;
+      Last_Line   : in     WisiToken.Line_Number_Type;
+      Offset      : in     Integer;
+      Accumulate  : in     Boolean)
+     return Delta_Type;
+   --  [2] wisi-elisp-parse--anchored-2
+
+   function Indent_Compute_Delta
+     (Data              : in out Parse_Data_Type'Class;
+      Tree              : in     WisiToken.Syntax_Trees.Tree;
+      Tokens            : in     WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+      Param             : in     Indent_Param;
+      Tree_Indenting    : in     WisiToken.Syntax_Trees.Valid_Node_Index;
+      Indenting_Comment : in     Boolean)
+     return Delta_Type;
+
+   procedure Indent_Token_1
+     (Data              : in out Parse_Data_Type;
+      Indenting_Token   : in     Augmented_Token'Class;
+      Delta_Indent      : in     Delta_Type;
+      Indenting_Comment : in     Boolean);
+   --  [2] wisi-elisp-parse--indent-token-1. Sets Data.Indents, so caller
+   --  may not be in a renames for a Data.Indents element.
+
+end Wisi;
diff --git a/wisi.el b/wisi.el
index b063321..00719a2 100755
--- a/wisi.el
+++ b/wisi.el
@@ -1,1642 +1,1298 @@
-;;; wisi.el --- Utilities for implementing an indentation/navigation engine 
using a generalized LALR parser -*- lexical-binding:t -*-
-;;
-;; Copyright (C) 2012 - 2017  Free Software Foundation, Inc.
-;;
-;; Author: Stephen Leake <stephen_leake@stephe-leake.org>
-;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
-;; Keywords: parser
-;;  indentation
-;;  navigation
-;; Version: 1.1.6
-;; package-requires: ((cl-lib "0.4") (emacs "24.3"))
-;; URL: http://www.nongnu.org/ada-mode/wisi/wisi.html
-;;
-;; 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: see NEWS-wisi.text
-;;
-;;;; 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.
-;;
-;;; Handling parse errors:
-;;
-;; When a parse fails, the cache information before the failure point
-;; is only partly correct, and there is no cache informaiton after the
-;; failure point.
-;;
-;; However, in the case where a parse previously succeeded, and the
-;; current parse fails due to editing, we keep the preceding cache
-;; information by setting wisi-cache-max to the edit point in
-;; wisi-before change; the parser does not apply actions before that
-;; point.
-;;
-;; This allows navigation and indentation in the text preceding the
-;; edit point, and saves some time.
-;;
-;;;; 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.
-;;
-;;;; lexer
-;;
-;; The lexer is `wisi-forward-token'. It relies on syntax properties,
-;; so syntax-propertize must be called on the text to be lexed before
-;; wisi-forward-token is called. In general, it is hard to determine
-;; an appropriate end-point for syntax-propertize, other than
-;; point-max. So we call (syntax-propertize point-max) in wisi-setup,
-;; and also call syntax-propertize in wisi-after-change.
-;; FIXME: no longer needed in Emacs 25? (email from Stefan Monnier)
-;;
-;;;; 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 'cl-lib)
-(require 'wisi-parse)
-
-;; WORKAROUND: for some reason, this condition doesn't work in batch mode!
-;; (when (and (= emacs-major-version 24)
-;;        (= emacs-minor-version 2))
-  (require 'wisi-compat-24.2)
-;;)
-
-(defcustom wisi-size-threshold 100000
-  "Max size (in characters) for using wisi parser results for syntax 
highlighting and file navigation."
-  :type 'integer
-  :group 'wisi
-  :safe 'integerp)
-(make-variable-buffer-local 'wisi-size-threshold)
-
-;;;; 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
-  "Non-nil if a string delimiter is escaped by doubling it (as in Ada).")
-(defvar-local wisi-string-quote-escape nil
-  "Cons (delim . character) where `character' escapes quotes in strings 
delimited by `delim'.")
-(defvar-local wisi-string-single-term nil) ;; string delimited by single quotes
-(defvar-local wisi-symbol-term nil)
-(defvar-local wisi-number-term nil)
-(defvar-local wisi-number-p nil)
-
-(defun wisi-number-p (token-text)
-  "Return t if TOKEN-TEXT plus text after point matches the
-syntax for a real literal; otherwise nil.  Point is after
-TOKEN-TEXT; move point to just past token."
-  ;; Typical literals:
-  ;; 1234
-  ;; 1234.5678
-  ;; _not_ including non-decimal base, or underscores (see ada-wisi-number-p)
-  ;;
-  ;; Starts with a simple integer
-  (when (string-match "^[0-9]+$" token-text)
-    (when (looking-at "\\.[0-9]+")
-      ;; real number
-      (goto-char (match-end 0))
-      (when (looking-at  "[Ee][+-][0-9]+")
-        ;; exponent
-        (goto-char (match-end 0))))
-
-    t
-    ))
-
-(defun wisi-forward-token ()
-  "Move point forward across one token, skipping leading whitespace and 
comments.
-Return the corresponding token, in format: (token 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'.
-
-`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-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-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))
-       (condition-case err
-           (progn
-             (forward-sexp)
-
-             ;; point is now after the end quote; check for an escaped quote
-             (while (or
-                     (and wisi-string-quote-escape-doubled
-                          (eq (char-after (point)) delim))
-                     (and (eq delim (car wisi-string-quote-escape))
-                          (eq (char-before (1- (point))) (cdr 
wisi-string-quote-escape))))
-               (forward-sexp))
-             (setq token-id (if (= delim ?\") wisi-string-double-term 
wisi-string-single-term)))
-         (scan-error
-          ;; Something screwed up; we should not get here if
-          ;; syntax-propertize works properly.
-          (signal 'wisi-parse-error (format "wisi-forward-token: forward-sexp 
failed %s" err))
-          ))))
-
-     (t ;; assuming word or symbol syntax; includes numbers
-      (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))
-               (and (functionp wisi-number-p)
-                    (funcall wisi-number-p token-text)
-                    (setq token-text (buffer-substring-no-properties start 
(point)))
-                    wisi-number-term)
-               wisi-symbol-term))
-      )
-     );; cond
-
-    (unless token-id
-      (signal 'wisi-parse-error
-             (wisi-error-msg "unrecognized token '%s'" 
(buffer-substring-no-properties start (point)))))
-
-    (cons token-id (cons start (point)))
-    ))
-
-(defun wisi-backward-token ()
-  "Move point backward across one token, skipping whitespace and comments.
-Does _not_ handle numbers with wisi-number-p; just sees lower-level syntax.
-Return (nil 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)
-
-     ((eq syntax 1)
-      ;; punctuation. Find the longest matching string in 
wisi-punctuation-table
-      (backward-char 1)
-      (let ((next-point (point))
-           temp-text done)
-       (while (not done)
-         (setq temp-text (buffer-substring-no-properties (point) end))
-         (when (car (rassoc temp-text wisi-punctuation-table))
-           (setq next-point (point)))
-         (if (or
-              (bobp)
-              (= (- end (point)) wisi-punctuation-table-max-length))
-             (setq done t)
-           (backward-char 1))
-         )
-       (goto-char next-point))
-      )
-
-     ((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 ;; assuming word or symbol syntax
-      (if (zerop (skip-syntax-backward "."))
-         (skip-syntax-backward "w_'")))
-     )
-    (cons nil (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-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
-  "When non-nil, buffer position to invalidate from.
-Used in before/after change functions.")
-
-(defvar-local wisi-end-caches nil
-  "List of buffer positions of caches in current statement that need 
wisi-cache-end set.")
-
-(defun wisi-delete-cache (after)
-  (with-silent-modifications
-    (remove-text-properties after (point-max) '(wisi-cache nil))
-    ;; We don't remove 'font-lock-face; that's annoying to the user,
-    ;; since they won't be restored until a parse for some other
-    ;; reason, and they are likely to be right anyway.
-    ))
-
-(defun wisi-invalidate-cache(&optional after)
-  "Invalidate parsing caches for the current buffer from AFTER to end of 
buffer."
-  (interactive)
-  (if (not after)
-      (setq after (point-min))
-    (setq after
-       (save-excursion
-         (goto-char after)
-         (line-beginning-position))))
-  (when (> wisi-debug 0) (message "wisi-invalidate %s:%d" (current-buffer) 
after))
-  (setq wisi-cache-max after)
-  (setq wisi-parse-try t)
-  (syntax-ppss-flush-cache after)
-  (wisi-delete-cache after)
-  )
-
-;; To see the effects of wisi-before-change, wisi-after-change, you need:
-;; (global-font-lock-mode 0)
-;; (setq jit-lock-functions nil)
-;;
-;; otherwise jit-lock runs and overrides them
-
-(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-need-invalidate nil)
-
-  (when (> end begin)
-    (save-excursion
-      ;; (info "(elisp)Parser State")
-      (let* ((begin-state (syntax-ppss begin))
-            (end-state (syntax-ppss end))
-            ;; syntax-ppss has moved point to "end".
-            (word-end (progn (skip-syntax-forward "w_")(point))))
-
-       ;; Remove grammar face from word(s) containing change region;
-       ;; might be changing to/from a keyword. See
-       ;; test/ada_mode-interactive_common.adb Obj_1
-       (goto-char begin)
-       (skip-syntax-backward "w_")
-       (with-silent-modifications
-         (remove-text-properties (point) word-end '(font-lock-face nil 
fontified nil)))
-
-       (if (<= wisi-cache-max begin)
-           ;; Change is in unvalidated region; either the parse was
-           ;; failing, or there is more than one top-level grammar
-           ;; symbol in buffer.
-           (when 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))
-
-         ;; else change is in validated region
-         ;;
-         ;; don't invalidate parse for whitespace, string, or comment changes
-         (cond
-          ((and
-            (nth 3 begin-state); in string
-            (nth 3 end-state)))
-          ;; no easy way to tell if there is intervening non-string
-
-          ((and
-            (nth 4 begin-state); in comment
-            (nth 4 end-state))
-           ;; too hard to detect case where there is intervening
-           ;; code; no easy way to go to end of comment if not
-           ;; newline
-           )
-
-          ;; Deleting whitespace generally does not require parse, but
-          ;; deleting all whitespace between two words does; check that
-          ;; there is whitespace on at least one side of the deleted
-          ;; text.
-          ;;
-          ;; We are not in a comment (checked above), so treat
-          ;; comment end as whitespace in case it is newline, except
-          ;; deleting a comment end at begin means commenting the
-          ;; current line; requires parse.
-          ((and
-            (eq (car (syntax-after begin)) 0) ; whitespace
-            (memq (car (syntax-after (1- end))) '(0 12)) ; whitespace, comment 
end
-            (or
-             (memq (car (syntax-after (1- begin))) '(0 12))
-             (memq (car (syntax-after end)) '(0 12)))
-            (progn
-              (goto-char begin)
-              (skip-syntax-forward " >" end)
-              (eq (point) end))))
-
-          (t
-           (setq wisi-change-need-invalidate
-                 (progn
-                   (goto-char begin)
-                   ;; note that because of the checks above, this never
-                   ;; triggers a parse, so it's fast
-                   (wisi-goto-statement-start)
-                   (point))))
-          )))
-      ))
-  )
-
-(defun wisi-after-change (begin end length)
-  "For `after-change-functions'."
-  ;; begin . end is range of text being inserted (empty if equal);
-  ;; length is the size of the deleted text.
-
-  ;; (syntax-ppss-flush-cache begin) is in before-change-functions
-
-  (syntax-propertize end) ;; see comments above on "lexer" re syntax-propertize
-
-  ;; Remove caches on inserted text, which could have caches from
-  ;; before the failed parse (or another buffer), and are in any case
-  ;; invalid. No point in removing 'fontified; that's handled by
-  ;; jit-lock.
-
-  (with-silent-modifications
-    (remove-text-properties begin end '(wisi-cache nil font-lock-face nil)))
-
-  ;; Also remove grammar face from word(s) containing change region;
-  ;; might be changing to/from a keyword. See
-  ;; test/ada_mode-interactive_common.adb Obj_1
-  (save-excursion
-    ;; (info "(elisp)Parser State")
-    (let ((need-invalidate wisi-change-need-invalidate)
-         begin-state end-state word-end)
-      (when (> end begin)
-       (setq begin-state (syntax-ppss begin))
-       (setq end-state (syntax-ppss end))
-       ;; syntax-ppss has moved point to "end".
-
-       ;; extend fontification over new text,
-       (skip-syntax-forward "w_")
-       (setq word-end (point))
-       (goto-char begin)
-       (skip-syntax-backward "w_")
-       (with-silent-modifications
-         (remove-text-properties (point) word-end '(font-lock-face nil 
fontified nil))))
-
-      (if (<= wisi-cache-max begin)
-         ;; Change is in unvalidated region
-         (when 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))
-
-       ;; Change is in validated region
-       (cond
-        (wisi-change-need-invalidate
-         ;; wisi-before change determined the removed text alters the
-         ;; parse
-         )
-
-        ((= end begin)
-         (setq need-invalidate nil))
-
-        ((and
-          (nth 3 begin-state); in string
-          (nth 3 end-state))
-         ;; no easy way to tell if there is intervening non-string
-         (setq need-invalidate nil))
-
-        ((and
-          (nth 4 begin-state)
-          (nth 4 end-state)); in comment
-         ;; no easy way to detect intervening code
-         (setq need-invalidate nil)
-         ;; no caches to remove
-         )
-
-        ;; Adding whitespace generally does not require parse, but in
-        ;; the middle of word it does; check that there was
-        ;; whitespace on at least one side of the inserted text.
-        ;;
-        ;; We are not in a comment (checked above), so treat
-        ;; comment end as whitespace in case it is newline
-        ((and
-          (or
-           (memq (car (syntax-after (1- begin))) '(0 12)); whitespace, comment 
end
-           (memq (car (syntax-after end)) '(0 12)))
-          (progn
-           (goto-char begin)
-           (skip-syntax-forward " >" end)
-           (eq (point) end)))
-         (setq need-invalidate nil))
-
-        (t
-         (setq need-invalidate
-               (progn
-                 (goto-char begin)
-                 ;; note that because of the checks above, this never
-                 ;; triggers a parse, so it's fast
-                 (wisi-goto-statement-start)
-                 (point))))
-        )
-
-       (if need-invalidate
-           (wisi-invalidate-cache need-invalidate)
-
-         ;; else move cache-max by the net change length.
-         (setq wisi-cache-max
-               (+ wisi-cache-max (- end begin length))) )
-       ))
-    ))
-
-(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 (and wisi-parse-error-msg
-            (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))))
-      (push-mark)
-      (goto-char (point-min))
-      (forward-line (1- line))
-      (forward-char col))))
-
-(defun wisi-show-parse-error ()
-  "Show last wisi-parse error."
-  (interactive)
-  (cond
-   (wisi-parse-failed
-    (wisi-goto-error)
-    (message wisi-parse-error-msg))
-
-   (wisi-parse-try
-    (message "need parse"))
-
-   (t
-    (message "parse succeeded"))
-   ))
-
-(defvar wisi-post-parse-succeed-hook nil
-  "Hook run after parse succeeds.")
-
-(defun wisi-validate-cache (pos &optional error-on-fail)
-  "Ensure cached data is valid at least up to POS in current buffer."
-  (let ((msg (when (> wisi-debug 0) (format "wisi: parsing %s:%d ..." 
(buffer-name) (line-number-at-pos pos)))))
-    ;; If wisi-cache-max = pos, then there is no cache at pos; need parse
-    (when (and wisi-parse-try
-              (<= wisi-cache-max pos))
-      (when (> wisi-debug 0)
-       (message msg))
-
-      ;; Don't keep retrying failed parse until text changes again.
-      (setq wisi-parse-try nil)
-
-      (setq wisi-parse-error-msg nil)
-      (setq wisi-end-caches nil)
-
-      (if (> wisi-debug 1)
-         ;; let debugger stop in wisi-parse
-         (progn
-           (save-excursion
-             (wisi-parse wisi-parse-table 'wisi-forward-token)
-             (setq wisi-cache-max (point))
-             (setq wisi-parse-failed nil))
-           (run-hooks 'wisi-post-parse-succeed-hook))
-
-       ;; else capture errors from bad syntax, so higher level
-       ;; functions can try to continue and/or we don't bother the
-       ;; user.
-       (condition-case err
-           (progn
-             (save-excursion
-               (wisi-parse wisi-parse-table 'wisi-forward-token)
-               (setq wisi-cache-max (point))
-               (setq wisi-parse-failed nil))
-             (run-hooks 'wisi-post-parse-succeed-hook))
-         (wisi-parse-error
-          ;; delete caches past wisi-cache-max added by failed parse
-          (wisi-delete-cache wisi-cache-max)
-          (setq wisi-parse-failed t)
-          (setq wisi-parse-error-msg (cdr err)))
-         ))
-      (if wisi-parse-error-msg
-         ;; error
-         (cond
-          ((> wisi-debug 0)
-           (message "%s error" msg)
-           (wisi-goto-error)
-           (error wisi-parse-error-msg)))
-       ;; no msg; success
-       (when (> wisi-debug 0)
-         (message "%s done" msg)))
-      )
-    (when (and error-on-fail (not (>= wisi-cache-max pos)))
-      (error "parse failed"))
-    ))
-
-(defun wisi-fontify-region (_begin end)
-  "For `jit-lock-functions'."
-  (when (< (point-max) wisi-size-threshold)
-    (wisi-validate-cache end)))
-
-(defun wisi-get-containing-cache (cache)
-  "Return cache from (wisi-cache-containing CACHE)."
-  (when cache
-    (let ((containing (wisi-cache-containing cache)))
-      (and containing
-          (wisi-get-cache (1- containing))))))
-
-(defun wisi-cache-region (cache)
-  "Return region designated by cache.
-Point must be at cache."
-  (cons (point) (+ (point) (wisi-cache-last cache))))
-
-(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 (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)
-(defvar $nterm nil)
-;; keep byte-compiler happy; `wisi-tokens' and `$nterm' are bound in
-;; action created by wisi-semantic-action, and in module parser.
-;; FIXME: $nterm should have wisi- prefix
-
-(defun wisi-statement-action (pairs)
-  "Cache 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])"
-  (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 (cdr (aref wisi-tokens number)));; wisi-tokens is 
let-bound in wisi-parse-reduce
-              (token (car (aref wisi-tokens number)))
-              (class (aref pairs (setq i (1+ i))))
-              (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)
-
-         (setq i (1+ i))
-
-         (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, containing
-                   ;; set end only if not set yet (due to failed parse)
-                   (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)
-                     (unless (wisi-cache-end cache)
-                       (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    $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
-                           (memq class '(block-start statement-start)))
-                   (setq override-start nil)
-                   (setq first-keyword-mark mark)))
-
-               (when (eq class 'statement-end)
-                 (wisi-set-end (1- first-keyword-mark) (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 (cdr (aref wisi-tokens (1- containing-token))))
-        (contained-region (cdr (aref wisi-tokens (1- contained-token)))))
-
-    (unless containing-region ;;
-      (signal 'wisi-parse-error
-             (wisi-error-msg
-              "wisi-containing-action: containing-region '%s' is empty. 
grammar error; bad action"
-              (wisi-token-text (aref wisi-tokens (1- containing-token))))))
-
-    (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))))))
-
-    (while (not containing-region)
-      ;; containing-token is empty; use next
-      (setq containing-region (cdr (aref wisi-tokens 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 (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-match-class-token (cache class-tokens)
-  "Return t if CACHE matches CLASS-TOKENS.
-CLASS-TOKENS is a vector [number class token_id class token_id ...].
-number is ignored."
-  (let ((i 1)
-       (done nil)
-       (result nil)
-       class token)
-    (while (and (not done)
-               (< i (length class-tokens)))
-      (setq class (aref class-tokens i))
-      (setq token (aref class-tokens (setq i (1+ i))))
-      (setq i (1+ i))
-      (when (and (eq class (wisi-cache-class cache))
-                (eq token (wisi-cache-token cache)))
-       (setq result t
-             done t))
-      )
-    result))
-
-(defun wisi-motion-action (token-numbers)
-  "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 class token_id]:
-vector [number class token_id class token_id ...]:
-   mark all tokens in number nonterminal matching (class token_id) with nil 
prev/next."
-  (save-excursion
-    (let (prev-keyword-mark
-         prev-cache
-         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 region (cdr (aref wisi-tokens (1- token-number))))
-           (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)
-             ))
-
-          ((vectorp token-number)
-           ;; token-number may contain 0, 1, or more 'class token_id' pairs
-           ;; the corresponding region may be empty
-           ;; there must have been a prev keyword
-           (setq region (cdr (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.
-             (goto-char (car region))
-             (setq cache (or (wisi-get-cache (point))
-                             (wisi-forward-cache)))
-             (while (< (point) (cdr region))
-               (when (wisi-match-class-token cache token-number)
-                 (when (null (wisi-cache-prev cache))
-                   (setf (wisi-cache-prev cache) prev-keyword-mark))
-                 (when (null (wisi-cache-next cache))
-                   (setq mark (copy-marker (1+ (point))))
-                   (setf (wisi-cache-next prev-cache) mark)
-                   (setq prev-keyword-mark mark)
-                   (setq prev-cache cache)))
-
-               (setq cache (wisi-forward-cache))
-             )))
-
-          (t
-           (error "unexpected token-number %s" token-number))
-          )
-
-         ))
-      )))
-
-(defun wisi-extend-action (first last)
-  "Extend text of cache at token FIRST to cover all tokens thru LAST."
-  (let* ((first-region (cdr (aref wisi-tokens (1- first))));; wisi-tokens is 
let-bound in wisi-parse-reduce
-        (last-region (cdr (aref wisi-tokens (1- last))))
-       cache)
-
-    (when first-region
-      (setq cache (wisi-get-cache (car first-region)))
-      (setf (wisi-cache-last cache) (- (cdr last-region) (car first-region)))
-      )
-    ))
-
-(defun wisi-face-action-1 (face region &optional override-no-error)
-  "Apply FACE to REGION.
-If OVERRIDE-NO-ERROR is non-nil, don't report an error for overriding an 
existing face."
-  (when region
-    ;; We allow overriding a face property, because we don't want to
-    ;; delete them in wisi-invalidate (see comments there). On the
-    ;; other hand, it can be an error, so keep this debug
-    ;; code. However, to validly report errors, note that
-    ;; font-lock-face properties must be removed first, or the buffer
-    ;; must be fresh (never parsed), and wisi-debug must be > 1.
-    ;;
-    ;; Grammar sets override-no-error when a higher-level production might
-    ;; override a face in a lower-level production.
-    (when (> wisi-debug 1)
-      (let ((cur-face (get-text-property (car region) 'font-lock-face)))
-       (when cur-face
-         (unless override-no-error
-           (message "%s:%d overriding face %s with %s on '%s'"
-                    (buffer-file-name)
-                    (line-number-at-pos (car region))
-                    face
-                    cur-face
-                    (buffer-substring-no-properties (car region) (cdr 
region))))
-
-         )))
-    (with-silent-modifications
-      (add-text-properties
-       (car region) (cdr region)
-       (list
-       'font-lock-face face
-       'fontified t)))
-    ))
-
-(defun wisi-face-action (pairs &optional no-override)
-  "Cache face information in text properties of tokens.
-Intended as a grammar non-terminal action.
-
-PAIRS is a vector of the form [token-number face token-number face ...]
-token-number may be an integer, or a vector [integer token_id token_id ...]
-
-For an integer token-number, apply face to the first cached token
-in the range covered by wisi-tokens[token-number]. If there are
-no cached tokens, apply face to entire wisi-tokens[token-number]
-region.
-
-For a vector token-number, apply face to the first cached token
-in the range matching one of token_id covered by
-wisi-tokens[token-number].
-
-If NO-OVERRIDE is non-nil, don't override existing face."
-  (let (number region face (tokens nil) cache (i 0) (j 1))
-    (while (< i (length pairs))
-      (setq number (aref pairs i))
-      (setq face (aref pairs (setq i (1+ i))))
-      (cond
-       ((integerp number)
-       (setq region (cdr (aref wisi-tokens (1- number))));; wisi-tokens is 
let-bound in wisi-parse-reduce
-       (when region
-         (save-excursion
-           (goto-char (car region))
-           (setq cache (or (wisi-get-cache (point))
-                           (wisi-forward-cache)))
-           (if (< (point) (cdr region))
-               (when cache
-                 (wisi-face-action-1 face (wisi-cache-region cache) 
no-override))
-
-             ;; no caches in region; just apply face to region
-             (wisi-face-action-1 face region no-override))
-           )))
-
-       ((vectorp number)
-       (setq region (cdr (aref wisi-tokens (1- (aref number 0)))))
-       (when region
-         (while (< j (length number))
-           (setq tokens (cons (aref number j) tokens))
-           (setq j (1+ j)))
-         (save-excursion
-           (goto-char (car region))
-           (setq cache (wisi-forward-find-token tokens (cdr region) t))
-           ;; might be looking for IDENTIFIER in name, but only have "*".
-           (when cache
-             (wisi-face-action-1 face (wisi-cache-region cache) no-override))
-           )))
-       )
-      (setq i (1+ i))
-
-      )))
-
-(defun wisi-face-list-action (pairs &optional no-override)
-  "Cache face information in text properties of tokens.
-Intended as a grammar non-terminal action.
-
-PAIRS is a vector of the form [token-number face token-number face ...]
-token-number is an integer. Apply face to all cached tokens
-in the range covered by wisi-tokens[token-number].
-
-If NO-OVERRIDE is non-nil, don't override existing face."
-  (let (number region face cache (i 0))
-    (while (< i (length pairs))
-      (setq number (aref pairs i))
-      (setq face (aref pairs (setq i (1+ i))))
-      (setq region (cdr (aref wisi-tokens (1- number))));; wisi-tokens is 
let-bound in wisi-parse-reduce
-      (when region
-       (save-excursion
-         (goto-char (car region))
-         (setq cache (or (wisi-get-cache (point))
-                         (wisi-forward-cache)))
-         (while (<= (point) (cdr region))
-           (when cache
-             (wisi-face-action-1 face (wisi-cache-region cache) no-override))
-           (setq cache (wisi-forward-cache))
-           )))
-
-      (setq i (1+ i))
-
-      )))
-
-;;;; 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-cache-token (ids limit)
-  "Search forward for a cache with token in IDS (a list of token ids).
-Return cache, or nil if at LIMIT or end of buffer."
-  (let ((cache (wisi-forward-cache)))
-    (while (and (< (point) limit)
-               (not (eobp))
-               (not (memq (wisi-cache-token cache) ids)))
-      (setq cache (wisi-forward-cache)))
-    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 cache-end, or next cache
-if both nil.  Return cache found."
-  (unless (eobp)
-    (wisi-validate-cache (point-max) t) ;; ensure there is a next cache to 
move to
-    (let ((cache (wisi-get-cache (point))))
-      (if (and cache
-              (not (eq (wisi-cache-class cache) 'statement-end)))
-         (let ((next (or (wisi-cache-next cache)
-                         (wisi-cache-end 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) t)
-  (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-forward-sexp (&optional arg)
-  "For `forward-sexp-function'."
-  (interactive "^p")
-  (or arg (setq arg 1))
-  (cond
-   ((and (> arg 0) (= 4 (syntax-class (syntax-after (point)))))  ;; on open 
paren
-    (let ((forward-sexp-function nil))
-      (forward-sexp arg)))
-
-   ((and (< arg 0) (= 5 (syntax-class (syntax-after (1- (point)))))) ;; after 
close paren
-    (let ((forward-sexp-function nil))
-      (forward-sexp arg)))
-
-   ((and (> arg 0) (= 7 (syntax-class (syntax-after (point)))))  ;; on (open) 
string quote
-    (let ((forward-sexp-function nil))
-      (forward-sexp arg)))
-
-   ((and (< arg 0) (= 7 (syntax-class (syntax-after (1- (point)))))) ;; after 
(close) string quote
-    (let ((forward-sexp-function nil))
-      (forward-sexp arg)))
-
-   (t
-    (dotimes (_i (abs arg))
-      (if (> arg 0)
-         (wisi-forward-statement-keyword)
-       (wisi-backward-statement-keyword))))
-   ))
-
-(defun wisi-goto-containing (cache &optional error)
-  "Move point to containing token for CACHE, return cache at that point.
-If ERROR, throw error when CACHE has no container; else return nil."
-  (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, or on cache in partially parsed statement
-    (while (and cache
-               (not (memq (wisi-cache-class cache) '(block-start 
statement-start))))
-      (setq cache (wisi-goto-containing cache)))
-    )
-  cache)
-
-(defun wisi-goto-end-1 (cache)
-  (goto-char (1- (wisi-cache-end cache))))
-
-(defun wisi-goto-statement-start ()
-  "Move point to token at start of statement point is in or after.
-Return start cache."
-  (interactive)
-  (wisi-validate-cache (point) t)
-  (let ((cache (wisi-get-cache (point))))
-    (unless cache
-      (setq cache (wisi-backward-cache)))
-    (wisi-goto-start cache)))
-
-(defun wisi-goto-statement-end ()
-  "Move point to token at end of statement point is in or before."
-  (interactive)
-  (wisi-validate-cache (point) t)
-  (let ((cache (or (wisi-get-cache (point))
-                  (wisi-forward-cache))))
-    (when (wisi-cache-end cache)
-      ;; nil when cache is statement-end
-      (wisi-goto-end-1 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-prev, 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."
-  ;; Called from `comment-indent', either to insert a new comment, or
-  ;; to indent the first line of an existing one.  In either case, the
-  ;; comment may be after code on the same line.  For an existing
-  ;; comment, point is at the start of the starting delimiter.
-  (or
-   (save-excursion
-     ;; Check for a preceding comment line; fail if comment follows code.
-     (when (forward-comment -1)
-       ;; For the case:
-       ;;
-       ;; code;-- comment
-       ;;
-       ;; point is on '--', and 'forward-comment' does not move point,
-       ;; returns nil.
-       (when (looking-at comment-start)
-         (current-column))))
-
-   (save-excursion
-     (back-to-indentation)
-     (if (looking-at comment-start)
-         ;; An existing comment, no code preceding comment, and
-         ;; no comment on preceding line. Return nil, so
-         ;; `comment-indent' will call `indent-according-to-mode'
-         nil
-
-       ;; A comment after code on the same line.
-       comment-column))
-   ))
-
-(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."
-  (wisi-validate-cache (point) t)
-
-  (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.")
-
-(defvar-local wisi-indent-fallback 'wisi-indent-fallback-default
-  "Function to compute indent for current line when wisi parse fails.")
-
-(defun wisi-indent-fallback-default ()
-  ;; no indent info at point. Assume user is
-  ;; editing; indent to previous line, fix it
-  ;; after parse succeeds
-  (forward-line -1);; safe at bob
-  (back-to-indentation)
-  (current-column))
-
-(defun wisi-indent-line ()
-  "Indent current line using the wisi indentation engine."
-  (interactive)
-
-  (let ((savep (point))
-       indent)
-    (save-excursion
-      (back-to-indentation)
-      (when (>= (point) savep) (setq savep nil))
-
-      (when (>= (point) wisi-cache-max)
-       (wisi-validate-cache (line-end-position))) ;; include at lease the 
first token on this line
-
-      (if (> (point) wisi-cache-max)
-         (progn
-             (setq wisi-indent-failed t)
-             (setq indent (funcall wisi-indent-fallback)))
-
-       ;; parse succeeded
-       (when wisi-indent-failed
-         ;; previous parse failed
-         (setq wisi-indent-failed nil)
-         (run-hooks 'wisi-post-parse-fail-hook))
-
-       (when (> (point) wisi-cache-max)
-         (error "wisi-post-parse-fail-hook invalidated parse."))
-
-       (setq indent
-             (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)) t)
-
-(defun wisi-lex-buffer ()
-  (interactive)
-  (syntax-propertize (point-max))
-  (goto-char (point-min))
-  (while (not (eq wisent-eoi-term (car (wisi-forward-token)))))
-  )
-
-(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)))
-    ))
-
-(defun wisi-show-cache-max ()
-  (interactive)
-  (push-mark)
-  (goto-char wisi-cache-max))
-
-;;;;; 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))))
-
-  (let ((numbers (cadr (symbol-value (intern-soft "number" token-table)))))
-    (setq wisi-number-term (car numbers))
-    (setq wisi-number-p (cdr numbers)))
-
-  (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)
-
-  ;; file local variables may have added opentoken, gnatprep
-  (setq wisi-indent-calculate-functions (append 
wisi-indent-calculate-functions indent-calculate))
-  (set (make-local-variable 'indent-line-function) 'wisi-indent-line)
-  (set (make-local-variable 'forward-sexp-function) #'wisi-forward-sexp)
-
-  (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)
-
-  (jit-lock-register 'wisi-fontify-region)
-
-  ;; see comments on "lexer" above re syntax-propertize
-  (syntax-propertize (point-max))
-
-  (wisi-invalidate-cache)
-  )
-
-(provide 'wisi)
-;;; wisi.el ends here
+;;; wisi.el --- Utilities for implementing an indentation/navigation engine 
using a generalized LALR parser -*- lexical-binding:t -*-
+;;
+;; Copyright (C) 2012 - 2018  Free Software Foundation, Inc.
+;;
+;; Author: Stephen Leake <stephen_leake@stephe-leake.org>
+;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
+;; Keywords: parser
+;;  indentation
+;;  navigation
+;; Version: 2.0.0
+;; package-requires: ((cl-lib "1.0") (emacs "25.0") (seq "2.20"))
+;; URL: http://www.nongnu.org/ada-mode/wisi/wisi.html
+;;
+;; 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: see NEWS-wisi.text
+;;
+;;;; Design:
+;;
+;; 'wisi' was originally short for "wisent indentation engine", but
+;; now is just a name. wisi was developed to support Emacs ada-mode
+;; 5.0 indentation, font-lock, and navigation, which are parser based.
+;;
+;; The approach to indenting a given token is to parse the buffer,
+;; computing a delta indent at each parse action.
+;;
+;; The parser actions also cache face and navigation information
+;; as text properties on tokens in statements.
+;;
+;; The three reasons to run the parser (indent, face, navigate) occur
+;; at different times (user indent, font-lock, user navigate), so only
+;; the relevant parser actions are run.
+;;
+;; 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 font-lock and navigate, keeping track of the point after which
+;; caches have been deleted is sufficent (see `wisi-cache-max').
+;;
+;; For indenting, we cache the indent for each line in a text property
+;; on the newline char preceding the line. `wisi-indent-region' sets
+;; the cache on all the lines computed (normally the whole buffer),
+;; but performs the indent only on the lines in the indent
+;; region. Subsequent calls to `wisi-indent-region' apply the cached
+;; indents. Non-whitespace edits to the buffer invalidate the indent
+;; caches in the edited region and after.
+;;
+;; See `wisi--post-change' for the details of what we check for
+;; invalidating.
+;;
+;;;; Choice of grammar compiler and parser
+;;
+;; There are two other parsing engines available in Emacs:
+;;
+;; - SMIE
+;;
+;;   We don't use this because it is designed to parse small snippets
+;;   of code. For Ada indentation, we always need to parse the entire
+;;   buffer.
+;;
+;; - semantic
+;;
+;;   The Ada grammar as given in the Ada language reference manual is
+;;   not LALR(1). So we use a generalized parser. In addition, the
+;;   semantic lexer is more complex, and gives different information
+;;   than we need.
+;;
+;; We use wisitoken wisi-generate to compile BNF to Elisp source, and
+;; wisi-compile-grammar to compile that to the parser table. See
+;; ada-mode info for more information on the developer tools used for
+;; ada-mode and wisi.
+;;
+;; Alternately, to gain speed and error handling, we use wisi-generate
+;; to generate Ada source, and run that in an external process. That
+;; supports error correction while parsing.
+;;
+;;;; syntax-propertize
+;;
+;; `wisi-forward-token' relies on syntax properties, so
+;; `syntax-propertize' must be called on the text to be lexed before
+;; wisi-forward-token is called.
+;;
+;; Emacs >= 25 calls syntax-propertize transparently in the low-level
+;; lexer functions.
+;;
+;; In Emacs < 25, we call syntax-propertize in wisi-setup, and in
+;; `wisi--post-change'.
+;;
+;;;;;
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'compile)
+(require 'seq)
+(require 'semantic/lex)
+(require 'wisi-parse-common)
+(require 'wisi-elisp-lexer)
+(require 'wisi-fringe)
+
+(defcustom wisi-size-threshold 100000
+  "Max size (in characters) for using wisi parser results for anything."
+  :type 'integer
+  :group 'wisi
+  :safe 'integerp)
+(make-variable-buffer-local 'wisi-size-threshold)
+
+(defvar wisi-inhibit-parse nil
+  "When non-nil, don't run the parser.
+Language code can set this non-nil when syntax is known to be
+invalid temporarily, or when making lots of changes.")
+
+(defcustom wisi-disable-face nil
+  "When non-nil, `wisi-setup' does not enable use of parser for font-lock.
+Useful when debugging parser or parser actions."
+  :type 'boolean
+  :group 'wisi
+  :safe 'booleanp)
+
+(defconst wisi-error-buffer-name "*wisi syntax errors*"
+  "Name of buffer for displaying syntax errors.")
+
+(defvar wisi-error-buffer nil
+  "Buffer for displaying syntax errors.")
+
+;;;; token info cache
+
+(defvar-local wisi-parse-failed nil
+  "Non-nil when a recent parse has failed - cleared when parse succeeds.")
+
+(defvar-local wisi--parse-try
+  (list
+   (cons 'face t)
+   (cons 'navigate t)
+   (cons 'indent t))
+  "Non-nil when parse is needed - cleared when parse succeeds.")
+
+(defun wisi-parse-try (&optional parse-action)
+  (cdr (assoc (or parse-action wisi--parse-action) wisi--parse-try)))
+
+(defun wisi-set-parse-try (value &optional parse-action)
+  (setcdr (assoc (or parse-action wisi--parse-action) wisi--parse-try) value))
+
+(defvar-local wisi--cache-max
+  (list
+   (cons 'face nil)
+   (cons 'navigate nil)
+   (cons 'indent nil))
+  "Alist of maximimum position in buffer where parser text properties are 
valid.")
+
+(defun wisi-cache-max (&optional parse-action)
+  ;; Don't need 'wisi-set-cache-max; (move-marker (wisi-cache-max) foo) works
+  (let ((mark (cdr (assoc (or parse-action wisi--parse-action) 
wisi--cache-max))))
+    (unless (marker-position mark)
+      ;; Sometimes marker gets set to <marker in no buffer>; not clear how.
+      (move-marker mark (point-min)))
+    mark))
+
+(defun wisi--delete-face-cache (after)
+  (with-silent-modifications
+    (remove-text-properties after (point-max) '(wisi-face nil 'font-lock-face 
nil))
+    ))
+
+(defun wisi--delete-navigate-cache (after)
+  (with-silent-modifications
+    ;; This text property is 'wisi-cache', not 'wisi-navigate', for
+    ;; historical reasons.
+    (remove-text-properties after (point-max) '(wisi-cache nil))
+    ))
+
+(defun wisi--delete-indent-cache (after)
+  (with-silent-modifications
+    (remove-text-properties after (point-max) '(wisi-indent nil))
+    ))
+
+(defun wisi-invalidate-cache (action after)
+  "Invalidate ACTION caches for the current buffer from AFTER to end of 
buffer."
+  (when (< after (wisi-cache-max action))
+    (when (> wisi-debug 0) (message "wisi-invalidate-cache %s:%s:%d" action 
(current-buffer) after))
+    (cond
+     ((eq 'face action)
+      (wisi--delete-face-cache after))
+
+     ((eq 'navigate action)
+      ;; We goto statement start to ensure that motion within nested
+      ;; structures is properly done (ie prev/next on ’elsif’ is not
+      ;; set by wisi-motion-action if already set by a lower level
+      ;; statement). We don’t do it for ’face or ’indent, because that
+      ;; might require a parse, and they don’t care about nested
+      ;; structures.
+      (save-excursion
+       (goto-char after)
+
+       ;; This is copied from ‘wisi-goto-statement-start’; we can’t
+       ;; call that because it would call ‘wisi-validate-cache’,
+       ;; which would call ‘wisi-invalidate-cache’; infinite loop.
+       ;; If this needed a navigate parse to succeed, we would not
+       ;; get here.
+       (let ((cache (or (wisi-get-cache (point))
+                        (wisi-backward-cache))))
+         (cond
+          ((null cache)
+           ;; at bob
+           nil)
+
+          ((eq 'statement-end (wisi-cache-class cache))
+           ;; If the change did affect part of a structure statement,
+           ;; this is a lower level statement. Otherwise, we are
+           ;; invalidating more than necessary; not a problem.
+           (wisi-goto-start cache)
+           (setq cache (wisi-backward-cache))
+           (when cache ;; else bob
+             (wisi-goto-start cache)))
+
+          (t
+           (wisi-goto-start cache))
+          ))
+
+       (setq after (point)))
+      (wisi--delete-navigate-cache after))
+
+     ((eq 'indent action)
+      ;; indent cache is stored on newline before line being indented.
+      (setq after
+           (save-excursion
+             (goto-char after)
+             (line-beginning-position)))
+      (wisi--delete-indent-cache (max 1 (1- after))))
+     )
+    (move-marker (wisi-cache-max action) after)
+    ))
+
+(defun wisi-reset-parser ()
+  "For ’ada-reset-parser’."
+  (wisi-invalidate-cache 'indent 0)
+  (wisi-invalidate-cache 'face 0)
+  (wisi-invalidate-cache 'navigate 0))
+
+;; wisi--change-* keep track of buffer modifications.
+;; If wisi--change-end comes before wisi--change-beg, it means there were
+;; no modifications.
+(defvar-local wisi--change-beg most-positive-fixnum
+  "First position where a change may have taken place.")
+
+(defvar-local wisi--change-end nil
+  "Marker pointing to the last position where a change may have taken place.")
+
+(defvar-local wisi--deleted-syntax nil
+  "Worst syntax class of characters deleted in changes.
+One of:
+nil - no deletions since reset
+0   - only whitespace or comment deleted
+2   - some other syntax deleted
+
+Set by `wisi-before-change', used and reset by `wisi--post-change'.")
+
+(defvar-local wisi-indenting-p nil
+  "Non-nil when `wisi-indent-region' is actively indenting.
+Used to ignore whitespace changes in before/after change hooks.")
+
+(defvar-local wisi--parser nil
+  "Choice of wisi parser implementation; a ‘wisi-parser’ object.")
+
+(defvar-local wisi--last-parse-action nil
+  "Last value of `wisi--parse-action' when `wisi-validate-cache' was run.")
+
+(defun wisi-before-change (begin end)
+  "For `before-change-functions'."
+  ;; begin . (1- end) is range of text being deleted
+  (unless wisi-indenting-p
+    ;; We set wisi--change-beg, -end even if only inserting, so we
+    ;; don't have to do it again in wisi-after-change.
+    (setq wisi--change-beg (min wisi--change-beg begin))
+
+    (cond
+     ((null wisi--change-end)
+      (setq wisi--change-end (copy-marker end)))
+
+     ((> end wisi--change-end)
+      ;; `buffer-base-buffer' deals with edits in indirect buffers
+      ;; created by ediff-regions-*
+      (set-marker wisi--change-end end (buffer-base-buffer)))
+     )
+
+    (unless (= begin end)
+      (cond
+       ((or (null wisi--deleted-syntax)
+           (= 0 wisi--deleted-syntax))
+       (save-excursion
+         (if (or (nth 4 (syntax-ppss begin)) ; in comment, moves point to begin
+                 (= end (skip-syntax-forward " " end)));; whitespace
+             (setq wisi--deleted-syntax 0)
+           (setq wisi--deleted-syntax 2))))
+
+       (t
+       ;; wisi--deleted-syntax is 2; no change.
+       )
+       ))))
+
+(defun wisi-after-change (begin end _length)
+  "For `after-change-functions'"
+  ;; begin . end is range of text being inserted (empty if equal);
+  ;; length is the size of the deleted text.
+  ;;
+  ;; This change might be changing to/from a keyword; trigger
+  ;; font-lock. See test/ada_mode-interactive_common.adb Obj_1.
+  (unless wisi-indenting-p
+    (save-excursion
+      (let (word-end)
+       (goto-char end)
+       (skip-syntax-forward "w_")
+       (setq word-end (point))
+       (goto-char begin)
+       (skip-syntax-backward "w_")
+       (with-silent-modifications
+         (remove-text-properties (point) word-end '(font-lock-face nil 
fontified nil)))
+       )
+      )))
+
+(defun wisi--post-change (begin end)
+  "Update wisi text properties for changes in region BEG END."
+  ;; (syntax-ppss-flush-cache begin) is in before-change-functions
+
+  ;; see comments above on syntax-propertize
+  (when (< emacs-major-version 25) (syntax-propertize end))
+
+  ;; Remove caches on inserted text, which could have caches from
+  ;; before the failed parse (or another buffer), and are in any case
+  ;; invalid. No point in removing 'fontified; that's handled by
+  ;; jit-lock.
+
+  (with-silent-modifications
+    (remove-text-properties begin end '(wisi-cache nil font-lock-face nil)))
+
+  (save-excursion
+    (let ((need-invalidate t)
+         (done nil)
+         ;; non-nil if require a parse because the syntax may have
+         ;; changed.
+
+         (begin-state (syntax-ppss begin))
+         (end-state (syntax-ppss end)))
+         ;; (info "(elisp)Parser State")
+         ;; syntax-ppss has moved point to "end"; might be eob.
+
+      ;; consider deletion
+      (cond
+       ((null wisi--deleted-syntax)
+       ;; no deletions
+       )
+
+       ((= 0 wisi--deleted-syntax)
+       ;; Only deleted whitespace; may have joined two words
+       (when
+           (and (= begin end) ;; no insertions
+                (or
+                 (= (point-min) begin)
+                 (= 0 (syntax-class (syntax-after (1- begin))))
+                 (= (point-max) end)
+                 (= 0 (syntax-class (syntax-after end)))))
+         ;; More whitespace on at least one side of deletion; did not
+         ;; join two words.
+         (setq need-invalidate nil)
+         (setq done t)
+         ))
+
+       (t
+       ;; wisi--deleted-syntax is 2; need invalidate and parse for all
+       ;; parse actions
+       (setq done t)
+       ))
+
+      (setq wisi--deleted-syntax nil)
+
+      (unless done
+       ;; consider insertion
+       (cond
+        ((= begin end)
+         ;; no insertions
+         nil)
+
+        ((and
+          (nth 3 begin-state);; in string
+          (nth 3 end-state)
+          (= (nth 8 begin-state) (nth 8 end-state)));; no intervening 
non-string
+         (setq need-invalidate nil))
+
+        ((and
+          (nth 4 begin-state) ; in comment
+          (nth 4 end-state)
+          (= (nth 8 begin-state) (nth 8 end-state))) ;; no intervening 
non-comment
+         (setq need-invalidate nil))
+
+        ((and
+          (or
+           (= (point-min) begin)
+           (= 0 (syntax-class (syntax-after (1- begin)))); whitespace
+           (= (point-max) end)
+           (= 0 (syntax-class (syntax-after end))))
+          (progn
+            (goto-char begin)
+            (= (- end begin) (skip-syntax-forward " " end))
+            ))
+         ;; Inserted only whitespace, there is more whitespace on at
+         ;; least one side, and we are not in a comment or string
+         ;; (checked above).  This may affect indentation, but not
+         ;; the indentation cache.
+         (setq need-invalidate nil))
+        ))
+
+      (when need-invalidate
+       (wisi-set-parse-try t 'face)
+       (wisi-set-parse-try t 'navigate)
+       (wisi-set-parse-try t 'indent)
+
+       (wisi-invalidate-cache 'face begin)
+       (wisi-invalidate-cache 'navigate begin)
+       (wisi-invalidate-cache 'indent begin))
+      )))
+
+(defun wisi-goto-error ()
+  "Move point to position in last error message (if any)."
+  (cond
+   ((wisi-parser-parse-errors wisi--parser)
+    (let ((data (car (wisi-parser-parse-errors wisi--parser))))
+      (cond
+       ((wisi--parse-error-pos data)
+       (push-mark)
+       (goto-char (wisi--parse-error-pos data)))
+
+       ((string-match ":\\([0-9]+\\):\\([0-9]+\\):" (wisi--parse-error-message 
data))
+       (let* ((msg (wisi--parse-error-message data))
+              (line (string-to-number (match-string 1 msg)))
+              (col (string-to-number (match-string 2 msg))))
+         (push-mark)
+         (goto-char (point-min))
+         (condition-case nil
+             (progn
+               ;; line can be wrong if parser screws up, or user edits buffer
+               (forward-line (1- line))
+               (forward-char col))
+           (error
+            ;; just stay at eob.
+            nil))))
+       )))
+   ((wisi-parser-lexer-errors wisi--parser)
+    (push-mark)
+    (goto-char (wisi--lexer-error-pos (car (wisi-parser-lexer-errors 
wisi--parser)))))
+   ))
+
+(defun wisi-show-parse-error ()
+  "Show current wisi-parse errors."
+  (interactive)
+  (cond
+   ((or (wisi-parser-lexer-errors wisi--parser)
+       (wisi-parser-parse-errors wisi--parser))
+    (if (and (= 1 (+ (length (wisi-parser-lexer-errors wisi--parser))
+                    (length (wisi-parser-parse-errors wisi--parser))))
+            (or (and (wisi-parser-parse-errors wisi--parser)
+                     (not (wisi--parse-error-repair (car 
(wisi-parser-parse-errors wisi--parser)))))
+                (and (wisi-parser-lexer-errors wisi--parser)
+                     (not (wisi--lexer-error-inserted (car 
(wisi-parser-lexer-errors wisi--parser)))))))
+       ;; There is exactly one error; if there is error correction
+       ;; information, use a ’compilation’ buffer, so
+       ;; *-fix-compiler-error will call
+       ;; wisi-repair-error. Otherwise, just position cursor at
+       ;; error.
+       (progn
+         (wisi-goto-error)
+         (message (or (and (wisi-parser-parse-errors wisi--parser)
+                           (wisi--parse-error-message (car 
(wisi-parser-parse-errors wisi--parser))))
+                      (and (wisi-parser-lexer-errors wisi--parser)
+                           (wisi--lexer-error-message (car 
(wisi-parser-lexer-errors wisi--parser)))))
+                  ))
+
+      ;; else show all errors in a ’compilation’ buffer
+      (setq wisi-error-buffer (get-buffer-create wisi-error-buffer-name))
+
+      (let ((lexer-errs (nreverse (cl-copy-seq (wisi-parser-lexer-errors 
wisi--parser))))
+           (parse-errs (nreverse (cl-copy-seq (wisi-parser-parse-errors 
wisi--parser)))))
+       (with-current-buffer wisi-error-buffer
+         (compilation-mode)
+         (setq next-error-last-buffer (current-buffer))
+         (setq buffer-read-only nil)
+         (erase-buffer)
+         ;; compilation-nex-error-function assumes there is not an
+         ;; error at point min, so we need a comment.
+         (insert "wisi syntax errors")
+         (newline)
+         (dolist (err lexer-errs)
+           (insert (wisi--lexer-error-message err))
+           (put-text-property (line-beginning-position) (1+ 
(line-beginning-position)) 'wisi-error-data err)
+           (newline 2))
+         (dolist (err parse-errs)
+           (insert (wisi--parse-error-message err))
+           (put-text-property (line-beginning-position) (1+ 
(line-beginning-position)) 'wisi-error-data err)
+           (newline 2))
+         (compilation--flush-parse (point-min) (point-max))
+         (compilation--ensure-parse (point-max))
+         (when compilation-filter-hook
+           (let ((compilation-filter-start (point-min)))
+             (run-hooks 'compilation-filter-hook)))
+
+         (setq buffer-read-only t)
+         (goto-char (point-min)))
+
+       (display-buffer wisi-error-buffer
+                       (cons #'display-buffer-at-bottom
+                             (list (cons 'window-height 
#'shrink-window-if-larger-than-buffer))))
+       (next-error))
+      ))
+
+   ((wisi-parse-try wisi--last-parse-action)
+    (message "need parse"))
+
+   (t
+    (message "parse succeeded"))
+   ))
+
+(defun wisi-kill-parser ()
+  "Kill the background process running the parser for the current buffer.
+Usefull if the parser appears to be hung."
+  (interactive)
+  (wisi-parse-kill wisi--parser)
+  ;; also force re-parse
+  (dolist (parse-action '(face navigate indent))
+    (wisi-set-parse-try t parse-action)
+    (move-marker (wisi-cache-max parse-action) (point-max));; force delete 
caches
+    (wisi-invalidate-cache parse-action (point-min)))
+  )
+
+(defun wisi--run-parse ()
+  "Run the parser."
+  (unless (buffer-narrowed-p)
+    (let ((msg (when (> wisi-debug 0)
+                (format "wisi: parsing %s %s:%d ..."
+                        wisi--parse-action
+                        (buffer-name)
+                        (line-number-at-pos (point))))))
+      (when (> wisi-debug 0)
+       (message msg))
+
+      (setq wisi--last-parse-action wisi--parse-action)
+
+      (unless (eq wisi--parse-action 'face)
+       (when (buffer-live-p wisi-error-buffer)
+         (with-current-buffer wisi-error-buffer
+           (setq buffer-read-only nil)
+           (erase-buffer)
+           (setq buffer-read-only t))))
+
+      (condition-case-unless-debug err
+         (save-excursion
+           (wisi-parse-current wisi--parser)
+           (setq wisi-parse-failed nil)
+           (move-marker (wisi-cache-max) (point))
+           )
+       (wisi-parse-error
+        (cl-ecase wisi--parse-action
+          (face
+           ;; caches set by failed parse are ok
+           (wisi--delete-face-cache (wisi-cache-max)))
+
+          (navigate
+           ;; parse partially resets caches before and after wisi-cache-max
+           (move-marker (wisi-cache-max) (point-min))
+           (wisi--delete-navigate-cache (point-min)))
+
+          (indent
+           ;; parse does not set caches; see `wisi-indent-region'
+           nil))
+        (setq wisi-parse-failed t)
+        ;; parser should have stored this error message in parser-error-msgs
+        )
+       (error
+        ;; parser failed for other reason
+        (setq wisi-parse-failed t)
+        (signal (car err) (cdr err)))
+       )
+
+      (wisi-fringe-display-errors
+       (append
+       (seq-map (lambda (err) (wisi--lexer-error-pos err)) 
(wisi-parser-lexer-errors wisi--parser))
+       (seq-map (lambda (err) (wisi--parse-error-pos err)) 
(wisi-parser-parse-errors wisi--parser))))
+
+      (when (> wisi-debug 0)
+       (if (or (wisi-parser-lexer-errors wisi--parser)
+               (wisi-parser-parse-errors wisi--parser))
+           (progn
+             (message "%s error" msg)
+             (wisi-goto-error)
+             (error (or (and (wisi-parser-lexer-errors wisi--parser)
+                             (wisi--lexer-error-message (car 
(wisi-parser-lexer-errors wisi--parser))))
+                        (and (wisi-parser-parse-errors wisi--parser)
+                             (wisi--parse-error-message (car 
(wisi-parser-parse-errors wisi--parser))))
+                        )))
+
+         ;; no error
+         (message "%s done" msg))
+       ))))
+
+(defun wisi--check-change ()
+  "Process `wisi--change-beg', `wisi--change-end'.
+`wisi--parse-action' must be bound."
+  (when (and wisi--change-beg
+            wisi--change-end
+            (<= wisi--change-beg wisi--change-end))
+    (wisi--post-change wisi--change-beg (marker-position wisi--change-end))
+    (setq wisi--change-beg most-positive-fixnum)
+    (move-marker wisi--change-end (point-min))
+    ))
+
+(defun wisi-validate-cache (pos error-on-fail parse-action)
+  "Ensure cached data for PARSE-ACTION is valid at least up to POS in current 
buffer."
+  (if (< (point-max) wisi-size-threshold)
+      (let ((wisi--parse-action parse-action))
+       (wisi--check-change)
+
+       ;; Now we can rely on wisi-cache-max.
+
+       ;; If wisi-cache-max = pos, then there is no cache at pos; need parse
+       (when (and (not wisi-inhibit-parse)
+                  (wisi-parse-try)
+                  (<= (wisi-cache-max) pos))
+
+         ;; Don't keep retrying failed parse until text changes again.
+         (wisi-set-parse-try nil)
+
+         (wisi--run-parse))
+
+       ;; We want this error even if we did not try to parse; it means
+       ;; the parse results are not valid.
+       (when (and error-on-fail wisi-parse-failed)
+         (error "parse %s failed" parse-action))
+       )
+    (when (> wisi-debug 0)
+      (message "parse skipped due to ‘wisi-size-threshold’"))))
+
+(defun wisi-fontify-region (_begin end)
+  "For `jit-lock-functions'."
+  (wisi-validate-cache end nil 'face))
+
+(defun wisi-get-containing-cache (cache)
+  "Return cache from (wisi-cache-containing CACHE)."
+  (when cache
+    (let ((containing (wisi-cache-containing cache)))
+      (and containing
+          (wisi-get-cache 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))))
+
+;;;; navigation
+
+(defun wisi-forward-find-class (class limit)
+  "Search at point or 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 (or (wisi-get-cache (point))
+                  (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 TOKEN.
+If point is at a matching token, return that token.  TOKEN may be
+a list; stop on any member of the list.  Return `wisi-tok'
+struct, or 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))))
+       (tok (wisi-forward-token))
+       (done nil))
+    (while (not (or done
+                   (memq (wisi-tok-token tok) token-list)))
+      (setq tok (wisi-forward-token))
+      (when (or (>= (point) limit)
+               (eobp))
+       (goto-char limit)
+       (setq tok nil)
+       (if noerror
+           (setq done t)
+         (error "token %s not found" token))))
+    tok))
+
+(defun wisi-forward-find-cache-token (ids limit)
+  "Search forward for a cache with token in IDS (a list of token ids).
+Return cache, or nil if at LIMIT or end of buffer."
+  (let ((cache (wisi-forward-cache)))
+    (while (and (< (point) limit)
+               (not (eobp))
+               (not (memq (wisi-cache-token cache) ids)))
+      (setq cache (wisi-forward-cache)))
+    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 (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 cache-end, or next cache
+if both nil.  Return cache found."
+  (unless (eobp)
+    (wisi-validate-cache (point-max) t 'navigate) ;; ensure there is a next 
cache to move to
+    (let ((cache (wisi-get-cache (point))))
+      (if (and cache
+              (not (eq (wisi-cache-class cache) 'statement-end)))
+         (let ((next (or (wisi-cache-next cache)
+                         (wisi-cache-end cache))))
+           (if next
+               (goto-char next)
+             (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) t 'navigate)
+  (let ((cache (wisi-get-cache (point)))
+       prev)
+    (when cache
+      (setq prev (wisi-cache-prev cache))
+      (unless prev
+       (unless (eq 'statement-start (wisi-cache-class cache))
+         (setq prev (wisi-cache-containing cache)))))
+    (if prev
+       (goto-char prev)
+      (wisi-backward-cache))
+  ))
+
+(defun wisi-forward-sexp (&optional arg)
+  "For `forward-sexp-function'."
+  (interactive "^p")
+  (or arg (setq arg 1))
+  (cond
+   ((and (> arg 0) (= 4 (syntax-class (syntax-after (point)))))  ;; on open 
paren
+    (let ((forward-sexp-function nil))
+      (forward-sexp arg)))
+
+   ((and (< arg 0) (= 5 (syntax-class (syntax-after (1- (point)))))) ;; after 
close paren
+    (let ((forward-sexp-function nil))
+      (forward-sexp arg)))
+
+   ((and (> arg 0) (= 7 (syntax-class (syntax-after (point)))))  ;; on (open) 
string quote
+    (let ((forward-sexp-function nil))
+      (forward-sexp arg)))
+
+   ((and (< arg 0) (= 7 (syntax-class (syntax-after (1- (point)))))) ;; after 
(close) string quote
+    (let ((forward-sexp-function nil))
+      (forward-sexp arg)))
+
+   (t
+    (dotimes (_i (abs arg))
+      (if (> arg 0)
+         (wisi-forward-statement-keyword)
+       (wisi-backward-statement-keyword))))
+   ))
+
+(defun wisi-goto-containing (cache &optional error)
+  "Move point to containing token for CACHE, return cache at that point.
+If ERROR, throw error when CACHE has no container; else return nil."
+  (cond
+   ((and (markerp (wisi-cache-containing cache))
+
+        (not (= (wisi-cache-containing cache) (point))))
+    ;; This check is only needed if some cache points to itself as a
+    ;; container. Apparently that happend once that I caught in the
+    ;; debugger; emacs hung because we got here in the font-lock
+    ;; timer.
+
+    (goto-char (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 statement-start.
+Return start cache."
+  ;; cache nil at bob, or on cache in partially parsed statement
+  (while (and cache
+             (not (eq (wisi-cache-class cache) 'statement-start)))
+    (setq cache (wisi-goto-containing cache)))
+  cache)
+
+(defun wisi-goto-end-1 (cache)
+  (goto-char (wisi-cache-end cache)))
+
+(defun wisi-goto-statement-start ()
+  "Move point to token at start of statement point is in or after.
+Return start cache."
+  (interactive)
+  (wisi-validate-cache (point) t 'navigate)
+  (wisi-goto-start (or (wisi-get-cache (point))
+                      (wisi-backward-cache))))
+
+(defun wisi-goto-statement-end ()
+  "Move point to token at end of statement point is in or before."
+  (interactive)
+  (wisi-validate-cache (point) t 'navigate)
+  (let ((cache (or (wisi-get-cache (point))
+                  (wisi-forward-cache))))
+    (when (wisi-cache-end cache)
+      ;; nil when cache is statement-end
+      (wisi-goto-end-1 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 (wisi-cache-next cache))
+  (wisi-get-cache (point)))
+
+(defun wisi-prev-statement-cache (cache)
+  "Move point to CACHE-prev, return cache; error if nil."
+  (when (not (markerp (wisi-cache-prev cache)))
+    (error "no prev statement cache"))
+  (goto-char (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."
+  ;; Called from `comment-indent', either to insert a new comment, or
+  ;; to indent the first line of an existing one.  In either case, the
+  ;; comment may be after code on the same line.  For an existing
+  ;; comment, point is at the start of the starting delimiter.
+  (or
+   (save-excursion
+     ;; Check for a preceding comment line; fail if comment follows code.
+     (when (forward-comment -1)
+       ;; For the case:
+       ;;
+       ;; code;-- comment
+       ;;
+       ;; point is on '--', and 'forward-comment' does not move point,
+       ;; returns nil.
+       (when (looking-at comment-start)
+         (current-column))))
+
+   (save-excursion
+     (back-to-indentation)
+     (if (looking-at comment-start)
+         ;; An existing comment, no code preceding comment, and
+         ;; no comment on preceding line. Return nil, so
+         ;; `comment-indent' will call `indent-according-to-mode'
+         nil
+
+       ;; A comment after code on the same line.
+       comment-column))
+   ))
+
+(defun wisi-indent-statement ()
+  "Indent region given by `wisi-goto-start', `wisi-cache-end'."
+  (wisi-validate-cache (point) t 'navigate)
+
+  (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 (if (wisi-cache-end cache)
+                        ;; nil when cache is statement-end
+                        (wisi-cache-end cache)
+                      (point))))
+         (indent-region start end)
+         ))
+      )))
+
+(defvar-local wisi-indent-calculate-functions nil
+  "Functions to compute indentation special cases.
+Called with point at current indentation of a line; return
+indentation column, or nil if function does not know how to
+indent that line. Run after parser indentation, so other lines
+are indented correctly.")
+
+(defvar-local wisi-post-indent-fail-hook
+  "Function to reindent portion of buffer.
+Called from `wisi-indent-region' 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-region fails due to parse failing; cleared when 
indent succeeds.")
+
+(defvar-local wisi-indent-region-fallback 'wisi-indent-region-fallback-default
+  "Function to compute indent for lines in region when wisi parse fails.
+Called with BEGIN END.")
+
+(defun wisi-indent-region-fallback-default (begin end)
+  ;; Assume there is no indent info at point; user is editing. Indent
+  ;; to previous lines.
+  (goto-char begin)
+  (forward-line -1);; safe at bob
+  (back-to-indentation)
+  (let ((col (current-column)))
+    (while (and (not (eobp))
+               (< (point) end))
+      (forward-line 1)
+      (indent-line-to col)
+      (when (bobp)
+       ;; single line in buffer; terminate loop
+       (goto-char (point-max))))))
+
+(defun wisi-indent-region (begin end)
+  "For `indent-region-function', using the wisi indentation engine."
+  (let ((wisi--parse-action 'indent)
+       (parse-required nil)
+       (end-mark (copy-marker end))
+       (prev-indent-failed wisi-indent-failed))
+
+    (wisi--check-change)
+
+    ;; Always indent the line containing BEGIN.
+    (save-excursion
+      (goto-char begin)
+      (setq begin (line-beginning-position))
+
+      (when (bobp) (forward-line))
+      (while (and (not parse-required)
+                 (<= (point) end)
+                 (not (eobp)))
+       (unless (get-text-property (1- (point)) 'wisi-indent)
+         (setq parse-required t))
+       (forward-line))
+      )
+
+    ;; A parse either succeeds and sets the indent cache on all
+    ;; lines in the buffer, or fails and leaves valid caches
+    ;; untouched.
+    (when (and parse-required
+              (wisi-parse-try))
+
+      (wisi-set-parse-try nil)
+      (wisi--run-parse)
+
+      ;; If there were errors corrected, the indentation is
+      ;; potentially ambiguous; see test/ada_mode-interactive_2.adb
+      (setq wisi-indent-failed (< 0 (+ (length (wisi-parser-lexer-errors 
wisi--parser))
+                                      (length (wisi-parser-parse-errors 
wisi--parser)))))
+      )
+
+    (if wisi-parse-failed
+       (progn
+         ;; primary indent failed
+         (setq wisi-indent-failed t)
+         (when (functionp wisi-indent-region-fallback)
+           (funcall wisi-indent-region-fallback begin end)))
+
+      (save-excursion
+       ;; Apply cached indents.
+       (goto-char begin)
+       (let ((wisi-indenting-p t))
+         (while (and (not (eobp))
+                     (<= (point) end-mark)) ;; end-mark can be at the start of 
an empty line
+           (indent-line-to (if (bobp) 0 (get-text-property (1- (point)) 
'wisi-indent)))
+           (forward-line 1)))
+
+       ;; Run wisi-indent-calculate-functions
+       (when wisi-indent-calculate-functions
+         (goto-char begin)
+         (while (and (not (eobp))
+                     (< (point) end-mark))
+           (back-to-indentation)
+           (let ((indent
+                  (run-hook-with-args-until-success 
'wisi-indent-calculate-functions)))
+             (when indent
+               (indent-line-to indent)))
+
+           (forward-line 1)))
+
+       (when
+           (and prev-indent-failed
+                (not wisi-indent-failed))
+         ;; Previous parse failed or indent was potentially
+         ;; ambiguous, this one is not.
+         (goto-char end-mark)
+         (run-hooks 'wisi-post-indent-fail-hook))
+       ))
+    ))
+
+(defun wisi-indent-line ()
+  "For `indent-line-function'."
+  (let ((savep (copy-marker (point)))
+       (to-indent nil))
+    (back-to-indentation)
+    (when (>= (point) savep)
+      (setq to-indent t))
+
+    (wisi-indent-region (line-beginning-position) (line-end-position))
+
+    (goto-char savep)
+    (when to-indent (back-to-indentation))
+    ))
+
+(defun wisi-repair-error-1 (data)
+  "Repair error reported in DATA (a ’wisi--parse-error’ or 
’wisi--lexer-error’)"
+  (let ((wisi--parse-action 'navigate) ;; tell wisi-forward-token not to 
compute indent stuff.
+       tok-2)
+    (cond
+     ((wisi--lexer-error-p data)
+      (goto-char (1+ (wisi--lexer-error-pos data)))
+      (insert (wisi--lexer-error-inserted data)))
+     ((wisi--parse-error-p data)
+      (dolist (repair (wisi--parse-error-repair data))
+       (goto-char (wisi--parse-error-repair-pos repair))
+       (dolist (tok-1 (wisi--parse-error-repair-deleted repair))
+         (setq tok-2 (wisi-forward-token))
+         (if (eq tok-1 (wisi-tok-token tok-2))
+             (delete-region (car (wisi-tok-region tok-2)) (cdr 
(wisi-tok-region tok-2)))
+           (error "mismatched tokens: %d: parser %s, buffer %s %s"
+                  (point) tok-1 (wisi-tok-token tok-2) (wisi-tok-region 
tok-2))))
+
+       (dolist (id (wisi--parse-error-repair-inserted repair))
+         (insert (cdr (assoc id (wisi-elisp-lexer-id-alist wisi--lexer))))
+         (insert " "))
+       ))
+     )))
+
+(defun wisi-repair-error ()
+  "Repair the current error."
+  (interactive)
+  (let ((wisi-inhibit-parse t)) ;; don’t let the error list change while we 
are processing it.
+    (if (= 1 (+ (length (wisi-parser-lexer-errors wisi--parser))
+               (length (wisi-parser-parse-errors wisi--parser))))
+       (progn
+         (wisi-goto-error)
+         (wisi-repair-error-1 (or (car (wisi-parser-lexer-errors wisi--parser))
+                                  (car (wisi-parser-parse-errors 
wisi--parser)))))
+      (if (buffer-live-p wisi-error-buffer)
+         (let ((err
+                (with-current-buffer wisi-error-buffer
+                  ;; FIXME: ensure at beginning of error message line.
+                  (get-text-property (point) 'wisi-error-data))))
+           (wisi-repair-error-1 err))
+       (error "no current error found")
+       ))))
+
+(defun wisi-repair-errors (&optional beg end)
+  "Repair errors reported by last parse.
+If non-nil, only repair errors in BEG END region."
+  (interactive)
+  (let ((wisi-inhibit-parse t)) ;; don’t let the error list change while we 
are processing it.
+    (dolist (data (wisi-parser-lexer-errors wisi--parser))
+      (when (or (null beg)
+               (and (not (= 0 (wisi--lexer-error-inserted data)))
+                    (wisi--lexer-error-pos data)
+                    (<= beg (wisi--lexer-error-pos data))
+                    (<= (wisi--lexer-error-pos data) end)))
+       (wisi-repair-error-1 data)))
+
+    (dolist (data (wisi-parser-parse-errors wisi--parser))
+      (when (or (null beg)
+               (and (wisi--parse-error-pos data)
+                    (<= beg (wisi--parse-error-pos data))
+                    (<= (wisi--parse-error-pos data) end)))
+       (wisi-repair-error-1 data)))
+    ))
+
+;;;; debugging
+
+(defun wisi-debug-keys ()
+  "Add debug key definitions to `global-map'."
+  (interactive)
+  (define-key global-map "\M-h" 'wisi-show-containing-or-previous-cache)
+  (define-key global-map "\M-i" 'wisi-show-indent)
+  (define-key global-map "\M-j" 'wisi-show-cache)
+  )
+
+(defun wisi-parse-buffer (&optional parse-action)
+  (interactive)
+  (unless parse-action (setq parse-action 'indent))
+  (wisi-set-parse-try t parse-action)
+  (move-marker (wisi-cache-max parse-action) (point-max));; force delete caches
+  (wisi-invalidate-cache parse-action (point-min))
+
+  (cl-ecase parse-action
+    (face
+     (with-silent-modifications
+       (remove-text-properties
+       (point-min) (point-max)
+       (list
+        'font-lock-face nil
+        'fontified nil)))
+     (wisi-validate-cache (point-max) t parse-action)
+     (when (fboundp 'font-lock-ensure) (font-lock-ensure))) ;; emacs < 25
+
+    (navigate
+     (wisi-validate-cache (point-max) t parse-action))
+
+    (indent
+     (wisi-indent-region (point-min) (point-max)))
+    ))
+
+(defun wisi-time (func count &optional report-wait-time)
+  "call FUNC COUNT times, show total time"
+  (interactive "afunction \nncount ")
+
+  (let ((start-time (float-time))
+       (start-gcs gcs-done)
+       (cum-wait-time 0.0)
+        (i 0)
+        diff-time
+       diff-gcs)
+    (while (not (eq (1+ count) (setq i (1+ i))))
+      (save-excursion
+        (funcall func))
+      (when report-wait-time
+       (setq cum-wait-time (+ cum-wait-time 
(wisi-process--parser-total-wait-time wisi--parser)))))
+    (setq diff-time (- (float-time) start-time))
+    (setq diff-gcs (- gcs-done start-gcs))
+    (if report-wait-time
+       (progn
+         (message "Total %f seconds, %d gcs; per iteration %f seconds %d gcs 
%d responses %f wait"
+                  diff-time
+                  diff-gcs
+                  (/ diff-time count)
+                  (/ (float diff-gcs) count)
+                  (wisi-process--parser-response-count wisi--parser)
+                  (/ cum-wait-time count)))
+
+      (message "Total %f seconds, %d gcs; per iteration %f seconds %d gcs"
+              diff-time
+              diff-gcs
+              (/ diff-time count)
+              (/ (float diff-gcs) count))
+      ))
+  nil)
+
+(defun wisi-time-indent-middle-line-cold-cache (count &optional 
report-wait-time)
+  (goto-char (point-min))
+  (forward-line (1- (/ (count-lines (point-min) (point-max)) 2)))
+  (let ((cum-wait-time 0.0))
+    (wisi-time
+     (lambda ()
+       (wisi-set-parse-try t 'indent)
+       (move-marker (wisi-cache-max 'indent) (point-max));; force delete caches
+       (wisi-invalidate-cache 'indent (point-min))
+       (wisi-indent-line)
+       (when (wisi-process--parser-p wisi--parser)
+        (setq cum-wait-time (+ cum-wait-time 
(wisi-process--parser-total-wait-time wisi--parser)))))
+     count
+     report-wait-time)
+    ))
+
+(defun wisi-time-indent-middle-line-warm-cache (count)
+  (wisi-set-parse-try t 'indent)
+  (move-marker (wisi-cache-max 'indent) (point-max));; force delete caches
+  (wisi-invalidate-cache 'indent (point-min))
+  (goto-char (point-min))
+  (forward-line (/ (count-lines (point-min) (point-max)) 2))
+  (wisi-indent-line)
+  (wisi-time #'wisi-indent-line count))
+
+(defun wisi-show-indent ()
+  "Show indent cache for current line."
+  (interactive)
+  (message "%s" (get-text-property (1- (line-beginning-position)) 
'wisi-indent)))
+
+(defun wisi-show-cache ()
+  "Show navigation and face caches, and applied faces, at point."
+  (interactive)
+  (message "%s:%s:%s:%s"
+          (wisi-get-cache (point))
+          (get-text-property (point) 'wisi-face)
+          (get-text-property (point) 'face)
+          (get-text-property (point) 'font-lock-face)
+          ))
+
+(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)))
+    ))
+
+(defun wisi-show-cache-max (action)
+  (push-mark)
+  (goto-char (wisi-cache-max action)))
+
+;;;;; setup
+
+(cl-defun wisi-setup (&key indent-calculate post-indent-fail parser lexer)
+  "Set up a buffer for parsing files with wisi."
+  (when wisi--parser
+    (wisi-kill-parser))
+
+  (setq wisi--parser parser)
+  (setq wisi--lexer lexer)
+
+  (setq wisi--cache-max
+       (list
+        (cons 'face (copy-marker (point-min)))
+        (cons 'navigate (copy-marker (point-min)))
+        (cons 'indent (copy-marker (point-min)))))
+
+  (setq wisi--parse-try
+       (list
+        (cons 'face t)
+        (cons 'navigate t)
+        (cons 'indent t)))
+
+  ;; file local variables may have added opentoken, gnatprep
+  (setq wisi-indent-calculate-functions (append 
wisi-indent-calculate-functions indent-calculate))
+  (set (make-local-variable 'indent-line-function) #'wisi-indent-line)
+  (set (make-local-variable 'indent-region-function) #'wisi-indent-region)
+  (set (make-local-variable 'forward-sexp-function) #'wisi-forward-sexp)
+
+  (setq wisi-post-indent-fail-hook post-indent-fail)
+  (setq wisi-indent-failed nil)
+
+  (add-hook 'before-change-functions #'wisi-before-change 'append t)
+  (add-hook 'after-change-functions #'wisi-after-change nil t)
+  (setq wisi--change-end (copy-marker (point-min) t))
+
+  ;; See comments above on syntax-propertize.
+  (when (< emacs-major-version 25) (syntax-propertize (point-max)))
+
+  ;; In Emacs >= 26, ‘run-mode-hooks’ (in the major mode function)
+  ;; runs ‘hack-local-variables’ after ’*-mode-hooks’; we need
+  ;; ‘wisi-post-local-vars’ to run after ‘hack-local-variables’.
+  (add-hook 'hack-local-variables-hook 'wisi-post-local-vars nil t)
+  )
+
+(defun wisi-post-local-vars ()
+  "See wisi-setup."
+  (setq hack-local-variables-hook (delq 'wisi-post-local-vars 
hack-local-variables-hook))
+
+  (unless wisi-disable-face
+    (jit-lock-register #'wisi-fontify-region)))
+
+
+(provide 'wisi)
+;;; wisi.el ends here
diff --git a/wisitoken-bnf-generate.adb b/wisitoken-bnf-generate.adb
new file mode 100644
index 0000000..7569ffb
--- /dev/null
+++ b/wisitoken-bnf-generate.adb
@@ -0,0 +1,522 @@
+--  Abstract :
+--
+--  Parser for Wisi grammar files, producing Ada or Elisp source
+--  files for a parser.
+--
+--  Copyright (C) 2012 - 2015, 2017, 2018 Stephen Leake.  All Rights Reserved.
+--
+--  The WisiToken package is free software; you can redistribute it
+--  and/or modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or
+--  (at your option) any later version. This library 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.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Command_Line;
+with Ada.Directories;
+with Ada.Exceptions;
+with Ada.Real_Time;
+with Ada.Strings.Fixed;
+with Ada.Strings.Maps;
+with Ada.Strings.Unbounded;
+with Ada.Text_IO;
+with GNAT.Traceback.Symbolic;
+with WisiToken.BNF.Generate_Utils;
+with WisiToken.BNF.Output_Ada;
+with WisiToken.BNF.Output_Ada_Common;
+with WisiToken.BNF.Output_Ada_Emacs;
+with WisiToken.BNF.Output_Elisp;
+with WisiToken.BNF.Output_Elisp_Common;
+with WisiToken.Generate.Packrat;
+with WisiToken.Generate.LR.LALR_Generate;
+with WisiToken.Generate.LR.LR1_Generate;
+with WisiToken.Parse.LR.Parser_No_Recover; -- for reading BNF file
+with WisiToken.Productions;
+with WisiToken.Text_IO_Trace;
+with WisiToken_Grammar_Runtime;
+with Wisitoken_Grammar_Actions;
+with Wisitoken_Grammar_Main;
+procedure WisiToken.BNF.Generate
+is
+   use all type Ada.Containers.Count_Type;
+
+   procedure Put_Usage
+   is
+      use Ada.Text_IO;
+      First : Boolean := True;
+   begin
+      --  verbosity meaning is actually determined by output choice;
+      --  they should be consistent with this description.
+      Put_Line (Standard_Error, "version 1.0");
+      Put_Line (Standard_Error, "wisi-generate [options] {wisi grammar file}");
+      Put_Line (Standard_Error, "Generate source code implementing a parser 
for the grammar.");
+      New_Line (Standard_Error);
+      Put_Line (Standard_Error, "The following grammar file directives control 
parser generation:");
+      Put_Line (Standard_Error,
+                "%generate <algorithm> <output language> [<lexer>] 
[<interface>] [text_rep]");
+      Put_Line (Standard_Error, "   specify one of each generate parameter. 
May be repeated.");
+      Put (Standard_Error, "   algorithm: ");
+      for I of Generate_Algorithm_Image loop
+         if First then
+            First := False;
+         else
+            Put (Standard_Error, " | ");
+         end if;
+         Put (Standard_Error, I.all);
+      end loop;
+      New_Line (Standard_Error);
+
+      Put (Standard_Error, "   output language: ");
+      First := True;
+      for I of Output_Language_Image loop
+         if First then
+            First := False;
+         else
+            Put (Standard_Error, " | ");
+         end if;
+         Put (Standard_Error, I.all);
+      end loop;
+      New_Line (Standard_Error);
+
+      Put_Line (Standard_Error, "   interface: interface Process | Module");
+      Put_Line (Standard_Error, "      only valid with Ada_Emacs:");
+      Put_Line (Standard_Error, "      Process is for an external subprocess 
communicating with Emacs.");
+      Put_Line (Standard_Error, "      Module  is for a dynamically loaded 
Emacs module.");
+      Put (Standard_Error, "   lexer: ");
+      First := True;
+      for I of Output_Language_Image loop
+         if First then
+            First := False;
+         else
+            Put (Standard_Error, " | ");
+         end if;
+         Put (Standard_Error, I.all);
+      end loop;
+      New_Line (Standard_Error);
+      Put_Line
+        (Standard_Error, "   text_rep: output LR parse table in a text file, 
not as source code; for large tables");
+
+      New_Line (Standard_Error);
+      Put_Line (Standard_Error, "options:");
+      Put_Line (Standard_Error, "  --help: show this help");
+      Put_Line (Standard_Error, "  -v level: sets verbosity (default 0):");
+      Put_Line (Standard_Error, "     0 - only error messages to standard 
error");
+      Put_Line (Standard_Error, "     1 - add diagnostics to standard out");
+      Put_Line (Standard_Error, "     2 - more diagnostics to standard out, 
ignore unused tokens, unknown conflicts");
+      Put_Line (Standard_Error, "  --generate ...: override grammar file 
%generate directive");
+      Put_Line (Standard_Error, "  --suffix <string>; appended to grammar file 
name");
+      Put_Line (Standard_Error,
+                "  --test_main; generate standalone main program for running 
the generated parser, modify file names");
+      Put_Line (Standard_Error, "  --time; output execution time of various 
stages");
+
+   end Put_Usage;
+
+   Language_Name         : Ada.Strings.Unbounded.Unbounded_String; -- The 
language the grammar defines
+   Output_File_Name_Root : Ada.Strings.Unbounded.Unbounded_String;
+   Suffix                : Ada.Strings.Unbounded.Unbounded_String;
+   Test_Main             : Boolean := False;
+
+   Command_Generate_Set : Generate_Set_Access; -- override grammar file 
declarations
+
+   Trace          : aliased WisiToken.Text_IO_Trace.Trace 
(Wisitoken_Grammar_Actions.Descriptor'Access);
+   Input_Data     : aliased WisiToken_Grammar_Runtime.User_Data_Type;
+   Grammar_Parser : WisiToken.Parse.LR.Parser_No_Recover.Parser;
+
+   Do_Time : Boolean := False;
+
+   procedure Use_Input_File (File_Name : in String)
+   is
+      use Ada.Strings.Unbounded;
+      use Ada.Text_IO;
+   begin
+      Output_File_Name_Root := +Ada.Directories.Base_Name (File_Name) & Suffix;
+
+      Wisitoken_Grammar_Main.Create_Parser
+        (Parser    => Grammar_Parser,
+         Trace     => Trace'Unchecked_Access,
+         User_Data => Input_Data'Unchecked_Access);
+
+      Grammar_Parser.Lexer.Reset_With_File (File_Name);
+
+      declare
+         Language_Name_Dir   : constant Integer := Ada.Strings.Fixed.Index
+           (File_Name, Ada.Strings.Maps.To_Set ("/\"), Going => 
Ada.Strings.Backward);
+         Language_Name_Ext   : constant Integer := Ada.Strings.Fixed.Index 
(File_Name, ".wy");
+      begin
+         Language_Name := +WisiToken.BNF.Output_Elisp_Common.Elisp_Name_To_Ada
+           (File_Name
+              ((if Language_Name_Dir = 0
+                then File_Name'First
+                else Language_Name_Dir + 1) ..
+                 Language_Name_Ext - 1),
+            Append_ID => False,
+            Trim      => 0);
+      end;
+   exception
+   when Name_Error | Use_Error =>
+      raise Name_Error with "input file '" & File_Name & "' could not be 
opened.";
+   end Use_Input_File;
+
+begin
+   declare
+      use Ada.Command_Line;
+      Arg_Next : Integer := 1;
+   begin
+      loop
+         exit when Argument (Arg_Next)(1) /= '-';
+
+         --   --help, -v first, then alphabetical
+
+         if Argument (Arg_Next) = "--help" then
+            Put_Usage;
+            return;
+
+         elsif Argument (Arg_Next) = "-v" then
+            Arg_Next  := Arg_Next + 1;
+            WisiToken.Trace_Generate := Integer'Value (Argument (Arg_Next));
+            Arg_Next  := Arg_Next + 1;
+
+         elsif Argument (Arg_Next) = "--generate" then
+            Arg_Next  := Arg_Next + 1;
+            declare
+               Tuple : Generate_Tuple;
+               Done  : Boolean := False;
+            begin
+               begin
+                  Tuple.Gen_Alg := Generate_Algorithm'Value (Argument 
(Arg_Next));
+                  Arg_Next     := Arg_Next + 1;
+               exception
+               when Constraint_Error =>
+                  raise User_Error with "invalid value for 
generator_algorithm: '" & Argument (Arg_Next) & ";";
+               end;
+               begin
+                  Tuple.Out_Lang := To_Output_Language (Argument (Arg_Next));
+                  Arg_Next       := Arg_Next + 1;
+               end;
+
+               loop
+                  exit when Done;
+                  declare
+                     Text : constant String := Argument (Arg_Next);
+                  begin
+                     if Text = "text_rep" then
+                        Tuple.Text_Rep := True;
+                        Arg_Next := Arg_Next + 1;
+
+                     elsif (for some I of Lexer_Image => To_Lower (Text) =  
I.all) then
+                        Tuple.Lexer := To_Lexer (Text);
+                        Arg_Next := Arg_Next + 1;
+
+                     elsif (for some I in Valid_Interface =>
+                              To_Lower (Text) = To_Lower 
(Valid_Interface'Image (I)))
+                     then
+                        Tuple.Interface_Kind := 
WisiToken.BNF.Valid_Interface'Value (Text);
+                        Arg_Next := Arg_Next + 1;
+
+                     else
+                        Done := True;
+                     end if;
+                  end;
+               end loop;
+
+               Add (Command_Generate_Set, Tuple);
+            end;
+
+         elsif Argument (Arg_Next) = "--suffix" then
+            Arg_Next := Arg_Next + 1;
+            Suffix   := +Argument (Arg_Next);
+            Arg_Next := Arg_Next + 1;
+
+         elsif Argument (Arg_Next) = "--test_main" then
+            Arg_Next  := Arg_Next + 1;
+            Test_Main := True;
+
+         elsif Argument (Arg_Next) = "--time" then
+            Arg_Next := Arg_Next + 1;
+            Do_Time  := True;
+
+         else
+            raise User_Error with "invalid argument '" & Argument (Arg_Next) & 
"'";
+         end if;
+      end loop;
+
+      Use_Input_File (Argument (Arg_Next));
+
+      if Arg_Next /= Argument_Count then
+         raise User_Error with "arg count" & Integer'Image (Argument_Count) &
+           " different from expected count" & Integer'Image (Arg_Next);
+      end if;
+   end;
+
+   begin
+      Grammar_Parser.Parse;
+   exception
+   when WisiToken.Syntax_Error =>
+      Grammar_Parser.Put_Errors;
+      raise;
+   when E : WisiToken.Parse_Error =>
+      WisiToken.Generate.Put_Error (Ada.Exceptions.Exception_Message (E));
+      raise;
+   end;
+
+   declare
+      use all type Ada.Strings.Unbounded.Unbounded_String;
+      use Ada.Text_IO;
+
+      --  Create a .parse_table file unless verbosity > 0
+      Parse_Table_File : File_Type;
+
+      Generate_Set    : Generate_Set_Access;
+      Multiple_Tuples : Boolean;
+
+      Lexer_Done : Lexer_Set := (others => False);
+
+      --  In general, all of the data in Generate_Utils.Generate_Data
+      --  depends on the generate tuple parameters. However, if
+      --  'If_Lexer_Present' is false, then they don't depend on the lexer,
+      --  and if 'If_Parser_Present' is false, then they don't depend on the
+      --  Gen_Alg, except for the parser table. But it's not worth trying to
+      --  cache results in those cases; they only happen in test grammars,
+      --  which are small.
+
+      procedure Parse_Check (Lexer : in Lexer_Type; Parser : in 
Generate_Algorithm)
+      is begin
+         Input_Data.User_Parser := Parser;
+         Input_Data.User_Lexer  := Lexer;
+         --  Specifying the parser and lexer can change the parsed grammar, due
+         --  to %if {parser | lexer}.
+
+         Input_Data.Reset;
+         Grammar_Parser.Execute_Actions;
+         --  Ensures Input_Data.User_{Parser|Lexer} are set if needed.
+
+         if Input_Data.Rule_Count = 0 or Input_Data.Tokens.Rules.Length = 0 
then
+            raise WisiToken.Grammar_Error with "no rules";
+         end if;
+
+      end Parse_Check;
+
+   begin
+      if Command_Generate_Set = null then
+         --  Get the first quad from the input file
+         Parse_Check (None, None);
+
+         if Input_Data.Generate_Set = null then
+            raise User_Error with
+              WisiToken.Generate.Error_Message
+                (Input_Data.Grammar_Lexer.File_Name, 1,
+                 "generate algorithm, output_language, lexer, interface not 
specified");
+         end if;
+
+         --  Input_Data.Generate_Set will be free'd and regenerated if
+         --  Parse_Check is called, but the content won't change. So make a
+         --  copy.
+         Generate_Set := new 
WisiToken.BNF.Generate_Set'(Input_Data.Generate_Set.all);
+      else
+         Generate_Set := Command_Generate_Set;
+      end if;
+
+      Multiple_Tuples := Generate_Set'Length > 1;
+
+      for Tuple of Generate_Set.all loop
+
+         Input_Data.User_Parser := Tuple.Gen_Alg;
+         Input_Data.User_Lexer  := Tuple.Lexer;
+
+         Parse_Check (Input_Data.User_Lexer, Input_Data.User_Parser);
+
+         declare
+            use Ada.Real_Time;
+
+            Time_Start : Time;
+            Time_End   : Time;
+
+            Generate_Data : aliased WisiToken.BNF.Generate_Utils.Generate_Data 
:=
+              WisiToken.BNF.Generate_Utils.Initialize (Input_Data);
+
+            Packrat_Data : WisiToken.Generate.Packrat.Data
+              (Generate_Data.Descriptor.First_Terminal, 
Generate_Data.Descriptor.First_Nonterminal,
+               Generate_Data.Descriptor.Last_Nonterminal);
+         begin
+            if not Lexer_Done (Input_Data.User_Lexer) then
+               Lexer_Done (Input_Data.User_Lexer) := True;
+               if Input_Data.User_Lexer = re2c_Lexer then
+                  WisiToken.BNF.Output_Ada_Common.Create_re2c
+                    (Input_Data, Tuple, Generate_Data, -Output_File_Name_Root, 
Input_Data.User_Names.Regexps);
+               end if;
+            end if;
+
+            if WisiToken.Trace_Generate = 0 and Tuple.Gen_Alg /= External then
+               Create
+                 (Parse_Table_File, Out_File,
+                  -Output_File_Name_Root & "_" & To_Lower 
(Generate_Algorithm'Image (Tuple.Gen_Alg)) &
+                    (if Input_Data.If_Lexer_Present
+                     then "_" & Lexer_Image (Input_Data.User_Lexer).all
+                     else "") &
+                    ".parse_table");
+               Set_Output (Parse_Table_File);
+            end if;
+
+            case Tuple.Gen_Alg is
+            when LALR =>
+
+               Time_Start := Clock;
+
+               Generate_Data.LR_Parse_Table := 
WisiToken.Generate.LR.LALR_Generate.Generate
+                 (Generate_Data.Grammar,
+                  Generate_Data.Descriptor.all,
+                  Generate_Utils.To_Conflicts
+                    (Generate_Data, Input_Data.Conflicts, 
Input_Data.Grammar_Lexer.File_Name),
+                  Generate_Utils.To_McKenzie_Param
+                    (Generate_Data, Input_Data.McKenzie_Recover, 
Input_Data.Grammar_Lexer.File_Name),
+                  Put_Parse_Table => True);
+
+               if Do_Time then
+                  Time_End := Clock;
+
+                  Put_Line
+                    (Standard_Error,
+                     "LALR " & Lexer_Image (Tuple.Lexer).all & " generate 
time:" &
+                       Duration'Image (To_Duration (Time_End - Time_Start)));
+               end if;
+
+               Generate_Data.Parser_State_Count :=
+                 Generate_Data.LR_Parse_Table.State_Last - 
Generate_Data.LR_Parse_Table.State_First + 1;
+               WisiToken.BNF.Generate_Utils.Count_Actions (Generate_Data);
+               WisiToken.BNF.Generate_Utils.Put_Stats (Input_Data, 
Generate_Data);
+
+            when LR1 =>
+               Time_Start := Clock;
+
+               Generate_Data.LR_Parse_Table := 
WisiToken.Generate.LR.LR1_Generate.Generate
+                 (Generate_Data.Grammar,
+                  Generate_Data.Descriptor.all,
+                  Generate_Utils.To_Conflicts
+                    (Generate_Data, Input_Data.Conflicts, 
Input_Data.Grammar_Lexer.File_Name),
+                  Generate_Utils.To_McKenzie_Param
+                    (Generate_Data, Input_Data.McKenzie_Recover, 
Input_Data.Grammar_Lexer.File_Name),
+                  Put_Parse_Table => True);
+
+               if Do_Time then
+                  Time_End := Clock;
+
+                  Put_Line
+                    (Standard_Error,
+                     "LR1 " & Lexer_Image (Tuple.Lexer).all & " generate 
time:" &
+                       Duration'Image (To_Duration (Time_End - Time_Start)));
+               end if;
+
+               Generate_Data.Parser_State_Count :=
+                 Generate_Data.LR_Parse_Table.State_Last - 
Generate_Data.LR_Parse_Table.State_First + 1;
+               WisiToken.BNF.Generate_Utils.Count_Actions (Generate_Data);
+               WisiToken.BNF.Generate_Utils.Put_Stats (Input_Data, 
Generate_Data);
+
+            when Packrat_Generate_Algorithm =>
+               --  The only significant computation done for Packrat is First, 
done
+               --  in Initialize; not worth timing.
+
+               Packrat_Data := WisiToken.Generate.Packrat.Initialize
+                 (Input_Data.Grammar_Lexer.File_Name, Generate_Data.Grammar, 
Generate_Data.Source_Line_Map,
+                  Generate_Data.Descriptor.First_Terminal);
+
+               Put_Line ("Tokens:");
+               WisiToken.Put_Tokens (Generate_Data.Descriptor.all);
+               New_Line;
+               Put_Line ("Productions:");
+               WisiToken.Productions.Put (Generate_Data.Grammar, 
Generate_Data.Descriptor.all);
+
+               Packrat_Data.Check_All (Generate_Data.Descriptor.all);
+
+            when External =>
+               null;
+            end case;
+
+            if WisiToken.Trace_Generate = 0 and Tuple.Gen_Alg /= External then
+               Set_Output (Standard_Output);
+               Close (Parse_Table_File);
+            end if;
+
+            if WisiToken.Generate.Error then
+               raise WisiToken.Grammar_Error with "errors: aborting";
+            end if;
+
+            case Tuple.Gen_Alg is
+            when LR_Generate_Algorithm =>
+               if Tuple.Text_Rep then
+                  WisiToken.Generate.LR.Put_Text_Rep
+                    (Generate_Data.LR_Parse_Table.all,
+                     -Output_File_Name_Root & "_" &
+                       To_Lower (Generate_Algorithm_Image (Tuple.Gen_Alg).all) 
&
+                       "_parse_table.txt",
+                    Generate_Data.Action_Names.all, 
Generate_Data.Check_Names.all);
+               end if;
+
+            when others =>
+               null;
+            end case;
+
+            case Tuple.Out_Lang is
+            when Ada_Lang =>
+               WisiToken.BNF.Output_Ada
+                 (Input_Data, -Output_File_Name_Root, Generate_Data, 
Packrat_Data, Tuple, Test_Main, Multiple_Tuples);
+
+            when Ada_Emacs_Lang =>
+               WisiToken.BNF.Output_Ada_Emacs
+                 (Input_Data, -Output_File_Name_Root, Generate_Data, 
Packrat_Data, Tuple, Test_Main, Multiple_Tuples,
+                  -Language_Name);
+
+            when Elisp_Lang =>
+               WisiToken.BNF.Output_Elisp (Input_Data, -Output_File_Name_Root, 
Generate_Data, Packrat_Data, Tuple);
+
+            end case;
+         end;
+      end loop;
+   end;
+exception
+when WisiToken.Syntax_Error | WisiToken.Parse_Error =>
+   --  error message already output
+   Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
+
+when E : User_Error =>
+   declare
+      use Ada.Command_Line;
+      use Ada.Exceptions;
+      use Ada.Text_IO;
+   begin
+      Put_Line (Standard_Error, Exception_Message (E));
+      Put_Command_Line (Ada_Comment);
+      Set_Exit_Status (Failure);
+      Put_Usage;
+   end;
+
+when E : WisiToken.Grammar_Error =>
+   --  error message not already output
+   declare
+      use Ada.Command_Line;
+      use Ada.Exceptions;
+      use Ada.Text_IO;
+   begin
+      Put_Line (Standard_Error, Exception_Message (E));
+      Set_Exit_Status (Failure);
+   end;
+
+when E :  others =>
+   --  IMPROVEME: for some exceptions, Error message already output via 
wisi.utils.Put_Error
+   declare
+      use Ada.Text_IO;
+      use Ada.Exceptions;
+      use Ada.Command_Line;
+   begin
+      Put_Line (Standard_Error, Exception_Name (E) & ": " & Exception_Message 
(E));
+      Put_Line (Standard_Error, GNAT.Traceback.Symbolic.Symbolic_Traceback 
(E));
+      Set_Exit_Status (Failure);
+   end;
+
+end WisiToken.BNF.Generate;
diff --git a/wisitoken-bnf-generate_grammar.adb 
b/wisitoken-bnf-generate_grammar.adb
new file mode 100644
index 0000000..03ef661
--- /dev/null
+++ b/wisitoken-bnf-generate_grammar.adb
@@ -0,0 +1,86 @@
+--  Abstract :
+--
+--  Output Ada source code to recreate Grammar.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Text_IO; use Ada.Text_IO;
+with WisiToken.Generate;
+with WisiToken.Productions;
+procedure WisiToken.BNF.Generate_Grammar
+  (Grammar      : in WisiToken.Productions.Prod_Arrays.Vector;
+   Action_Names : in WisiToken.Names_Array_Array)
+is
+   use all type Ada.Containers.Count_Type;
+   use Ada.Strings.Unbounded;
+   use WisiToken.Generate;
+   use WisiToken.Productions;
+   Text : Unbounded_String;
+   Need_Comma : Boolean := False;
+begin
+   Indent_Line ("Grammar.Set_First (" & Trimmed_Image (Grammar.First_Index) & 
");");
+   Indent_Line ("Grammar.Set_Last (" & Trimmed_Image (Grammar.Last_Index) & 
");");
+
+   for Prod of Grammar loop
+      Indent_Line ("declare");
+      Indent_Line ("   Prod : Instance;");
+      Indent_Line ("begin");
+      Indent := Indent + 3;
+      Indent_Line ("Prod.LHS := " & Trimmed_Image (Prod.LHS) & ";");
+      Indent_Line ("Prod.RHSs.Set_First (0);");
+      Indent_Line ("Prod.RHSs.Set_Last (" & Trimmed_Image 
(Prod.RHSs.Last_Index) & ");");
+      for RHS_Index in Prod.RHSs.First_Index .. Prod.RHSs.Last_Index loop
+         declare
+            RHS : Right_Hand_Side renames Prod.RHSs (RHS_Index);
+         begin
+            Indent_Line ("declare");
+            Indent_Line ("   RHS : Right_Hand_Side;");
+            Indent_Line ("begin");
+            Indent := Indent + 3;
+            if RHS.Tokens.Length > 0 then
+               Indent_Line ("RHS.Tokens.Set_First (1);");
+               Indent_Line ("RHS.Tokens.Set_Last (" & Trimmed_Image (Prod.RHSs 
(RHS_Index).Tokens.Last_Index) & ");");
+
+               if RHS.Tokens.Length = 1 then
+                  Indent_Line ("To_Vector ((1 => " & Trimmed_Image (RHS.Tokens 
(1)) & "), RHS.Tokens);");
+               else
+                  Need_Comma := False;
+                  Text := +"To_Vector ((";
+                  for ID of RHS.Tokens  loop
+                     if Need_Comma then
+                        Text := Text & ", ";
+                     else
+                        Need_Comma := True;
+                     end if;
+                     Text := Text & Trimmed_Image (ID);
+                  end loop;
+                  Text := Text & "), RHS.Tokens);";
+                  Indent_Wrap (-Text);
+               end if;
+            end if;
+            if Action_Names (Prod.LHS) /= null and then Action_Names 
(Prod.LHS)(RHS_Index) /= null then
+               Indent_Line ("RHS.Action     := " & Action_Names 
(Prod.LHS)(RHS_Index).all & "'Access;");
+            end if;
+            Indent_Line ("Prod.RHSs (" & Trimmed_Image (RHS_Index) & ") := 
RHS;");
+            Indent := Indent - 3;
+            Indent_Line ("end;");
+         end;
+      end loop;
+      Indent_Line ("Grammar (" & Trimmed_Image (Prod.LHS) & ") := Prod;");
+      Indent := Indent - 3;
+      Indent_Line ("end;");
+   end loop;
+end WisiToken.BNF.Generate_Grammar;
diff --git a/wisitoken-bnf-generate_packrat.adb 
b/wisitoken-bnf-generate_packrat.adb
new file mode 100644
index 0000000..ee43b16
--- /dev/null
+++ b/wisitoken-bnf-generate_packrat.adb
@@ -0,0 +1,331 @@
+--  Abstract :
+--
+--  Generate Ada code for a Packrat parser.
+--
+--  References:
+--
+--  See wisitoken-parse-packrat.ads.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Text_IO; use Ada.Text_IO;
+with WisiToken.BNF.Generate_Utils;
+with WisiToken.Generate.Packrat;
+with WisiToken.Productions;
+procedure WisiToken.BNF.Generate_Packrat
+  (Data          : in WisiToken.Generate.Packrat.Data;
+   Generate_Data : in WisiToken.BNF.Generate_Utils.Generate_Data)
+is
+   use WisiToken.Generate;
+
+   Descriptor   : WisiToken.Descriptor renames Generate_Data.Descriptor.all;
+   Action_Names : Names_Array_Array renames Generate_Data.Action_Names.all;
+
+   subtype Terminal is Token_ID range Descriptor.First_Terminal .. 
Descriptor.Last_Terminal;
+
+   --  FIXME: optimize memoizing? small productions not worth the memory cost?
+   --  or just use langkit space optimization.
+
+   function Parser_Name (Nonterm : in Token_ID) return String
+   is begin
+      return "Parse_" & Image (Nonterm, Descriptor);
+   end Parser_Name;
+
+   procedure Put_Parser_Spec (Name : in String)
+   is begin
+      Indent_Line ("function " & Name);
+      Indent_Start ("  (Parser : in out Generated.Parser; Last_Pos : in 
Base_Token_Index) return Result_Type");
+   end Put_Parser_Spec;
+
+   function Var_Suffix (I, J : in Integer) return String
+   is begin
+      return Trimmed_Image (I) & '_' & Trimmed_Image (J);
+   end Var_Suffix;
+
+   procedure Generate_Parser_Body (Prod : in Productions.Instance)
+   is
+      use all type Ada.Containers.Count_Type;
+
+      Result_ID : constant String := Trimmed_Image (Prod.LHS);
+   begin
+      --  We use gotos and function scope vars rather than nested if/declare
+      --  to avoid excessive indenting for long productions.
+
+      Put_Parser_Spec (Parser_Name (Prod.LHS)); New_Line;
+      Indent_Line ("is");
+      Indent := Indent + 3;
+
+      Indent_Line ("Descriptor : WisiToken.Descriptor renames 
Parser.Trace.Descriptor.all;");
+      Indent_Line ("Start_Pos  : constant Token_Index := Last_Pos + 1; --  
first token in current nonterm");
+      Indent_Line ("Pos        : Base_Token_Index := Last_Pos; --  last token 
parsed.");
+
+      for RHS_Index in Prod.RHSs.First_Index .. Prod.RHSs.Last_Index loop
+         declare
+            RHS : Productions.Right_Hand_Side renames Prod.RHSs (RHS_Index);
+         begin
+            for Token_Index in RHS.Tokens.First_Index .. RHS.Tokens.Last_Index 
loop
+               if RHS.Tokens (Token_Index) in Descriptor.First_Terminal .. 
Descriptor.Last_Terminal then
+                  Indent_Line ("Pos_" & Var_Suffix (RHS_Index, Token_Index) & 
"  : Token_Index;");
+               else
+                  Indent_Line ("Memo_" & Var_Suffix (RHS_Index, Token_Index) & 
" : Memo_Entry;");
+               end if;
+            end loop;
+         end;
+      end loop;
+
+      if Data.Direct_Left_Recursive (Prod.LHS) then
+         Indent_Line ("Pos_Recurse_Last : Base_Token_Index := Last_Pos;");
+         Indent_Line ("Result_Recurse   : Memo_Entry;");
+      end if;
+
+      Indent := Indent - 3;
+      Indent_Line ("begin");
+      Indent := Indent + 3;
+
+      Indent_Line ("if Pos = Parser.Terminals.Last_Index then");
+      Indent_Line ("   return (State => Failure);");
+      Indent_Line ("end if;");
+      Indent_Line ("declare");
+      Indent_Line ("   Memo : Memo_Entry renames Parser.Derivs (" & Result_ID 
& ")(Start_Pos);");
+      Indent_Line ("begin");
+      Indent := Indent + 3;
+      Indent_Line ("case Memo.State is");
+      Indent_Line ("when Success =>");
+      Indent_Line ("   return Parser.Derivs (" & Result_ID & ")(Start_Pos);");
+      Indent_Line ("when Failure =>");
+
+      --  FIXME: Could simplify this when not doing left recursion
+      Indent_Line ("   goto RHS_" & Trimmed_Image (Prod.RHSs.Last_Index) & 
"_Fail;");
+
+      Indent_Line ("when No_Result =>");
+      Indent_Line ("   if Memo.Recursive then");
+      Indent_Start ("      raise Recursive with Image (" & Result_ID & ", 
Descriptor) &");
+      Put_Line (" Token_Index'Image (Start_Pos) & "": recursive"";");
+      Indent_Line ("   end if;");
+      Indent_Line ("   Memo.Recursive := True;");
+      Indent_Line ("end case;");
+      Indent := Indent - 3;
+      Indent_Line ("end;");
+      New_Line;
+
+      if Data.Direct_Left_Recursive (Prod.LHS) then
+         --  This is the top of the 'while' loop in [warth 2008] figure 3 
Grow-LR.
+         Indent_Line ("Parser.Derivs (" & Result_ID & ").Replace_Element 
(Start_Pos, (State => Failure));");
+         Indent_Line ("<<Recurse_Start>>");
+      end if;
+
+      for RHS_Index in Prod.RHSs.First_Index .. Prod.RHSs.Last_Index loop
+         declare
+            RHS : Productions.Right_Hand_Side renames Prod.RHSs (RHS_Index);
+
+            procedure Finish
+            is begin
+               if Data.Direct_Left_Recursive (Prod.LHS) then
+                  Indent_Line ("Result_Recurse :=");
+                  Indent := Indent + 2;
+               else
+                  Indent_Line ("Parser.Derivs (" & Result_ID & 
").Replace_Element");
+                  Indent_Line ("  (Start_Pos,");
+                  Indent := Indent + 3;
+               end if;
+               Indent_Line ("(State              => Success,");
+               Indent_Line (" Result             => Parser.Tree.Add_Nonterm");
+
+               Indent := Indent + 3;
+               Indent_Line ("(Production      => (" & Result_ID & ", " & 
Trimmed_Image (RHS_Index) & "),");
+               Indent_Line
+                 (" Action          => " &
+                    (if Action_Names (Prod.LHS) = null or else Action_Names 
(Prod.LHS)(RHS_Index) = null
+                     then "null,"
+                     else Action_Names (Prod.LHS)(RHS_Index).all & 
"'Access,"));
+
+               if RHS.Tokens.Length = 0 then
+                  Indent_Line (" Children        => (1 .. 0 => 
Syntax_Trees.Invalid_Node_Index),");
+
+               elsif RHS.Tokens.Length = 1 then
+                  Indent_Start (" Children        => ");
+                  if RHS.Tokens (RHS.Tokens.First_Index) in Terminal then
+                     Put ("(1 => Tree_Index (Pos_" & Var_Suffix (RHS_Index, 
RHS.Tokens.First_Index) & ")),");
+                  else
+                     Put ("(1 => Memo_" & Var_Suffix (RHS_Index, 
RHS.Tokens.First_Index) & ".Result),");
+                  end if;
+
+               else
+                  Indent_Line (" Children        =>");
+
+                  for Token_Index in RHS.Tokens.First_Index .. 
RHS.Tokens.Last_Index loop
+                     if RHS.Tokens (Token_Index) in Terminal then
+                        Indent_Start
+                          ((if Token_Index = RHS.Tokens.First_Index
+                            then "  ("
+                            else "   ") &
+                             "Tree_Index (Pos_" & Var_Suffix (RHS_Index, 
Token_Index) & ")");
+                     else
+                        Indent_Start
+                          ((if Token_Index = RHS.Tokens.First_Index
+                            then "  ("
+                            else "   ") &
+                             "Memo_" & Var_Suffix (RHS_Index, Token_Index) & 
".Result");
+                     end if;
+                     if Token_Index = RHS.Tokens.Last_Index then
+                        Put_Line ("),");
+                     else
+                        Put_Line (",");
+                     end if;
+                  end loop;
+               end if;
+
+               Indent_Line (" Default_Virtual => False),");
+               Indent := Indent - 3;
+               Indent_Start (" Last_Token      => Pos)");
+
+               if Data.Direct_Left_Recursive (Prod.LHS) then
+                  Put_Line (";");
+                  Indent := Indent - 2;
+                  Indent_Line ("goto Finish;");
+               else
+                  Put_Line (");");
+                  Indent := Indent - 3;
+                  Indent_Line ("goto Succeed;");
+               end if;
+            end Finish;
+
+         begin
+            Indent_Wrap_Comment (Productions.Image (Prod.LHS, RHS_Index, 
RHS.Tokens, Descriptor), Ada_Comment);
+            Indent_Line ("Pos := Last_Pos;");
+
+            if RHS.Tokens.Length = 0 then
+               Finish;
+            else
+               for Token_Index in RHS.Tokens.First_Index .. 
RHS.Tokens.Last_Index loop
+                  declare
+                     ID      : constant String := Trimmed_Image (RHS.Tokens 
(Token_Index));
+                     Var_Suf : constant String := Var_Suffix (RHS_Index, 
Token_Index);
+                  begin
+                     if RHS.Tokens (Token_Index) in Terminal then
+                        Indent_Line ("if Parser.Terminals (Pos + 1).ID = " & 
ID & " then");
+                        Indent := Indent + 3;
+                        Indent_Line ("Pos := Pos + 1;");
+                        Indent_Line ("Pos_" & Var_Suf & " := Pos;");
+                        if Token_Index = RHS.Tokens.Last_Index then
+                           Finish;
+                        end if;
+                        Indent := Indent - 3;
+                        Indent_Line ("else");
+                        Indent_Line ("   goto RHS_" & Trimmed_Image 
(RHS_Index) & "_Fail;");
+                        Indent_Line ("end if;");
+
+                     else -- nonterminal
+                        Indent_Line
+                          ("Memo_" & Var_Suf & " := Parse_" & Image 
(RHS.Tokens (Token_Index), Descriptor) &
+                             " (Parser, Pos);");
+                        Indent_Line ("case Result_States'(Memo_" & Var_Suf & 
".State) is");
+                        Indent_Line ("when Success =>");
+                        Indent := Indent + 3;
+                        Indent_Line ("Pos := Memo_" & Var_Suf & 
".Last_Token;");
+                        if Token_Index = RHS.Tokens.Last_Index then
+                           Finish;
+                        end if;
+                        Indent := Indent - 3;
+                        Indent_Line ("when Failure =>");
+                        Indent_Line ("   goto RHS_" & Trimmed_Image 
(RHS_Index) & "_Fail;");
+                        Indent_Line ("end case;");
+                     end if;
+                  end;
+               end loop;
+            end if;
+
+            Indent_Line ("<<RHS_" & Trimmed_Image (RHS_Index) & "_Fail>>");
+            New_Line;
+         end;
+      end loop;
+
+      --  We get here if the last alternative fails.
+      if Data.Direct_Left_Recursive (Prod.LHS) then
+         Indent_Line ("Result_Recurse := (State => Failure);");
+      else
+         Indent_Line ("Parser.Derivs (" & Result_ID & ").Replace_Element 
(Start_Pos, (State => Failure));");
+         Indent_Line ("return Parser.Derivs (" & Result_ID & ")(Start_Pos);");
+      end if;
+
+      if Data.Direct_Left_Recursive (Prod.LHS) then
+         Indent_Line ("<<Finish>>");
+         Indent_Line ("if Result_Recurse.State = Success then");
+         Indent := Indent + 3;
+         Indent_Line ("if Pos > Pos_Recurse_Last then");
+         --  made progress, try again
+         Indent := Indent + 3;
+         Indent_Line ("Parser.Derivs (" & Result_ID & ").Replace_Element 
(Start_Pos, Result_Recurse);");
+         Indent_Line ("Pos_Recurse_Last := Pos;");
+         Indent_Line ("if WisiToken.Trace_Parse > Detail then");
+         Indent_Line ("   Parser.Trace.Put_Line");
+         Indent_Line
+           ("     (Parser.Tree.Image (Result_Recurse.Result, Descriptor, 
Include_Children => True));");
+         Indent_Line ("end if;");
+         Indent_Line ("goto Recurse_Start;");
+         Indent := Indent - 3;
+         Indent_Line ("elsif Pos = Pos_Recurse_Last and then 
Parser.Tree.Is_Empty (Result_Recurse.Result) then");
+         --  Parse succeeded producing an empty nonterm; don't try again. This
+         --  special case is not in [warth 2008].
+         Indent_Line ("   Parser.Derivs (8).Replace_Element (Start_Pos, 
Result_Recurse);");
+         Indent_Line ("end if;");
+         Indent := Indent - 3;
+         Indent_Line ("end if;");
+      end if;
+      New_Line;
+
+      if not Data.Direct_Left_Recursive (Prod.LHS) then
+         Indent_Line ("<<Succeed>>");
+         Indent_Line ("if WisiToken.Trace_Parse > Detail then");
+         Indent := Indent + 3;
+         Indent_Line ("Parser.Trace.Put_Line");
+         Indent_Line ("  (Parser.Tree.Image");
+         Indent_Line
+           ("    (Parser.Derivs (" & Result_ID & ")(Start_Pos).Result, 
Descriptor, Include_Children => True));");
+         Indent := Indent - 3;
+         Indent_Line ("end if;");
+      end if;
+
+      Indent_Line ("return Parser.Derivs (" & Result_ID & ")(Start_Pos);");
+      Indent := Indent - 3;
+      Indent_Line ("end " & Parser_Name (Prod.LHS) & ";");
+      New_Line;
+   end Generate_Parser_Body;
+
+begin
+   Indent_Line ("use WisiToken;");
+   Indent_Line ("use WisiToken.Parse.Packrat;");
+   Indent_Line ("use WisiToken.Parse.Packrat.Generated;");
+
+   for Prod of Data.Grammar loop
+      Put_Parser_Spec (Parser_Name (Prod.LHS)); Put_Line (";");
+   end loop;
+   New_Line;
+
+   for Prod of Data.Grammar loop
+      Generate_Parser_Body (Prod);
+   end loop;
+
+   Indent_Line ("function Parse_wisitoken_accept_1");
+   Indent_Line
+     --  WORKAROUND: using Parse.Packrat.Parser'Class here generates GNAT bug 
box with GPL 2018
+     ("  (Parser : in out WisiToken.Parse.Base_Parser'Class; Last_Pos : in 
Base_Token_Index) return Result_Type");
+   Indent_Line ("is begin");
+   Indent_Line ("   return Parse_wisitoken_accept (Generated.Parser (Parser), 
Last_Pos);");
+   Indent_Line ("end Parse_wisitoken_accept_1;");
+   New_Line;
+
+end WisiToken.BNF.Generate_Packrat;
diff --git a/wisitoken-bnf-generate_utils.adb b/wisitoken-bnf-generate_utils.adb
new file mode 100644
index 0000000..01bc419
--- /dev/null
+++ b/wisitoken-bnf-generate_utils.adb
@@ -0,0 +1,818 @@
+--  Abstract :
+--
+--  see spec
+--
+--  Copyright (C) 2014, 2015, 2017, 2018  All Rights Reserved.
+--
+--  This program is free software; you can redistribute it and/or
+--  modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or (at
+--  your option) any later version. This program 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
+--  distributed with this program; see file COPYING. If not, write to
+--  the Free Software Foundation, 51 Franklin Street, Suite 500, Boston,
+--  MA 02110-1335, USA.
+
+pragma License (GPL);
+
+with Ada.Exceptions;
+with Ada.Text_IO;
+with WisiToken.Generate; use WisiToken.Generate;
+with WisiToken.Syntax_Trees;
+with WisiToken.Wisi_Ada;
+package body WisiToken.BNF.Generate_Utils is
+
+   --  For Constant_Reference
+   Aliased_EOI_Name              : aliased constant 
Ada.Strings.Unbounded.Unbounded_String := +EOI_Name;
+   Aliased_WisiToken_Accept_Name : aliased constant 
Ada.Strings.Unbounded.Unbounded_String :=
+     +WisiToken_Accept_Name;
+
+   --  body specs, as needed.
+
+   ----------
+   --  Body subprograms
+
+   function Find_Kind (Data : aliased Generate_Data; Target_Kind : in String) 
return Token_ID
+   is begin
+      for Cursor in All_Tokens (Data).Iterate loop
+         if Kind (Cursor) = Target_Kind then
+            return ID (Cursor);
+         end if;
+      end loop;
+      return Invalid_Token_ID;
+   end Find_Kind;
+
+   function Name_1 (Cursor : in Token_Cursor) return String
+   is begin
+      --   This function is used to compute LR1_descriptor.Image
+      case Cursor.Kind is
+      when Non_Grammar_Kind =>
+         declare
+            Kind_Ref : constant 
WisiToken.BNF.Token_Lists.Constant_Reference_Type :=
+              WisiToken.BNF.Token_Lists.Constant_Reference 
(Cursor.Data.Tokens.Non_Grammar, Cursor.Token_Kind);
+
+            Item_Ref : constant String_Pair_Lists.Constant_Reference_Type :=
+              String_Pair_Lists.Constant_Reference (Kind_Ref.Element.Tokens, 
Cursor.Token_Item);
+         begin
+            return -Item_Ref.Element.Name;
+         end;
+
+      when Terminals_Keywords =>
+         declare
+            Keyword_Ref : constant String_Pair_Lists.Constant_Reference_Type :=
+              String_Pair_Lists.Constant_Reference 
(Cursor.Data.Tokens.Keywords, Cursor.Keyword);
+         begin
+            return -Keyword_Ref.Element.Name;
+         end;
+
+      when Terminals_Others =>
+         declare
+            Kind_Ref : constant 
WisiToken.BNF.Token_Lists.Constant_Reference_Type :=
+              WisiToken.BNF.Token_Lists.Constant_Reference 
(Cursor.Data.Tokens.Tokens, Cursor.Token_Kind);
+
+            Item_Ref : constant String_Pair_Lists.Constant_Reference_Type :=
+              String_Pair_Lists.Constant_Reference (Kind_Ref.Element.Tokens, 
Cursor.Token_Item);
+         begin
+            return -Item_Ref.Element.Name;
+         end;
+
+      when EOI =>
+         return EOI_Name;
+
+      when WisiToken_Accept =>
+         return WisiToken_Accept_Name;
+
+      when Nonterminal =>
+         declare
+            Rule_Ref : constant Rule_Lists.Constant_Reference_Type := 
Rule_Lists.Constant_Reference
+              (Cursor.Data.Tokens.Rules, Cursor.Nonterminal);
+         begin
+            return -Rule_Ref.Element.Left_Hand_Side;
+         end;
+
+      when Done =>
+         raise SAL.Programmer_Error with "token cursor is done";
+      end case;
+   end Name_1;
+
+   procedure To_Grammar
+     (Data             : aliased in out Generate_Data;
+      Source_File_Name :         in     String;
+      Start_Token      :         in     String)
+   is
+      use WisiToken.Wisi_Ada;
+      Descriptor : WisiToken.Descriptor renames Data.Descriptor.all;
+   begin
+      Data.Grammar.Set_First (Descriptor.First_Nonterminal);
+      Data.Grammar.Set_Last (Descriptor.Last_Nonterminal);
+      Data.Source_Line_Map.Set_First (Descriptor.First_Nonterminal);
+      Data.Source_Line_Map.Set_Last (Descriptor.Last_Nonterminal);
+
+      Data.Action_Names := new Names_Array_Array (Descriptor.First_Nonterminal 
.. Descriptor.Last_Nonterminal);
+      Data.Check_Names  := new Names_Array_Array (Descriptor.First_Nonterminal 
.. Descriptor.Last_Nonterminal);
+
+      pragma Assert (Descriptor.Accept_ID = Descriptor.First_Nonterminal);
+      begin
+         Data.Grammar (Descriptor.Accept_ID) :=
+           Descriptor.Accept_ID <= Only
+             (Find_Token_ID (Data, Start_Token) & Descriptor.EOF_ID + 
WisiToken.Syntax_Trees.Null_Action);
+
+         Data.Source_Line_Map (Descriptor.Accept_ID).Line := 
Line_Number_Type'First;
+         Data.Source_Line_Map (Descriptor.Accept_ID).RHS_Map.Set_First (0);
+         Data.Source_Line_Map (Descriptor.Accept_ID).RHS_Map.Set_Last (0);
+         Data.Source_Line_Map (Descriptor.Accept_ID).RHS_Map (0) := 
Line_Number_Type'First;
+      exception
+      when Not_Found =>
+         Put_Error
+           (Error_Message
+              (Source_File_Name, 1, "start token '" & (Start_Token) & "' not 
found; need %start?"));
+      end;
+
+      for Rule of Data.Tokens.Rules loop
+         declare
+            RHS_Index        : Natural := 0;
+            RHSs             : WisiToken.Productions.RHS_Arrays.Vector;
+            LHS              : Token_ID; -- not initialized for exception 
handler
+            Action_Names     : Names_Array (0 .. Integer 
(Rule.Right_Hand_Sides.Length) - 1);
+            Action_All_Empty : Boolean := True;
+            Check_Names     : Names_Array (0 .. Integer 
(Rule.Right_Hand_Sides.Length) - 1);
+            Check_All_Empty : Boolean := True;
+         begin
+            LHS := Find_Token_ID (Data, -Rule.Left_Hand_Side);
+
+            RHSs.Set_First (RHS_Index);
+            RHSs.Set_Last (Natural (Rule.Right_Hand_Sides.Length) - 1);
+
+            Data.Source_Line_Map (LHS).Line := Rule.Source_Line;
+            Data.Source_Line_Map (LHS).RHS_Map.Set_First (RHSs.First_Index);
+            Data.Source_Line_Map (LHS).RHS_Map.Set_Last (RHSs.Last_Index);
+
+            for Right_Hand_Side of Rule.Right_Hand_Sides loop
+               declare
+                  use Ada.Strings.Unbounded;
+                  use all type Ada.Containers.Count_Type;
+                  Tokens : WisiToken.Token_ID_Arrays.Vector;
+                  I      : Integer := 1;
+               begin
+                  if Right_Hand_Side.Tokens.Length > 0 then
+                     Tokens.Set_First (I);
+                     Tokens.Set_Last (Integer (Right_Hand_Side.Tokens.Length));
+                     for Token of Right_Hand_Side.Tokens loop
+                        Tokens (I) := Find_Token_ID (Data, Token);
+                        I := I + 1;
+                     end loop;
+                  end if;
+                  RHSs (RHS_Index) := (Tokens => Tokens, Action => null, Check 
=> null);
+                  if Length (Right_Hand_Side.Action) > 0 then
+                     Action_All_Empty := False;
+                     Action_Names (RHS_Index) := new String'
+                       (-Rule.Left_Hand_Side & '_' & WisiToken.Trimmed_Image 
(RHS_Index));
+                  end if;
+                  if Length (Right_Hand_Side.Check) > 0 then
+                     Check_All_Empty := False;
+                     Check_Names (RHS_Index) := new String'
+                       (-Rule.Left_Hand_Side & '_' & WisiToken.Trimmed_Image 
(RHS_Index) & "_check");
+                  end if;
+
+                  Data.Source_Line_Map (LHS).RHS_Map (RHS_Index) := 
Right_Hand_Side.Source_Line;
+               exception
+               when E : Not_Found =>
+                  --  From "&"
+                  Put_Error
+                    (Error_Message
+                       (Source_File_Name, Right_Hand_Side.Source_Line, 
Ada.Exceptions.Exception_Message (E)));
+               end;
+               RHS_Index := RHS_Index + 1;
+            end loop;
+
+            Data.Grammar (LHS) := LHS <= RHSs;
+            if not Action_All_Empty then
+               Data.Action_Names (LHS) := new Names_Array'(Action_Names);
+            end if;
+            if not Check_All_Empty then
+               Data.Check_Names (LHS) := new Names_Array'(Check_Names);
+            end if;
+
+         exception
+         when E : Not_Found =>
+            --  From Find_Token_ID (left_hand_side)
+            Put_Error
+              (Error_Message
+                 (Source_File_Name, Rule.Source_Line, 
Ada.Exceptions.Exception_Message (E)));
+         end;
+      end loop;
+
+      WisiToken.Generate.Check_Consistent (Data.Grammar, Descriptor, 
Source_File_Name);
+   end To_Grammar;
+
+   ----------
+   --  Public subprograms, declaration order
+
+   function Initialize (Input_Data : aliased in 
WisiToken_Grammar_Runtime.User_Data_Type) return Generate_Data
+   is
+      EOF_ID : constant Token_ID := Token_ID
+        (Count (Input_Data.Tokens.Non_Grammar) + Count 
(Input_Data.Tokens.Tokens)) + Token_ID
+          (Input_Data.Tokens.Keywords.Length) + Token_ID'First;
+   begin
+      return Result : aliased Generate_Data :=
+        (Tokens => Input_Data.Tokens'Access,
+
+         Descriptor => new WisiToken.Descriptor
+           (First_Terminal    =>
+              (if Count (Input_Data.Tokens.Non_Grammar) > 0
+               then Token_ID (Count (Input_Data.Tokens.Non_Grammar)) + 
Token_ID'First
+               else Token_ID'First),
+            Last_Terminal     => EOF_ID,
+            EOF_ID            => EOF_ID,
+            Accept_ID         => EOF_ID + 1,
+            First_Nonterminal => EOF_ID + 1,
+            Last_Nonterminal  => EOF_ID + 1 + Token_ID 
(Input_Data.Tokens.Rules.Length)),
+
+         others => <>)
+      do
+         Result.Descriptor.Case_Insensitive := 
Input_Data.Language_Params.Case_Insensitive;
+         Result.Descriptor.New_Line_ID      := Find_Kind (Result, "new-line");
+         Result.Descriptor.Comment_ID       := Find_Kind (Result, "comment");
+         Result.Descriptor.Left_Paren_ID    := Find_Kind (Result, 
"left-paren");
+         Result.Descriptor.Right_Paren_ID   := Find_Kind (Result, 
"right-paren");
+         Result.Descriptor.String_1_ID      := Find_Kind (Result, 
"string-single");
+         Result.Descriptor.String_2_ID      := Find_Kind (Result, 
"string-double");
+
+         Result.Descriptor.Embedded_Quote_Escape_Doubled := 
Input_Data.Language_Params.Embedded_Quote_Escape_Doubled;
+
+         --  Image set in loop below, which also updates these widths.
+         Result.Descriptor.Terminal_Image_Width := 0;
+         Result.Descriptor.Image_Width          := 0;
+
+         Result.Descriptor.Last_Lookahead       :=
+           (case (Input_Data.User_Parser) is
+            when None                                  => raise 
SAL.Programmer_Error,
+            when LR1                                   => 
Result.Descriptor.Last_Terminal,
+            when LALR                                  => 
Result.Descriptor.First_Nonterminal,
+            when Packrat_Generate_Algorithm | External => Invalid_Token_ID);
+
+         for Cursor in All_Tokens (Result).Iterate loop
+            Result.Descriptor.Image (ID (Cursor)) := new String'(Name_1 
(Cursor));
+         end loop;
+
+         for ID in Result.Descriptor.Image'Range loop
+            if ID in Result.Descriptor.First_Terminal .. 
Result.Descriptor.Last_Terminal then
+               if Result.Descriptor.Image (ID).all'Length > 
Result.Descriptor.Terminal_Image_Width then
+                  Result.Descriptor.Terminal_Image_Width := 
Result.Descriptor.Image (ID).all'Length;
+               end if;
+            end if;
+
+            if Result.Descriptor.Image (ID).all'Length > 
Result.Descriptor.Image_Width then
+               Result.Descriptor.Image_Width := Result.Descriptor.Image 
(ID).all'Length;
+            end if;
+         end loop;
+
+         To_Grammar (Result, Input_Data.Grammar_Lexer.File_Name, 
-Input_Data.Language_Params.Start_Token);
+      end return;
+   end Initialize;
+
+   function Find_Token_ID (Data : aliased in Generate_Data; Token : in String) 
return Token_ID
+   is begin
+      for Cursor in All_Tokens (Data).Iterate loop
+         if Name (Cursor) = Token then
+            return ID (Cursor);
+         end if;
+      end loop;
+      raise Not_Found with "token '" & Token & "' not found";
+   end Find_Token_ID;
+
+   function All_Tokens (Data : aliased in Generate_Data) return Token_Container
+   is begin
+      return (Data => Data'Access);
+   end All_Tokens;
+
+   function Constant_Reference
+     (Container : aliased in Token_Container'Class;
+      Cursor    :         in Token_Cursor)
+     return Token_Constant_Reference_Type
+   is begin
+      case Cursor.Kind is
+      when Non_Grammar_Kind =>
+         declare
+            Token_Ref : constant 
WisiToken.BNF.Token_Lists.Constant_Reference_Type :=
+              WisiToken.BNF.Token_Lists.Constant_Reference 
(Container.Data.Tokens.Non_Grammar, Cursor.Token_Kind);
+
+            Item_Ref : constant String_Pair_Lists.Constant_Reference_Type :=
+              String_Pair_Lists.Constant_Reference (Token_Ref.Element.Tokens, 
Cursor.Token_Item);
+         begin
+            return (Element => Item_Ref.Element.all.Name'Access);
+         end;
+
+      when Terminals_Keywords =>
+         declare
+            Keyword_Ref : constant String_Pair_Lists.Constant_Reference_Type :=
+              String_Pair_Lists.Constant_Reference 
(Container.Data.Tokens.Keywords, Cursor.Keyword);
+         begin
+            return (Element => Keyword_Ref.Element.all.Name'Access);
+         end;
+
+      when Terminals_Others =>
+         declare
+            Token_Ref : constant 
WisiToken.BNF.Token_Lists.Constant_Reference_Type :=
+              WisiToken.BNF.Token_Lists.Constant_Reference 
(Container.Data.Tokens.Tokens, Cursor.Token_Kind);
+
+            Item_Ref : constant String_Pair_Lists.Constant_Reference_Type :=
+              String_Pair_Lists.Constant_Reference (Token_Ref.Element.Tokens, 
Cursor.Token_Item);
+         begin
+            return (Element => Item_Ref.Element.all.Name'Access);
+         end;
+
+      when EOI =>
+         return (Element => Aliased_EOI_Name'Access);
+
+      when WisiToken_Accept =>
+         return (Element => Aliased_WisiToken_Accept_Name'Access);
+
+      when Nonterminal =>
+         declare
+            Rule_Ref : constant Rule_Lists.Constant_Reference_Type := 
Rule_Lists.Constant_Reference
+              (Container.Data.Tokens.Rules, Cursor.Nonterminal);
+         begin
+            return (Element => Rule_Ref.Element.all.Left_Hand_Side'Access);
+         end;
+
+      when Done =>
+         raise SAL.Programmer_Error with "token cursor is done";
+      end case;
+   end Constant_Reference;
+
+   type Token_Access_Constant is access constant Token_Container;
+   type Iterator is new Iterator_Interfaces.Forward_Iterator with record
+      Container    : Token_Access_Constant;
+      Non_Grammar  : Boolean;
+      Nonterminals : Boolean;
+   end record;
+
+   overriding function First (Object : Iterator) return Token_Cursor;
+   overriding function Next (Object : Iterator; Position : Token_Cursor) 
return Token_Cursor;
+
+   overriding function First (Object : Iterator) return Token_Cursor
+   is begin
+      return First (Object.Container.Data.all, Object.Non_Grammar, 
Object.Nonterminals);
+   end First;
+
+   overriding function Next (Object  : Iterator; Position : Token_Cursor) 
return Token_Cursor
+   is
+      Next_Position : Token_Cursor := Position;
+   begin
+      Next (Next_Position, Object.Nonterminals);
+      return Next_Position;
+   end Next;
+
+   function Iterate
+     (Container    : aliased    Token_Container;
+      Non_Grammar  :         in Boolean := True;
+      Nonterminals :         in Boolean := True)
+     return Iterator_Interfaces.Forward_Iterator'Class
+   is begin
+      return Iterator'(Container'Access, Non_Grammar, Nonterminals);
+   end Iterate;
+
+   function Next_Kind_Internal
+     (Cursor       : in out Token_Cursor;
+      Nonterminals : in     Boolean)
+     return Boolean
+   is begin
+      --  Advance Cursor to the next kind; return True if any of that
+      --  kind exist, or kind is Done; False otherwise.
+      case Cursor.Kind is
+      when Non_Grammar_Kind =>
+
+         Cursor :=
+           (Data        => Cursor.Data,
+            Kind        => Terminals_Keywords,
+            ID          => Cursor.Data.Descriptor.First_Terminal,
+            Token_Kind  => WisiToken.BNF.Token_Lists.No_Element,
+            Token_Item  => String_Pair_Lists.No_Element,
+            Keyword     => Cursor.Data.Tokens.Keywords.First,
+            Nonterminal => Rule_Lists.No_Element);
+
+         return String_Pair_Lists.Has_Element (Cursor.Keyword);
+
+      when Terminals_Keywords =>
+
+         Cursor :=
+           (Data        => Cursor.Data,
+            Kind        => Terminals_Others,
+            ID          => Cursor.ID,
+            Token_Kind  => Cursor.Data.Tokens.Tokens.First,
+            Token_Item  => String_Pair_Lists.No_Element,
+            Keyword     => String_Pair_Lists.No_Element,
+            Nonterminal => Rule_Lists.No_Element);
+
+         if WisiToken.BNF.Token_Lists.Has_Element (Cursor.Token_Kind) then
+            Cursor.Token_Item := Cursor.Data.Tokens.Tokens 
(Cursor.Token_Kind).Tokens.First;
+            return WisiToken.BNF.String_Pair_Lists.Has_Element 
(Cursor.Token_Item);
+         else
+            return False;
+         end if;
+
+      when Terminals_Others =>
+         Cursor :=
+           (Data        => Cursor.Data,
+            Kind        => EOI,
+            ID          => Cursor.ID,
+            Token_Kind  => WisiToken.BNF.Token_Lists.No_Element,
+            Token_Item  => String_Pair_Lists.No_Element,
+            Keyword     => String_Pair_Lists.No_Element,
+            Nonterminal => Rule_Lists.No_Element);
+
+         return True;
+
+      when EOI =>
+         if Nonterminals then
+            if Rule_Lists.Has_Element (Cursor.Data.Tokens.Rules.First) then
+               Cursor :=
+                 (Data        => Cursor.Data,
+                  Kind        => WisiToken_Accept,
+                  ID          => Cursor.ID,
+                  Token_Kind  => WisiToken.BNF.Token_Lists.No_Element,
+                  Token_Item  => String_Pair_Lists.No_Element,
+                  Keyword     => String_Pair_Lists.No_Element,
+                  Nonterminal => Rule_Lists.No_Element);
+            else
+               Cursor.Kind := Done;
+            end if;
+            return True;
+         else
+            Cursor.Kind := Done;
+            return True;
+         end if;
+
+      when WisiToken_Accept =>
+         Cursor :=
+           (Data        => Cursor.Data,
+            Kind        => Nonterminal,
+            ID          => Cursor.ID,
+            Token_Kind  => WisiToken.BNF.Token_Lists.No_Element,
+            Token_Item  => String_Pair_Lists.No_Element,
+            Keyword     => String_Pair_Lists.No_Element,
+            Nonterminal => Cursor.Data.Tokens.Rules.First);
+
+         --  Can't get here with no rules
+         return True;
+
+      when Nonterminal =>
+         Cursor.Kind := Done;
+
+         return True;
+
+      when Done =>
+         return True;
+      end case;
+   end Next_Kind_Internal;
+
+   function First
+     (Data         : aliased in Generate_Data;
+      Non_Grammar  :         in Boolean;
+      Nonterminals :         in Boolean)
+     return Token_Cursor
+   is
+      Cursor : Token_Cursor :=
+        (Data        => Data'Access,
+         Kind        => Non_Grammar_Kind,
+         ID          => Token_ID'First,
+         Token_Kind  => Data.Tokens.Non_Grammar.First,
+         Token_Item  => String_Pair_Lists.No_Element,
+         Keyword     => String_Pair_Lists.No_Element,
+         Nonterminal => Rule_Lists.No_Element);
+   begin
+      if Non_Grammar then
+         if WisiToken.BNF.Token_Lists.Has_Element (Cursor.Token_Kind) then
+            Cursor.Token_Item := Cursor.Data.Tokens.Non_Grammar 
(Cursor.Token_Kind).Tokens.First;
+            if WisiToken.BNF.String_Pair_Lists.Has_Element (Cursor.Token_Item) 
then
+               return Cursor;
+            end if;
+         end if;
+      end if;
+
+      --  There are no non_grammar tokens, or Non_Grammar false
+      loop
+         exit when Next_Kind_Internal (Cursor, Nonterminals);
+      end loop;
+      return Cursor;
+   end First;
+
+   procedure Next (Cursor : in out Token_Cursor; Nonterminals : in Boolean)
+   is begin
+      Cursor.ID := Cursor.ID + 1;
+
+      case Cursor.Kind is
+      when Non_Grammar_Kind =>
+         String_Pair_Lists.Next (Cursor.Token_Item);
+         if String_Pair_Lists.Has_Element (Cursor.Token_Item) then
+            return;
+         else
+            WisiToken.BNF.Token_Lists.Next (Cursor.Token_Kind);
+
+            if WisiToken.BNF.Token_Lists.Has_Element (Cursor.Token_Kind) then
+               Cursor.Token_Item := Cursor.Data.Tokens.Non_Grammar 
(Cursor.Token_Kind).Tokens.First;
+               if String_Pair_Lists.Has_Element (Cursor.Token_Item) then
+                  return;
+               end if;
+            end if;
+         end if;
+
+         loop
+            exit when Next_Kind_Internal (Cursor, Nonterminals);
+         end loop;
+         return;
+
+      when Terminals_Keywords =>
+         --  Keywords before other terminals, so they have precedence over 
Identifiers
+
+         String_Pair_Lists.Next (Cursor.Keyword);
+         if String_Pair_Lists.Has_Element (Cursor.Keyword) then
+            return;
+         end if;
+
+         loop
+            exit when Next_Kind_Internal (Cursor, Nonterminals);
+         end loop;
+         return;
+
+      when Terminals_Others =>
+         WisiToken.BNF.String_Pair_Lists.Next (Cursor.Token_Item);
+         if WisiToken.BNF.String_Pair_Lists.Has_Element (Cursor.Token_Item) 
then
+            return;
+         else
+            WisiToken.BNF.Token_Lists.Next (Cursor.Token_Kind);
+            if WisiToken.BNF.Token_Lists.Has_Element (Cursor.Token_Kind) then
+               Cursor.Token_Item := Cursor.Data.Tokens.Tokens 
(Cursor.Token_Kind).Tokens.First;
+               if WisiToken.BNF.String_Pair_Lists.Has_Element 
(Cursor.Token_Item) then
+                  return;
+               end if;
+            end if;
+         end if;
+
+         loop
+            exit when Next_Kind_Internal (Cursor, Nonterminals);
+         end loop;
+         return;
+
+      when EOI =>
+         if Next_Kind_Internal (Cursor, Nonterminals) then
+            return;
+         else
+            raise SAL.Programmer_Error;
+         end if;
+
+      when WisiToken_Accept =>
+         if Next_Kind_Internal (Cursor, Nonterminals) then
+            return;
+         else
+            raise SAL.Programmer_Error;
+         end if;
+
+      when Nonterminal =>
+         Rule_Lists.Next (Cursor.Nonterminal);
+         if not Rule_Lists.Has_Element (Cursor.Nonterminal) then
+            Cursor.Kind := Done;
+         end if;
+
+      when Done =>
+         null;
+      end case;
+   end Next;
+
+   function Is_Done (Cursor : in Token_Cursor) return Boolean
+   is begin
+      return Cursor.Kind = Done;
+   end Is_Done;
+
+   function ID (Cursor : in Token_Cursor) return Token_ID
+   is begin
+      return Cursor.ID;
+   end ID;
+
+   function Name (Cursor : in Token_Cursor) return String
+   is begin
+      return Cursor.Data.Descriptor.Image (Cursor.ID).all;
+   end Name;
+
+   function Kind (Cursor : in Token_Cursor) return String
+   is begin
+      case Cursor.Kind is
+      when Non_Grammar_Kind =>
+         return -Token_Lists.Constant_Reference 
(Cursor.Data.Tokens.Non_Grammar, Cursor.Token_Kind).Kind;
+
+      when Terminals_Keywords =>
+         return "keyword";
+
+      when Terminals_Others =>
+         return -Token_Lists.Constant_Reference (Cursor.Data.Tokens.Tokens, 
Cursor.Token_Kind).Kind;
+
+      when EOI =>
+         return "EOI";
+
+      when WisiToken_Accept =>
+         return "accept";
+
+      when Nonterminal =>
+            return "nonterminal";
+
+      when Done =>
+         raise SAL.Programmer_Error with "token cursor is done";
+      end case;
+   end Kind;
+
+   function Value (Cursor : in Token_Cursor) return String
+   is begin
+      case Cursor.Kind is
+      when Non_Grammar_Kind =>
+         declare
+            Token_Ref : constant 
WisiToken.BNF.Token_Lists.Constant_Reference_Type :=
+              WisiToken.BNF.Token_Lists.Constant_Reference 
(Cursor.Data.Tokens.Non_Grammar, Cursor.Token_Kind);
+
+            Item_Ref : constant String_Pair_Lists.Constant_Reference_Type :=
+              String_Pair_Lists.Constant_Reference (Token_Ref.Element.Tokens, 
Cursor.Token_Item);
+         begin
+            return -Item_Ref.Element.Value;
+         end;
+
+      when Terminals_Keywords =>
+         declare
+            Keyword_Ref : constant String_Pair_Lists.Constant_Reference_Type :=
+              String_Pair_Lists.Constant_Reference 
(Cursor.Data.Tokens.Keywords, Cursor.Keyword);
+         begin
+            return -Keyword_Ref.Element.Value;
+         end;
+
+      when Terminals_Others =>
+         declare
+            Token_Ref : constant 
WisiToken.BNF.Token_Lists.Constant_Reference_Type :=
+              WisiToken.BNF.Token_Lists.Constant_Reference 
(Cursor.Data.Tokens.Tokens, Cursor.Token_Kind);
+
+            Item_Ref : constant String_Pair_Lists.Constant_Reference_Type :=
+              String_Pair_Lists.Constant_Reference (Token_Ref.Element.Tokens, 
Cursor.Token_Item);
+         begin
+            return -Item_Ref.Element.Value;
+         end;
+
+      when EOI | WisiToken_Accept | Nonterminal =>
+            return "";
+
+      when Done =>
+         raise SAL.Programmer_Error with "token cursor is done";
+      end case;
+   end Value;
+
+   function To_Conflicts
+     (Data             : aliased in out Generate_Data;
+      Conflicts        :         in     WisiToken.BNF.Conflict_Lists.List;
+      Source_File_Name :         in     String)
+     return WisiToken.Generate.LR.Conflict_Lists.List
+   is
+      use WisiToken.Generate.LR;
+      use all type WisiToken.Parse.LR.Parse_Action_Verbs;
+      Result   : WisiToken.Generate.LR.Conflict_Lists.List;
+      Conflict : WisiToken.Generate.LR.Conflict;
+   begin
+      Data.Accept_Reduce_Conflict_Count := 0;
+      Data.Shift_Reduce_Conflict_Count  := 0;
+      Data.Reduce_Reduce_Conflict_Count := 0;
+
+      for Item of Conflicts loop
+         begin
+            Conflict :=
+              (Conflict_Parse_Actions'Value (-Item.Action_A),
+               Find_Token_ID (Data, -Item.LHS_A),
+               Conflict_Parse_Actions'Value (-Item.Action_B),
+               Find_Token_ID (Data, -Item.LHS_B),
+               -1,
+               Find_Token_ID (Data, -Item.On));
+
+            case Conflict.Action_A is
+            when Shift =>
+               Data.Shift_Reduce_Conflict_Count := 
Data.Shift_Reduce_Conflict_Count + 1;
+            when Reduce =>
+               Data.Reduce_Reduce_Conflict_Count := 
Data.Reduce_Reduce_Conflict_Count + 1;
+            when Accept_It =>
+               Data.Accept_Reduce_Conflict_Count := 
Data.Reduce_Reduce_Conflict_Count + 1;
+            end case;
+
+            Result.Append (Conflict);
+         exception
+         when E : Not_Found =>
+            Put_Error
+              (Error_Message
+                 (Source_File_Name, Item.Source_Line, 
Ada.Exceptions.Exception_Message (E)));
+         end;
+      end loop;
+      return Result;
+   end To_Conflicts;
+
+   function To_Nonterminal_ID_Set
+     (Data : aliased in Generate_Data;
+      Item :         in String_Lists.List)
+     return Token_ID_Set
+   is
+      Result : Token_ID_Set := (Data.Descriptor.First_Nonterminal .. 
Data.Descriptor.Last_Nonterminal => False);
+   begin
+      for Token of Item loop
+         Result (Find_Token_ID (Data, Token)) := True;
+      end loop;
+      return Result;
+   end To_Nonterminal_ID_Set;
+
+   function To_McKenzie_Param
+     (Data             : aliased in Generate_Data;
+      Item             :         in McKenzie_Recover_Param_Type;
+      Source_File_Name :         in String)
+     return WisiToken.Parse.LR.McKenzie_Param_Type
+   is
+      use Ada.Strings.Unbounded;
+
+      Result : WisiToken.Parse.LR.McKenzie_Param_Type :=
+        --  We use an aggregate, and overwrite some below, so the compiler
+        --  reminds us to change this when we modify McKenzie_Param_Type.
+        (Data.Descriptor.First_Terminal,
+         Data.Descriptor.Last_Terminal,
+         Data.Descriptor.First_Nonterminal,
+         Data.Descriptor.Last_Nonterminal,
+         Insert            => (others => Item.Default_Insert),
+         Delete            => (others => Item.Default_Delete_Terminal),
+         Push_Back         => (others => Item.Default_Push_Back),
+         Ignore_Check_Fail => Item.Ignore_Check_Fail,
+         Task_Count        => 0,
+         Cost_Limit        => Item.Cost_Limit,
+         Check_Limit       => Item.Check_Limit,
+         Check_Delta_Limit => Item.Check_Delta_Limit,
+         Enqueue_Limit     => Item.Enqueue_Limit);
+
+      ID : Token_ID;
+   begin
+      for Pair of Item.Delete loop
+         ID := Find_Token_ID (Data, -Pair.Name);
+         if ID in Result.Delete'Range then
+            Result.Delete (ID) := Natural'Value (-Pair.Value);
+         else
+            Put_Error
+              (Error_Message
+                 (Source_File_Name, Item.Source_Line, "delete cost is only 
valid for terminals (" &
+                    WisiToken.Image (ID, Data.Descriptor.all) & ")"));
+         end if;
+      end loop;
+      for Pair of Item.Insert loop
+         Result.Insert (Find_Token_ID (Data, -Pair.Name)) := Natural'Value 
(-Pair.Value);
+      end loop;
+      for Pair of Item.Push_Back loop
+         Result.Push_Back (Find_Token_ID (Data, -Pair.Name)) := Natural'Value 
(-Pair.Value);
+      end loop;
+
+      return Result;
+   end To_McKenzie_Param;
+
+   procedure Count_Actions (Data : in out Generate_Utils.Generate_Data)
+   is begin
+      Data.Table_Actions_Count := 0;
+      for State_Index in Data.LR_Parse_Table.States'Range loop
+         Data.Table_Actions_Count := Data.Table_Actions_Count +
+           Actions_Length (Data.LR_Parse_Table.States (State_Index)) + 1;
+      end loop;
+   end Count_Actions;
+
+   procedure Put_Stats
+     (Input_Data    : in WisiToken_Grammar_Runtime.User_Data_Type;
+      Generate_Data : in Generate_Utils.Generate_Data)
+   is
+      use Ada.Text_IO;
+   begin
+      New_Line;
+      Put_Line
+        (Integer'Image (Input_Data.Rule_Count) & " rules," &
+           Integer'Image (Input_Data.Action_Count) & " user actions," &
+           Integer'Image (Input_Data.Check_Count) & " checks," &
+           WisiToken.State_Index'Image (Generate_Data.Parser_State_Count) & " 
states," &
+           Integer'Image (Generate_Data.Table_Actions_Count) & " parse 
actions");
+      Put_Line
+        (Integer'Image (Generate_Data.Accept_Reduce_Conflict_Count) & " 
accept/reduce conflicts," &
+           Integer'Image (Generate_Data.Shift_Reduce_Conflict_Count) & " 
shift/reduce conflicts," &
+           Integer'Image (Generate_Data.Reduce_Reduce_Conflict_Count) & " 
reduce/reduce conflicts");
+   end Put_Stats;
+
+   function Actions_Length (State : in Parse.LR.Parse_State) return Integer
+   is
+      use all type WisiToken.Parse.LR.Action_Node_Ptr;
+      Node : Parse.LR.Action_Node_Ptr := State.Action_List;
+   begin
+      return Result : Integer := 0
+      do
+         loop
+            exit when Node = null;
+            Result := Result + 1;
+            Node := Node.Next;
+            exit when Node.Next = null; -- don't count Error
+         end loop;
+      end return;
+   end Actions_Length;
+
+end WisiToken.BNF.Generate_Utils;
diff --git a/wisitoken-bnf-generate_utils.ads b/wisitoken-bnf-generate_utils.ads
new file mode 100644
index 0000000..d7347de
--- /dev/null
+++ b/wisitoken-bnf-generate_utils.ads
@@ -0,0 +1,176 @@
+--  Abstract :
+--
+--  Utilities for translating input file structures to WisiToken
+--  structures needed for LALR.Generate.
+--
+--  Copyright (C) 2014, 2015, 2017, 2018 Stephen Leake All Rights Reserved.
+--
+--  The WisiToken package is free software; you can redistribute it
+--  and/or modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or
+--  (at your option) any later version. This library 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.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Iterator_Interfaces;
+with WisiToken.Generate.LR;
+with WisiToken.Parse.LR;
+with WisiToken.Productions;
+with WisiToken_Grammar_Runtime;
+package WisiToken.BNF.Generate_Utils is
+
+   EOI_Name : constant String := "Wisi_EOI";
+   --  EOI_Name is used for EOF_ID token; it must match Emacs ada-mode
+   --  wisi.el wisi-eoi-term. It must be a valid Ada identifier when
+   --  "_ID" is appended.
+
+   WisiToken_Accept_Name : constant String := "wisitoken_accept";
+
+   type Generate_Data is limited record
+      Tokens     : access constant WisiToken.BNF.Tokens;
+      Descriptor : access WisiToken.Descriptor;
+      Grammar    : WisiToken.Productions.Prod_Arrays.Vector;
+
+      Action_Names : access Names_Array_Array;
+      Check_Names  : access Names_Array_Array;
+      --  Names of subprograms for each grammar semantic action and check;
+      --  non-null only if there is an action or check in the grammar.
+
+      Start_ID        : WisiToken.Token_ID;
+      Source_Line_Map : WisiToken.Productions.Source_Line_Maps.Vector;
+
+      --  The following fields are LR specific; so far, it's not worth
+      --  splitting them out.
+
+      Conflicts                    : WisiToken.Generate.LR.Conflict_Lists.List;
+      LR_Parse_Table               : WisiToken.Parse.LR.Parse_Table_Ptr;
+      Table_Actions_Count          : Integer                       := -1; -- 
parse, not user, actions
+      Parser_State_Count           : WisiToken.Unknown_State_Index := 0;
+      Accept_Reduce_Conflict_Count : Integer                       := 0;
+      Shift_Reduce_Conflict_Count  : Integer                       := 0;
+      Reduce_Reduce_Conflict_Count : Integer                       := 0;
+   end record;
+
+   function Initialize (Input_Data : aliased in 
WisiToken_Grammar_Runtime.User_Data_Type) return Generate_Data;
+
+   function Find_Token_ID (Data : aliased in Generate_Data; Token : in String) 
return Token_ID;
+
+   type Token_Container (Data : not null access constant Generate_Data) is 
tagged null record
+   with
+     Constant_Indexing => Constant_Reference,
+     Default_Iterator  => Iterate,
+     Iterator_Element  => Ada.Strings.Unbounded.Unbounded_String;
+   --  We need a container type to define an iterator; the actual data is
+   --  in Data.Tokens. The Iterator_Element is given by Token_Name below.
+
+   function All_Tokens (Data : aliased in Generate_Data) return 
Token_Container;
+
+   type Token_Constant_Reference_Type
+     (Element : not null access constant 
Ada.Strings.Unbounded.Unbounded_String)
+     is null record
+   with Implicit_Dereference => Element;
+
+   type Token_Cursor is private;
+   --  Iterate thru Keywords, Tokens, Rules in a canonical order:
+   --
+   --  1. Non_Grammar
+   --  2. Keywords
+   --  3. other terminal tokens, in declaration order
+   --  4. EOI
+   --  5. Accept
+   --  6. Nonterminals
+   --
+   --  Within each group, tokens occur in the order they were declared in
+   --  the grammar file.
+
+   function Constant_Reference
+     (Container : aliased in Token_Container'Class;
+      Cursor    :         in Token_Cursor)
+     return Token_Constant_Reference_Type;
+
+   function Is_Done (Cursor : in Token_Cursor) return Boolean;
+   function Has_Element (Cursor : in Token_Cursor) return Boolean is (not 
Is_Done (Cursor));
+   package Iterator_Interfaces is new Ada.Iterator_Interfaces (Token_Cursor, 
Has_Element);
+   function Iterate
+     (Container    : aliased    Token_Container;
+      Non_Grammar  :         in Boolean := True;
+      Nonterminals :         in Boolean := True)
+     return Iterator_Interfaces.Forward_Iterator'Class;
+
+   function First
+     (Data         : aliased in Generate_Data;
+      Non_Grammar  :         in Boolean;
+      Nonterminals :         in Boolean)
+     return Token_Cursor;
+   procedure Next (Cursor : in out Token_Cursor; Nonterminals : in Boolean);
+
+   function ID (Cursor : in Token_Cursor) return Token_ID;
+
+   function Name (Cursor : in Token_Cursor) return String;
+   --  Return the token name from the .wy file:
+   --  Keywords: Keywords (i).name
+   --  Tokens  : Tokens (i).Tokens (j).name
+   --  Rules   : Rules (i).Left_Hand_Side
+
+   function Kind (Cursor : in Token_Cursor) return String;
+   --  Return the token kind from the .wy file:
+   --  Keywords: "keyword"
+   --  Tokens  : Tokens (i).Kind
+   --  Rules   : "nonterminal"
+
+   function Value (Cursor : in Token_Cursor) return String;
+   --  Return the token value from the .wy file:
+   --  Keywords: Keywords (i).value
+   --  Tokens  : Tokens (i).Tokens (j).Value
+   --  Rules   : "" - they have no Value
+
+   function To_Conflicts
+     (Data             : aliased in out Generate_Data;
+      Conflicts        :         in     WisiToken.BNF.Conflict_Lists.List;
+      Source_File_Name :         in     String)
+     return WisiToken.Generate.LR.Conflict_Lists.List;
+   --  Not included in Initialize because algorithms have no conflicts.
+
+   function To_Nonterminal_ID_Set
+     (Data : aliased in Generate_Data;
+      Item :         in String_Lists.List)
+     return Token_ID_Set;
+
+   function To_McKenzie_Param
+     (Data             : aliased in Generate_Data;
+      Item             :         in McKenzie_Recover_Param_Type;
+      Source_File_Name :         in String)
+     return WisiToken.Parse.LR.McKenzie_Param_Type;
+
+   procedure Count_Actions (Data : in out Generate_Utils.Generate_Data);
+
+   procedure Put_Stats
+     (Input_Data    : in WisiToken_Grammar_Runtime.User_Data_Type;
+      Generate_Data : in Generate_Utils.Generate_Data);
+
+   function Actions_Length (State : in Parse.LR.Parse_State) return Integer;
+   --  Not including Error.
+
+private
+
+   type Token_Cursor_Kind is
+     (Non_Grammar_Kind, Terminals_Keywords, Terminals_Others, EOI, 
WisiToken_Accept, Nonterminal, Done);
+
+   type Token_Cursor is record
+      Data        : not null access constant Generate_Data;
+      Kind        : Token_Cursor_Kind;
+      ID          : Token_ID;
+      Token_Kind  : WisiToken.BNF.Token_Lists.Cursor; -- Non_Grammar or 
Tokens, depending on Kind
+      Token_Item  : String_Pair_Lists.Cursor;
+      Keyword     : String_Pair_Lists.Cursor;
+      Nonterminal : Rule_Lists.Cursor;
+   end record;
+
+end WisiToken.BNF.Generate_Utils;
diff --git a/wisitoken-bnf-output_ada.adb b/wisitoken-bnf-output_ada.adb
new file mode 100644
index 0000000..ee24c7e
--- /dev/null
+++ b/wisitoken-bnf-output_ada.adb
@@ -0,0 +1,436 @@
+--  Abstract :
+--
+--  Output Ada code implementing the grammar defined by input
+--  parameters, and a parser for that grammar. The grammar parser
+--  actions must be Ada.
+--
+--  Copyright (C) 2017, 2018 Stephen Leake.  All Rights Reserved.
+--
+--  The WisiToken package is free software; you can redistribute it
+--  and/or modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or
+--  (at your option) any later version. This library 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.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Strings.Fixed;
+with Ada.Text_IO; use Ada.Text_IO;
+with GNAT.Regexp;
+with WisiToken.BNF.Generate_Packrat;
+with WisiToken.BNF.Generate_Utils;
+with WisiToken.BNF.Output_Ada_Common; use WisiToken.BNF.Output_Ada_Common;
+with WisiToken.Generate.Packrat;
+with WisiToken_Grammar_Runtime;
+procedure WisiToken.BNF.Output_Ada
+  (Input_Data            :         in WisiToken_Grammar_Runtime.User_Data_Type;
+   Output_File_Name_Root :         in String;
+   Generate_Data         : aliased in 
WisiToken.BNF.Generate_Utils.Generate_Data;
+   Packrat_Data          :         in WisiToken.Generate.Packrat.Data;
+   Tuple                 :         in Generate_Tuple;
+   Test_Main             :         in Boolean;
+   Multiple_Tuples       :         in Boolean)
+is
+   Common_Data : Output_Ada_Common.Common_Data := 
WisiToken.BNF.Output_Ada_Common.Initialize
+     (Input_Data, Tuple, Output_File_Name_Root, Check_Interface => False);
+
+   Gen_Alg_Name : constant String :=
+     (if Test_Main or Multiple_Tuples
+      then "_" & Generate_Algorithm_Image (Common_Data.Generate_Algorithm).all
+      else "");
+
+   function Symbol_Regexp (Item : in String) return String
+   is begin
+      --  Return a regular expression string that matches Item as a symbol;
+      --  it must be preceded and followed by non-symbol characters.
+      --
+      --  GNAT.Regexp does not have a char for 'end of string', so we hope
+      --  that doesn't occur. Sigh.
+      return ".*[ (\.]" & Item & "[ );\.,].*";
+   end Symbol_Regexp;
+
+   procedure Create_Ada_Actions_Body
+     (Action_Names : not null access WisiToken.Names_Array_Array;
+      Check_Names  : not null access WisiToken.Names_Array_Array;
+      Package_Name : in              String)
+   is
+      use GNAT.Regexp;
+      use Generate_Utils;
+      use WisiToken.Generate;
+
+      File_Name : constant String := Output_File_Name_Root & "_actions.adb";
+      --  No generate_algorithm when Test_Main; the generated actions file is 
independent of that.
+
+      User_Data_Regexp : constant Regexp := Compile (Symbol_Regexp 
("User_Data"), Case_Sensitive => False);
+      Tree_Regexp      : constant Regexp := Compile (Symbol_Regexp ("Tree"), 
Case_Sensitive      => False);
+      Nonterm_Regexp   : constant Regexp := Compile (Symbol_Regexp 
("Nonterm"), Case_Sensitive   => False);
+      Tokens_Regexp    : constant Regexp := Compile (Symbol_Regexp ("Tokens"), 
Case_Sensitive    => False);
+
+      Body_File : File_Type;
+   begin
+      Create (Body_File, Out_File, File_Name);
+      Set_Output (Body_File);
+      Indent := 1;
+      Put_File_Header (Ada_Comment, Use_Tuple => True, Tuple => Tuple);
+      Put_Raw_Code (Ada_Comment, Input_Data.Raw_Code (Copyright_License));
+      Put_Raw_Code (Ada_Comment, Input_Data.Raw_Code (Actions_Body_Context));
+      New_Line;
+
+      Put_Line ("package body " & Package_Name & " is");
+      Indent := Indent + 3;
+      New_Line;
+
+      if Input_Data.Check_Count > 0 then
+         Indent_Line ("use WisiToken.Semantic_Checks;");
+         New_Line;
+      end if;
+
+      Put_Raw_Code (Ada_Comment, Input_Data.Raw_Code (Actions_Body_Pre));
+
+      --  generate Action and Check subprograms.
+
+      for Rule of Input_Data.Tokens.Rules loop
+         --  No need for a Token_Cursor here, since we only need the
+         --  nonterminals.
+         declare
+            use Ada.Strings.Unbounded;
+
+            LHS_ID    : constant WisiToken.Token_ID := Find_Token_ID 
(Generate_Data, -Rule.Left_Hand_Side);
+            RHS_Index : Integer                     := 0;
+
+            function Is_Elisp (Action : in Unbounded_String) return Boolean
+            is begin
+               return Length (Action) >= 6 and then
+                 (Slice (Action, 1, 6) = "(progn" or
+                    Slice (Action, 1, 5) = "wisi-");
+            end Is_Elisp;
+
+         begin
+            for RHS of Rule.Right_Hand_Sides loop
+               if Length (RHS.Action) > 0 and then not Is_Elisp (RHS.Action) 
then
+                  declare
+                     Line : constant String := -RHS.Action;
+                     --  Actually multiple lines; we assume the formatting is 
adequate.
+
+                     Name : constant String := Action_Names 
(LHS_ID)(RHS_Index).all;
+
+                     Unref_User_Data : Boolean := True;
+                     Unref_Tree      : Boolean := True;
+                     Unref_Nonterm   : Boolean := True;
+                     Unref_Tokens    : Boolean := True;
+                     Need_Comma      : Boolean := False;
+
+                     procedure Check_Unref (Line : in String)
+                     is begin
+                        if Match (Line, User_Data_Regexp) then
+                           Unref_User_Data := False;
+                        end if;
+                        if Match (Line, Tree_Regexp) then
+                           Unref_Tree := False;
+                        end if;
+                        if Match (Line, Nonterm_Regexp) then
+                           Unref_Nonterm := False;
+                        end if;
+                        if Match (Line, Tokens_Regexp) then
+                           Unref_Tokens := False;
+                        end if;
+                     end Check_Unref;
+
+                  begin
+                     Check_Unref (Line);
+                     Indent_Line ("procedure " & Name);
+                     Indent_Line (" (User_Data : in out 
WisiToken.Syntax_Trees.User_Data_Type'Class;");
+                     Indent_Line ("  Tree      : in out 
WisiToken.Syntax_Trees.Tree;");
+                     Indent_Line ("  Nonterm   : in     
WisiToken.Syntax_Trees.Valid_Node_Index;");
+                     Indent_Line ("  Tokens    : in     
WisiToken.Syntax_Trees.Valid_Node_Index_Array)");
+                     Indent_Line ("is");
+
+                     if Unref_User_Data or Unref_Tree or Unref_Nonterm or 
Unref_Tokens then
+                        Indent_Start ("   pragma Unreferenced (");
+
+                        if Unref_User_Data then
+                           Put ((if Need_Comma then ", " else "") & 
"User_Data");
+                           Need_Comma := True;
+                        end if;
+                        if Unref_Tree then
+                           Put ((if Need_Comma then ", " else "") & "Tree");
+                           Need_Comma := True;
+                        end if;
+                        if Unref_Nonterm then
+                           Put ((if Need_Comma then ", " else "") & "Nonterm");
+                           Need_Comma := True;
+                        end if;
+                        if Unref_Tokens then
+                           Put ((if Need_Comma then ", " else "") & "Tokens");
+                           Need_Comma := True;
+                        end if;
+                        Put_Line (");");
+                     end if;
+
+                     Indent_Line ("begin");
+                     Indent := Indent + 3;
+
+                     Indent_Line (Line);
+                     Indent := Indent - 3;
+                     Indent_Line ("end " & Name & ";");
+                     New_Line;
+                  end;
+               end if;
+
+               if Length (RHS.Check) > 0 and then not Is_Elisp (RHS.Check) then
+                  declare
+                     use Ada.Strings.Fixed;
+                     Line          : constant String  := -RHS.Check;
+                     Name          : constant String  := Check_Names 
(LHS_ID)(RHS_Index).all;
+                     Unref_Lexer   : constant Boolean := 0 = Index (Line, 
"Lexer");
+                     Unref_Nonterm : constant Boolean := 0 = Index (Line, 
"Nonterm");
+                     Unref_Tokens  : constant Boolean := 0 = Index (Line, 
"Tokens");
+                  begin
+                     Indent_Line ("function " & Name);
+                     Indent_Line (" (Lexer   : access constant 
WisiToken.Lexer.Instance'Class;");
+                     Indent_Line ("  Nonterm : in out 
WisiToken.Recover_Token;");
+                     Indent_Line ("  Tokens  : in     
WisiToken.Recover_Token_Array)");
+                     Indent_Line (" return 
WisiToken.Semantic_Checks.Check_Status");
+                     Indent_Line ("is");
+
+                     if Unref_Lexer then
+                        Indent_Line ("   pragma Unreferenced (Lexer);");
+                     end if;
+                     if Unref_Nonterm then
+                        Indent_Line ("   pragma Unreferenced (Nonterm);");
+                     end if;
+                     if Unref_Tokens then
+                        Indent_Line ("   pragma Unreferenced (Tokens);");
+                     end if;
+
+                     Indent_Line ("begin");
+                     Indent := Indent + 3;
+                     Indent_Line (Line);
+                     Indent := Indent - 3;
+                     Indent_Line ("end " & Name & ";");
+                     New_Line;
+                  end;
+               end if;
+
+               RHS_Index := RHS_Index + 1;
+            end loop;
+         end;
+      end loop;
+
+      Put_Raw_Code (Ada_Comment, Input_Data.Raw_Code (Actions_Body_Post));
+
+      Put_Line ("end " & Package_Name & ";");
+      Close (Body_File);
+
+      Set_Output (Standard_Output);
+
+   end Create_Ada_Actions_Body;
+
+   procedure Create_Ada_Main_Body
+     (Actions_Package_Name : in String;
+      Main_Package_Name    : in String)
+   is
+      use WisiToken.Generate;
+
+      File_Name         : constant String := To_Lower (Main_Package_Name) & 
".adb";
+      re2c_Package_Name : constant String := -Common_Data.Lower_File_Name_Root 
& "_re2c_c";
+
+      Body_File : File_Type;
+   begin
+      Create (Body_File, Out_File, File_Name);
+      Set_Output (Body_File);
+      Indent := 1;
+
+      Put_File_Header (Ada_Comment, Use_Tuple => True, Tuple => Tuple);
+      Put_Raw_Code (Ada_Comment, Input_Data.Raw_Code (Copyright_License));
+      New_Line;
+
+      if (case Common_Data.Generate_Algorithm is
+          when LR_Generate_Algorithm => Input_Data.Action_Count > 0 or 
Input_Data.Check_Count > 0,
+          when Packrat_Generate_Algorithm | External => 
Input_Data.Action_Count > 0)
+      then
+         Put_Line ("with " & Actions_Package_Name & "; use " & 
Actions_Package_Name & ";");
+      end if;
+
+      case Common_Data.Lexer is
+      when None | Elisp_Lexer =>
+         null;
+
+      when re2c_Lexer =>
+         Put_Line ("with WisiToken.Lexer.re2c;");
+         Put_Line ("with " & re2c_Package_Name & ";");
+      end case;
+
+      case Common_Data.Generate_Algorithm is
+      when LR_Generate_Algorithm =>
+         if Tuple.Text_Rep then
+            Put_Line ("with WisiToken.Productions;");
+         end if;
+
+      when Packrat_Gen =>
+         Put_Line ("with WisiToken.Parse.Packrat.Generated;");
+
+      when Packrat_Proc =>
+         Put_Line ("with WisiToken.Parse.Packrat.Procedural;");
+         Put_Line ("with WisiToken.Productions;");
+
+      when External =>
+         null;
+      end case;
+
+      Put_Line ("package body " & Main_Package_Name & " is");
+      Indent := Indent + 3;
+      New_Line;
+
+      case Common_Data.Lexer is
+      when None | Elisp_Lexer =>
+         null;
+
+      when re2c_Lexer =>
+         Indent_Line ("package Lexer is new WisiToken.Lexer.re2c");
+         Indent_Line ("  (" & re2c_Package_Name & ".New_Lexer,");
+         Indent_Line ("   " & re2c_Package_Name & ".Free_Lexer,");
+         Indent_Line ("   " & re2c_Package_Name & ".Reset_Lexer,");
+         Indent_Line ("   " & re2c_Package_Name & ".Next_Token);");
+         New_Line;
+      end case;
+
+      case Common_Data.Generate_Algorithm is
+      when LR_Generate_Algorithm =>
+         LR_Create_Create_Parser (Input_Data, Common_Data, Generate_Data);
+
+      when Packrat_Gen =>
+         WisiToken.BNF.Generate_Packrat (Packrat_Data, Generate_Data);
+
+         Packrat_Create_Create_Parser (Common_Data, Generate_Data, 
Packrat_Data);
+
+      when Packrat_Proc =>
+         Packrat_Create_Create_Parser (Common_Data, Generate_Data, 
Packrat_Data);
+
+      when External =>
+         External_Create_Create_Grammar (Generate_Data);
+      end case;
+
+      Put_Line ("end " & Main_Package_Name & ";");
+      Close (Body_File);
+      Set_Output (Standard_Output);
+   end Create_Ada_Main_Body;
+
+   procedure Create_Ada_Test_Main
+     (Actions_Package_Name : in String;
+      Main_Package_Name    : in String)
+   is
+      use WisiToken.Generate;
+
+      Generic_Package_Name : constant String :=
+        (case Common_Data.Generate_Algorithm is
+         when LR_Generate_Algorithm =>
+           (if Input_Data.Language_Params.Error_Recover then
+              (if Common_Data.Text_Rep
+               then "Gen_LR_Text_Rep_Parser_Run"
+               else "Gen_LR_Parser_Run")
+            else
+              (if Common_Data.Text_Rep
+               then "Gen_LR_Text_Rep_Parser_No_Recover_Run"
+               else "Gen_LR_Parser_No_Recover_Run")),
+
+         when Packrat_Generate_Algorithm => "Gen_Packrat_Parser_Run",
+         when External => raise SAL.Programmer_Error);
+
+      Unit_Name : constant String := File_Name_To_Ada (Output_File_Name_Root) &
+        "_" & Generate_Algorithm'Image (Common_Data.Generate_Algorithm) & 
"_Run";
+
+      Language_Package_Name : constant String := 
"WisiToken.Parse.LR.McKenzie_Recover." & File_Name_To_Ada
+        (Output_File_Name_Root);
+
+      File_Name : constant String := To_Lower (Unit_Name) & ".ads";
+
+      File : File_Type;
+   begin
+      Create (File, Out_File, File_Name);
+      Set_Output (File);
+      Indent := 1;
+
+      Put_File_Header (Ada_Comment, Use_Tuple => True, Tuple => Tuple);
+      --  no Copyright_License; just a test file
+      New_Line;
+
+      Put_Line ("with " & Generic_Package_Name & ";");
+      Put_Line ("with " & Actions_Package_Name & ";");
+      Put_Line ("with " & Main_Package_Name & ";");
+      if Input_Data.Language_Params.Error_Recover then
+         Put_Line ("with " & Language_Package_Name & "; use " & 
Language_Package_Name & ";");
+      end if;
+
+      Put_Line ("procedure " & Unit_Name & " is new " & Generic_Package_Name);
+      Put_Line ("  (" & Actions_Package_Name & ".Descriptor,");
+      if Common_Data.Text_Rep then
+         Put_Line ("   """ & Output_File_Name_Root & "_" &
+                     To_Lower (Generate_Algorithm_Image (Tuple.Gen_Alg).all) &
+                     "_parse_table.txt"",");
+      end if;
+      if Input_Data.Language_Params.Error_Recover then
+         Put_Line ("Fixes'Access, Use_Minimal_Complete_Actions'Access, 
String_ID_Set'Access,");
+      end if;
+      Put_Line (Main_Package_Name & ".Create_Parser);");
+      Close (File);
+      Set_Output (Standard_Output);
+   end Create_Ada_Test_Main;
+
+begin
+   case Common_Data.Lexer is
+   when None | re2c_Lexer =>
+      null;
+
+   when Elisp_Lexer =>
+      raise User_Error with WisiToken.Generate.Error_Message
+        (Input_Data.Grammar_Lexer.File_Name, 1, "Ada output language does not 
support " & Lexer_Image
+           (Common_Data.Lexer).all & " lexer");
+   end case;
+
+   case Tuple.Interface_Kind is
+   when None  =>
+      null;
+
+   when Module | Process =>
+      raise User_Error with WisiToken.Generate.Error_Message
+        (Input_Data.Grammar_Lexer.File_Name, 1, "Ada output language does not 
support setting Interface");
+   end case;
+
+   declare
+      Main_Package_Name    : constant String := File_Name_To_Ada 
(Output_File_Name_Root & Gen_Alg_Name) & "_Main";
+      Actions_Package_Name : constant String := File_Name_To_Ada 
(Output_File_Name_Root) & "_Actions";
+   begin
+      if Input_Data.Action_Count > 0 or Input_Data.Check_Count > 0 then
+         --  Some WisiToken tests have no actions or checks.
+         Create_Ada_Actions_Body (Generate_Data.Action_Names, 
Generate_Data.Check_Names, Actions_Package_Name);
+      end if;
+
+      Create_Ada_Actions_Spec
+        (Output_File_Name_Root & "_actions.ads", Actions_Package_Name, 
Input_Data, Common_Data, Generate_Data);
+
+      if Tuple.Gen_Alg = External then
+         Create_External_Main_Spec (Main_Package_Name, Tuple, Input_Data);
+         Create_Ada_Main_Body (Actions_Package_Name, Main_Package_Name);
+      else
+         Create_Ada_Main_Body (Actions_Package_Name, Main_Package_Name);
+
+         Create_Ada_Main_Spec (To_Lower (Main_Package_Name) & ".ads", 
Main_Package_Name, Input_Data, Common_Data);
+
+         if Test_Main then
+            Create_Ada_Test_Main (Actions_Package_Name, Main_Package_Name);
+         end if;
+      end if;
+   end;
+
+exception
+when others =>
+   Set_Output (Standard_Output);
+   raise;
+end WisiToken.BNF.Output_Ada;
diff --git a/wisitoken-bnf-output_ada_common.adb 
b/wisitoken-bnf-output_ada_common.adb
new file mode 100644
index 0000000..3267ebb
--- /dev/null
+++ b/wisitoken-bnf-output_ada_common.adb
@@ -0,0 +1,1407 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2017, 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (GPL);
+
+with Ada.Strings.Fixed;
+with Ada.Text_IO; use Ada.Text_IO;
+with System.Multiprocessors;
+with WisiToken.BNF.Generate_Grammar;
+with WisiToken.BNF.Utils;
+with WisiToken.Generate; use WisiToken.Generate;
+with WisiToken.Parse.LR;
+with WisiToken.Productions;
+with WisiToken.Syntax_Trees;
+package body WisiToken.BNF.Output_Ada_Common is
+
+   --  Body subprograms, alphabetical
+
+   function Duplicate_Reduce (State : in Parse.LR.Parse_State) return Boolean
+   is
+      use Parse.LR;
+      Node        : Action_Node_Ptr       := State.Action_List;
+      Action_Node : Parse_Action_Node_Ptr := Node.Action;
+      First       : Boolean               := True;
+      Action      : Reduce_Action_Rec;
+   begin
+      loop
+         Action_Node := Node.Action;
+         if Action_Node.Next /= null then
+            --  conflict
+            return False;
+         elsif Action_Node.Item.Verb /= Reduce then
+            return False;
+         end if;
+
+         if First then
+            Action := Action_Node.Item;
+            First  := False;
+         else
+            if not Equal (Action, Action_Node.Item) then
+               return False;
+            end if;
+         end if;
+         Node := Node.Next;
+         exit when Node.Next = null; --  Last entry is Error.
+      end loop;
+      return True;
+   end Duplicate_Reduce;
+
+   function Symbols_Image (State : in Parse.LR.Parse_State) return String
+   is
+      use Ada.Strings.Unbounded;
+      use Parse.LR;
+
+      Result     : Unbounded_String;
+      Need_Comma : Boolean          := False;
+      Node       : Action_Node_Ptr  := State.Action_List;
+   begin
+      if Generate_Utils.Actions_Length (State) = 1 then
+         return "(1 => " & Token_ID'Image (Node.Symbol) & ")";
+      else
+         Result := +"(";
+         loop
+            Result := Result &
+              (if Need_Comma then ", " else "") &
+              Trimmed_Image (Node.Symbol);
+            Need_Comma := True;
+            Node := Node.Next;
+            exit when Node.Next = null; -- last is Error
+         end loop;
+         Result := Result & ")";
+         return -Result;
+      end if;
+   end Symbols_Image;
+
+   ----------
+   --  Public subprograms in alphabetical order
+
+   procedure Create_Ada_Actions_Spec
+     (Output_File_Name :         in String;
+      Package_Name     :         in String;
+      Input_Data       :         in WisiToken_Grammar_Runtime.User_Data_Type;
+      Common_Data      :         in Output_Ada_Common.Common_Data;
+      Generate_Data    : aliased in WisiToken.BNF.Generate_Utils.Generate_Data)
+   is
+      use Generate_Utils;
+
+      Descriptor  : WisiToken.Descriptor renames Generate_Data.Descriptor.all;
+      Spec_File : File_Type;
+      Paren_Done  : Boolean      := False;
+      Cursor      : Token_Cursor := First (Generate_Data, Non_Grammar => True, 
Nonterminals => True);
+   begin
+      Create (Spec_File, Out_File, Output_File_Name);
+      Set_Output (Spec_File);
+      Indent := 1;
+
+      Put_File_Header
+        (Ada_Comment, Use_Tuple => True, Tuple =>
+           (Common_Data.Generate_Algorithm, Common_Data.Output_Language, 
Common_Data.Lexer, Common_Data.Interface_Kind,
+            Common_Data.Text_Rep));
+      Put_Raw_Code (Ada_Comment, Input_Data.Raw_Code (Copyright_License));
+      New_Line;
+
+      if not (Input_Data.Action_Count > 0 or Input_Data.Check_Count > 0) then
+         Put_Line ("with WisiToken;");
+      end if;
+      if Input_Data.Action_Count > 0 then
+         Put_Line ("with WisiToken.Syntax_Trees;");
+      end if;
+      if Input_Data.Check_Count > 0 then
+         Put_Line ("with WisiToken.Lexer;");
+         Put_Line ("with WisiToken.Semantic_Checks;");
+      end if;
+      Put_Raw_Code (Ada_Comment, Input_Data.Raw_Code (Actions_Spec_Context));
+      Put_Line ("package " & Package_Name & " is");
+      Indent := Indent + 3;
+      New_Line;
+
+      Put_Raw_Code (Ada_Comment, Input_Data.Raw_Code (Actions_Spec_Pre));
+
+      Indent_Line ("Descriptor : aliased WisiToken.Descriptor :=");
+      Indent_Line ("  (First_Terminal                =>" & 
WisiToken.Token_ID'Image (Descriptor.First_Terminal) & ",");
+      Indent := Indent + 3;
+      Indent_Line ("Last_Terminal                 =>" & 
WisiToken.Token_ID'Image (Descriptor.Last_Terminal) & ",");
+      Indent_Line ("First_Nonterminal             =>" & 
WisiToken.Token_ID'Image (Descriptor.First_Nonterminal) & ",");
+      Indent_Line ("Last_Nonterminal              =>" & 
WisiToken.Token_ID'Image (Descriptor.Last_Nonterminal) & ",");
+      Indent_Line ("EOF_ID                        =>" & 
WisiToken.Token_ID'Image (Descriptor.EOF_ID) & ",");
+      Indent_Line ("Accept_ID                     =>" & 
WisiToken.Token_ID'Image (Descriptor.Accept_ID) & ",");
+      Indent_Line ("Case_Insensitive              => " & Image 
(Input_Data.Language_Params.Case_Insensitive) & ",");
+      Indent_Line ("New_Line_ID                   =>" & 
WisiToken.Token_ID'Image (Descriptor.New_Line_ID) & ",");
+      Indent_Line ("Comment_ID                    =>" & 
WisiToken.Token_ID'Image (Descriptor.Comment_ID) & ",");
+      Indent_Line ("Left_Paren_ID                 =>" & 
WisiToken.Token_ID'Image (Descriptor.Left_Paren_ID) & ",");
+      Indent_Line ("Right_Paren_ID                =>" & 
WisiToken.Token_ID'Image (Descriptor.Right_Paren_ID) & ",");
+      Indent_Line ("String_1_ID                   =>" & 
WisiToken.Token_ID'Image (Descriptor.String_1_ID) & ",");
+      Indent_Line ("String_2_ID                   =>" & 
WisiToken.Token_ID'Image (Descriptor.String_2_ID) & ",");
+      Indent_Line ("Embedded_Quote_Escape_Doubled => " & Image
+                     
(Input_Data.Language_Params.Embedded_Quote_Escape_Doubled) & ",");
+      Indent_Line ("Image                         =>");
+      Indent_Start ("  (");
+      Indent := Indent + 3;
+      loop
+         exit when Is_Done (Cursor);
+         if Paren_Done then
+            Indent_Start ("new String'(""" & (Name (Cursor)));
+         else
+            Put ("new String'(""" & (Name (Cursor)));
+            Paren_Done := True;
+         end if;
+         Next (Cursor, Nonterminals => True);
+         if Is_Done (Cursor) then
+            Put_Line (""")),");
+         else
+            Put_Line ("""),");
+         end if;
+      end loop;
+
+      Indent := Indent - 3;
+      Indent_Line ("Terminal_Image_Width =>" & Integer'Image 
(Descriptor.Terminal_Image_Width) & ",");
+      Indent_Line ("Image_Width          =>" & Integer'Image 
(Descriptor.Image_Width) & ",");
+      Indent_Line ("Last_Lookahead       =>" & WisiToken.Token_ID'Image 
(Descriptor.Last_Lookahead) & ");");
+      Indent := Indent - 3;
+      New_Line;
+
+      if Input_Data.Language_Params.Declare_Enums then
+         Paren_Done := False;
+
+         Cursor := First (Generate_Data, Non_Grammar => True, Nonterminals => 
True);
+         Indent_Line ("type Token_Enum_ID is");
+         Indent_Start ("  (");
+         Indent := Indent + 3;
+         loop
+            exit when Is_Done (Cursor);
+            if Paren_Done then
+               Indent_Start (To_Token_Ada_Name (Name (Cursor)));
+            else
+               Put (To_Token_Ada_Name (Name (Cursor)));
+               Paren_Done := True;
+            end if;
+            Next (Cursor, Nonterminals => True);
+            if Is_Done (Cursor) then
+               Put_Line (");");
+            else
+               Put_Line (",");
+            end if;
+         end loop;
+
+         Indent := Indent - 3;
+         New_Line;
+
+         Indent_Line ("type Token_Enum_ID_Array is array (Positive range <>) 
of Token_Enum_ID;");
+         Indent_Line ("use all type WisiToken.Token_ID;");
+         Indent_Line ("function ""+"" (Item : in Token_Enum_ID) return 
WisiToken.Token_ID");
+         Indent_Line ("  is (WisiToken.Token_ID'First + Token_Enum_ID'Pos 
(Item));");
+
+         Indent_Line ("function To_Token_Enum (Item : in WisiToken.Token_ID) 
return Token_Enum_ID");
+         Indent_Line ("  is (Token_Enum_ID'Val (Item - 
WisiToken.Token_ID'First));");
+         Indent_Line ("function ""-"" (Item : in WisiToken.Token_ID) return 
Token_Enum_ID renames To_Token_Enum;");
+         New_Line;
+
+      end if;
+
+      for Name_List of Generate_Data.Action_Names.all loop
+         if Name_List /= null then
+            for Name of Name_List.all loop
+               if Name /= null then
+                  Indent_Line ("procedure " & Name.all);
+                  Indent_Line (" (User_Data : in out 
WisiToken.Syntax_Trees.User_Data_Type'Class;");
+                  Indent_Line ("  Tree      : in out 
WisiToken.Syntax_Trees.Tree;");
+                  Indent_Line ("  Nonterm   : in     
WisiToken.Syntax_Trees.Valid_Node_Index;");
+                  Indent_Line ("  Tokens    : in     
WisiToken.Syntax_Trees.Valid_Node_Index_Array);");
+               end if;
+            end loop;
+         end if;
+      end loop;
+
+      for Name_List of Generate_Data.Check_Names.all loop
+         if Name_List /= null then
+            for Name of Name_List.all loop
+               if Name /= null then
+                  Indent_Line ("function " & Name.all);
+                  Indent_Line (" (Lexer   : access constant 
WisiToken.Lexer.Instance'Class;");
+                  Indent_Line ("  Nonterm : in out WisiToken.Recover_Token;");
+                  Indent_Line ("  Tokens  : in     
WisiToken.Recover_Token_Array)");
+                  Indent_Line (" return 
WisiToken.Semantic_Checks.Check_Status;");
+               end if;
+            end loop;
+         end if;
+      end loop;
+
+      Put_Raw_Code (Ada_Comment, Input_Data.Raw_Code (Actions_Spec_Post));
+
+      Put_Line ("end " & Package_Name & ";");
+      Close (Spec_File);
+      Set_Output (Standard_Output);
+
+   end Create_Ada_Actions_Spec;
+
+   procedure Create_Ada_Main_Spec
+     (Output_File_Name  : in String;
+      Main_Package_Name : in String;
+      Input_Data        : in WisiToken_Grammar_Runtime.User_Data_Type;
+      Common_Data       : in Output_Ada_Common.Common_Data)
+   is
+      Lower_Package_Name : constant String := To_Lower (Main_Package_Name);
+
+      Spec_File : File_Type;
+
+      procedure LR_Process
+      is begin
+         Indent_Line ("procedure Create_Parser");
+         if Input_Data.Language_Params.Error_Recover then
+            Indent_Line ("  (Parser                       :    out 
WisiToken.Parse.LR.Parser.Parser;");
+            Indent_Line ("   Language_Fixes               : in     
WisiToken.Parse.LR.Parser.Language_Fixes_Access;");
+            Indent_Line ("   Language_Use_Minimal_Complete_Actions : in");
+            Indent_Line ("  
WisiToken.Parse.LR.Parser.Language_Use_Minimal_Complete_Actions_Access;");
+            Indent_Line
+              ("   Language_String_ID_Set       : in     
WisiToken.Parse.LR.Parser.Language_String_ID_Set_Access;");
+         else
+            Indent_Line ("  (Parser                       :    out 
WisiToken.Parse.LR.Parser_No_Recover.Parser;");
+         end if;
+         Indent_Line ("   Trace                        : not null access 
WisiToken.Trace'Class;");
+         Indent_Start ("   User_Data                    : in     
WisiToken.Syntax_Trees.User_Data_Access");
+
+         if Common_Data.Text_Rep then
+            Put_Line (";");
+            Indent_Line ("   Text_Rep_File_Name : in String);");
+         else
+            Put_Line (");");
+         end if;
+         New_Line;
+      end LR_Process;
+
+      procedure Packrat_Process
+      is begin
+         Indent_Line ("function Create_Parser");
+         Indent_Line ("  (Trace     : not null access WisiToken.Trace'Class;");
+         Indent_Line ("   User_Data : in     
WisiToken.Syntax_Trees.User_Data_Access)");
+         Indent_Line ("  return WisiToken.Parse.Base_Parser'Class;");
+         New_Line;
+      end Packrat_Process;
+
+   begin
+      if Common_Data.Generate_Algorithm = External then
+         raise SAL.Programmer_Error;
+      end if;
+
+      Create (Spec_File, Out_File, Output_File_Name);
+      Set_Output (Spec_File);
+      Indent := 1;
+
+      Put_File_Header
+        (Ada_Comment, Use_Tuple => True, Tuple =>
+           (Common_Data.Generate_Algorithm, Common_Data.Output_Language, 
Common_Data.Lexer, Common_Data.Interface_Kind,
+            Common_Data.Text_Rep));
+      Put_Raw_Code (Ada_Comment, Input_Data.Raw_Code (Copyright_License));
+      New_Line;
+
+      case Common_Data.Output_Language is
+      when Ada_Lang =>
+         Put_Line ("with WisiToken.Syntax_Trees;");
+
+      when Ada_Emacs_Lang =>
+         case Common_Data.Interface_Kind is
+         when Process =>
+            Put_Line ("with WisiToken.Syntax_Trees;");
+
+         when Module =>
+            Put_Line ("with Emacs_Module_Aux;");
+            Put_Line ("with emacs_module_h;");
+            Put_Line ("with Interfaces.C;");
+            Put_Line ("with WisiToken.Semantic_State;");
+         end case;
+      end case;
+
+      case Common_Data.Generate_Algorithm is
+      when LR_Generate_Algorithm =>
+         if Input_Data.Language_Params.Error_Recover then
+            Put_Line ("with WisiToken.Parse.LR.Parser;");
+         else
+            Put_Line ("with WisiToken.Parse.LR.Parser_No_Recover;");
+         end if;
+
+      when Packrat_Generate_Algorithm =>
+         Put_Line ("with WisiToken.Parse;");
+
+      when External =>
+         null;
+      end case;
+
+      Put_Line ("package " & Main_Package_Name & " is");
+      Indent := Indent + 3;
+      New_Line;
+
+      case Common_Data.Output_Language is
+      when Ada_Lang =>
+         case Common_Data.Generate_Algorithm is
+         when LR_Generate_Algorithm =>
+            LR_Process;
+         when Packrat_Generate_Algorithm =>
+            Packrat_Process;
+         when External =>
+            null;
+         end case;
+
+      when Ada_Emacs_Lang =>
+         case Common_Data.Interface_Kind is
+         when Process =>
+            case Common_Data.Generate_Algorithm is
+            when LR_Generate_Algorithm =>
+               LR_Process;
+            when Packrat_Generate_Algorithm =>
+               Packrat_Process;
+            when External =>
+               null;
+            end case;
+
+         when Module =>
+            Indent_Line ("function Parse (Env : 
Emacs_Module_Aux.Emacs_Env_Access) return emacs_module_h.emacs_value;");
+            Indent_Line ("pragma Export (C, Parse, """ & Lower_Package_Name & 
"_wisi_module_parse"");");
+            Indent_Line ("function Init (Env : 
Emacs_Module_Aux.Emacs_Env_Access) return Interfaces.C.int;");
+            Indent_Line ("pragma Export (C, Init, """ & Lower_Package_Name & 
"_wisi_module_parse_init"");");
+            New_Line;
+
+         end case;
+      end case;
+
+      Put_Line ("end " & Main_Package_Name & ";");
+      Close (Spec_File);
+      Set_Output (Standard_Output);
+   end Create_Ada_Main_Spec;
+
+   procedure Create_External_Main_Spec
+     (Main_Package_Name    : in String;
+      Tuple                : in Generate_Tuple;
+      Input_Data           : in WisiToken_Grammar_Runtime.User_Data_Type)
+   is
+      File_Name : constant String := To_Lower (Main_Package_Name) & ".ads";
+      Spec_File : File_Type;
+   begin
+      Create (Spec_File, Out_File, File_Name);
+      Set_Output (Spec_File);
+      Indent := 1;
+
+      Put_File_Header (Ada_Comment, Use_Tuple => True, Tuple => Tuple);
+      Put_Raw_Code (Ada_Comment, Input_Data.Raw_Code (Copyright_License));
+      New_Line;
+
+      Put_Line ("with WisiToken.Productions;");
+      Put_Line ("package " & Main_Package_Name & " is");
+      Indent := Indent + 3;
+      New_Line;
+
+      Indent_Line ("function Create_Grammar return 
WisiToken.Productions.Prod_Arrays.Vector;");
+
+      Indent := Indent - 3;
+      Put_Line ("end " & Main_Package_Name & ";");
+      Close (Spec_File);
+      Set_Output (Standard_Output);
+   end Create_External_Main_Spec;
+
+   procedure Create_LR_Parser_Core_1
+     (Common_Data   : in Output_Ada_Common.Common_Data;
+      Generate_Data : in WisiToken.BNF.Generate_Utils.Generate_Data)
+   is
+      use Ada.Strings.Unbounded;
+      use all type Ada.Containers.Count_Type;
+
+      subtype Nonterminal_ID is Token_ID range
+        Generate_Data.Grammar.First_Index .. Generate_Data.Grammar.Last_Index;
+
+      Table : WisiToken.Parse.LR.Parse_Table_Ptr renames 
Generate_Data.LR_Parse_Table;
+      Line  : Unbounded_String;
+
+      procedure Append (Item : in String)
+      is begin
+         Line := Line & Item;
+      end Append;
+
+      procedure Put (Label : in String; Item : in Token_ID_Array_Natural)
+      is begin
+         Indent_Line (Label & " =>");
+         Indent_Start ("  (");
+         Indent := Indent + 3;
+         Line := +"";
+         for I in Item'Range loop
+            Append (Trimmed_Image (Item (I)));
+
+            if I = Item'Last then
+               Append ("),");
+
+            else
+               Append (", ");
+            end if;
+         end loop;
+         Indent_Wrap (-Line);
+         Indent := Indent - 3;
+      end Put;
+
+   begin
+      Indent_Line ("McKenzie_Param : constant McKenzie_Param_Type :=");
+      Indent_Line ("  (First_Terminal    =>" & Token_ID'Image 
(Table.McKenzie_Param.First_Terminal) & ",");
+      Indent := Indent + 3;
+      Indent_Line ("Last_Terminal     =>" & Token_ID'Image 
(Table.McKenzie_Param.Last_Terminal) & ",");
+      Indent_Line ("First_Nonterminal =>" & Token_ID'Image 
(Table.McKenzie_Param.First_Nonterminal) & ",");
+      Indent_Line ("Last_Nonterminal  =>" & Token_ID'Image 
(Table.McKenzie_Param.Last_Nonterminal) & ",");
+      Put ("Insert", Table.McKenzie_Param.Insert);
+      Put ("Delete", Table.McKenzie_Param.Delete);
+      Put ("Push_Back", Table.McKenzie_Param.Push_Back);
+      Indent_Line ("Ignore_Check_Fail  =>" & Integer'Image 
(Table.McKenzie_Param.Ignore_Check_Fail) & ",");
+      Indent_Line ("Task_Count  =>" & System.Multiprocessors.CPU_Range'Image
+                     (Table.McKenzie_Param.Task_Count) & ",");
+      Indent_Line ("Cost_Limit  =>" & Integer'Image 
(Table.McKenzie_Param.Cost_Limit) & ",");
+      Indent_Line ("Check_Limit =>" & Token_Index'Image 
(Table.McKenzie_Param.Check_Limit) & ",");
+      Indent_Line ("Check_Delta_Limit =>" & Integer'Image 
(Table.McKenzie_Param.Check_Delta_Limit) & ",");
+      Indent_Line ("Enqueue_Limit =>" & Integer'Image 
(Table.McKenzie_Param.Enqueue_Limit) & ");");
+      Indent := Indent - 3;
+      New_Line;
+
+      if Common_Data.Text_Rep then
+         Indent_Line ("function Productions return 
WisiToken.Productions.Prod_Arrays.Vector");
+         Indent_Line ("is begin");
+         Indent := Indent + 3;
+         Indent_Line ("return Prods : WisiToken.Productions.Prod_Arrays.Vector 
do");
+         Indent := Indent + 3;
+         Indent_Line
+           ("Prods.Set_First (" & Trimmed_Image 
(Generate_Data.Grammar.First_Index) & ");");
+         Indent_Line
+           ("Prods.Set_Last (" & Trimmed_Image 
(Generate_Data.Grammar.Last_Index) & ");");
+
+         for I in Nonterminal_ID loop
+            declare
+               P : Productions.Instance renames Generate_Data.Grammar (I);
+            begin
+               Indent_Line
+                 ("Set_Production (Prods (" & Trimmed_Image (P.LHS) & "), " &
+                    Trimmed_Image (P.LHS) & "," & Integer'Image 
(P.RHSs.Last_Index) & ");");
+
+               for J in P.RHSs.First_Index .. P.RHSs.Last_Index loop
+                  Line := +"Set_RHS (Prods (" & Trimmed_Image (P.LHS) & ")," & 
Natural'Image (J) & ", (";
+                  declare
+                     RHS : Productions.Right_Hand_Side renames P.RHSs (J);
+                  begin
+                     if RHS.Tokens.Length = 0 then
+                        Append ("1 .. 0 => <>");
+                     elsif RHS.Tokens.Length = 1 then
+                        Append ("1 => " & Trimmed_Image (RHS.Tokens (1)));
+                     else
+                        for I in RHS.Tokens.First_Index .. 
RHS.Tokens.Last_Index loop
+                           Append (Trimmed_Image (RHS.Tokens (I)));
+                           if I < RHS.Tokens.Last_Index then
+                              Append (", ");
+                           end if;
+                        end loop;
+                     end if;
+
+                     Append ("), ");
+                     Append
+                       ((if Generate_Data.Action_Names (P.LHS) = null then 
"null"
+                         elsif Generate_Data.Action_Names (P.LHS)(J) = null 
then "null"
+                         else Generate_Data.Action_Names (P.LHS)(J).all & 
"'Access"));
+                     Append (", ");
+                     Append
+                       ((if Generate_Data.Check_Names (P.LHS) = null then 
"null"
+                         elsif Generate_Data.Check_Names (P.LHS)(J) = null 
then "null"
+                         else Generate_Data.Check_Names (P.LHS)(J).all & 
"'Access"));
+                  end;
+                  Append (");");
+                  Indent_Wrap (-Line);
+               end loop;
+            end;
+         end loop;
+         Indent := Indent - 3;
+         Indent_Line ("end return;");
+         Indent := Indent - 3;
+         Indent_Line ("end Productions;");
+         New_Line;
+      end if;
+   end Create_LR_Parser_Core_1;
+
+   procedure Create_LR_Parser_Table
+     (Input_Data    : in WisiToken_Grammar_Runtime.User_Data_Type;
+      Generate_Data : in WisiToken.BNF.Generate_Utils.Generate_Data)
+   is
+      use all type Ada.Containers.Count_Type;
+      use Ada.Strings.Unbounded;
+
+      Table            : WisiToken.Parse.LR.Parse_Table_Ptr renames 
Generate_Data.LR_Parse_Table;
+      Lines_Per_Subr   : constant := 1000;
+      Subr_Count       : Integer  := 1;
+      Last_Subr_Closed : Boolean  := False;
+      Line             : Unbounded_String;
+
+      procedure Append (Item : in String)
+      is begin
+         Line := Line & Item;
+      end Append;
+   begin
+      --  Optimize source structure for GNAT compile time; one subroutine
+      --  with thousands of "Table.States (*) := ..." takes forever to
+      --  compile (apparently depending on available memory). But hundreds
+      --  of subroutines, containing the same lines in chunks of 1000,
+      --  compiles in acceptable time.
+
+      Indent_Line ("declare");
+      Indent := Indent + 3;
+
+      Indent_Line ("procedure Subr_" & Trimmed_Image (Subr_Count));
+      Indent_Line ("is begin");
+      Indent     := Indent + 3;
+      Line_Count := 0;
+
+      Declare_Subroutines :
+      for State_Index in Table.States'Range loop
+
+         if Input_Data.Language_Params.Error_Recover then
+            Indent_Wrap
+              ("Table.States (" & Trimmed_Image (State_Index) & ").Productions 
:= WisiToken.To_Vector (" &
+                 Image (Table.States (State_Index).Productions, Strict => 
True) & ");");
+         end if;
+
+         Actions :
+         declare
+            use Ada.Containers;
+            use WisiToken.Parse.LR;
+            Base_Indent : constant Ada.Text_IO.Count := Indent;
+            Node        : Action_Node_Ptr := Table.States 
(State_Index).Action_List;
+         begin
+            if Duplicate_Reduce (Table.States (State_Index)) then
+               declare
+                  Action : constant Reduce_Action_Rec := Node.Action.Item;
+               begin
+                  Set_Col (Indent);
+                  Line := +"Add_Action (Table.States (" & Trimmed_Image 
(State_Index) & "), " &
+                    Symbols_Image (Table.States (State_Index)) & ", " &
+                    Image (Action.Production) & "," &
+                    Count_Type'Image (Action.Token_Count) & ", ";
+
+                  Append
+                    ((if Generate_Data.Action_Names (Action.Production.LHS) = 
null then "null"
+                      elsif Generate_Data.Action_Names
+                        (Action.Production.LHS)(Action.Production.RHS) = null 
then "null"
+                      else Generate_Data.Action_Names
+                        (Action.Production.LHS)(Action.Production.RHS).all & 
"'Access"));
+                  Append (", ");
+                  Append
+                    ((if Generate_Data.Check_Names (Action.Production.LHS) = 
null then "null"
+                      elsif Generate_Data.Check_Names
+                        (Action.Production.LHS)(Action.Production.RHS) = null 
then "null"
+                      else Generate_Data.Check_Names
+                        (Action.Production.LHS)(Action.Production.RHS).all & 
"'Access"));
+
+                  Indent_Wrap (-Line & ");");
+                  Line_Count := Line_Count + 1;
+                  Indent     := Base_Indent;
+               end;
+
+            else
+               loop
+                  exit when Node = null;
+                  Set_Col (Indent);
+                  declare
+                     Action_Node : Parse_Action_Node_Ptr := Node.Action;
+                  begin
+                     case Action_Node.Item.Verb is
+                     when Shift =>
+                        Line := +"Add_Action (Table.States (" & Trimmed_Image 
(State_Index) & "), " &
+                          Trimmed_Image (Node.Symbol);
+                        Append (", ");
+                        Append (Trimmed_Image (Action_Node.Item.State));
+
+                     when Reduce | Accept_It =>
+                        Line := +"Add_Action (Table.States (" & Trimmed_Image 
(State_Index) & "), " &
+                          Trimmed_Image (Node.Symbol);
+                        if Action_Node.Item.Verb = Reduce then
+                           Append (", Reduce");
+                        else
+                           Append (", Accept_It");
+                        end if;
+                        Append (", ");
+                        Append (Image (Action_Node.Item.Production) & ",");
+                        Append (Count_Type'Image 
(Action_Node.Item.Token_Count) & ", ");
+                        Append
+                          ((if Generate_Data.Action_Names 
(Action_Node.Item.Production.LHS) = null then "null"
+                            elsif Generate_Data.Action_Names
+                              
(Action_Node.Item.Production.LHS)(Action_Node.Item.Production.RHS) = null
+                            then "null"
+                            else Generate_Data.Action_Names
+                              
(Action_Node.Item.Production.LHS)(Action_Node.Item.Production.RHS).all &
+                               "'Access"));
+                        Append (", ");
+                        Append
+                          ((if Generate_Data.Check_Names 
(Action_Node.Item.Production.LHS) = null then "null"
+                            elsif Generate_Data.Check_Names
+                              
(Action_Node.Item.Production.LHS)(Action_Node.Item.Production.RHS) = null
+                            then "null"
+                            else Generate_Data.Check_Names
+                              
(Action_Node.Item.Production.LHS)(Action_Node.Item.Production.RHS).all &
+                               "'Access"));
+
+                     when Parse.LR.Error =>
+                        Line := +"Add_Error (Table.States (" & Trimmed_Image 
(State_Index) & ")";
+                     end case;
+
+                     Action_Node := Action_Node.Next;
+                     if Action_Node /= null then
+                        --  There is a conflict; must be Shift/{Reduce|Accept} 
or Reduce/{Reduce|Accept}.
+                        --  The added parameters are the same in either case.
+                        case Action_Node.Item.Verb is
+                        when Reduce | Accept_It =>
+                           Append (", ");
+                           Append (Image (Action_Node.Item.Production) & ",");
+                           Append (Count_Type'Image 
(Action_Node.Item.Token_Count) & ", ");
+                           Append
+                             ((if Generate_Data.Action_Names 
(Action_Node.Item.Production.LHS) = null then "null"
+                               elsif Generate_Data.Action_Names
+                                 
(Action_Node.Item.Production.LHS)(Action_Node.Item.Production.RHS) = null
+                               then "null"
+                               else Generate_Data.Action_Names
+                                 
(Action_Node.Item.Production.LHS)(Action_Node.Item.Production.RHS).all &
+                                  "'Access"));
+                           Append (", ");
+                           Append
+                             ((if Generate_Data.Check_Names 
(Action_Node.Item.Production.LHS) = null then "null"
+                               elsif Generate_Data.Check_Names
+                                 
(Action_Node.Item.Production.LHS)(Action_Node.Item.Production.RHS) = null
+                               then "null"
+                               else Generate_Data.Check_Names
+                                 
(Action_Node.Item.Production.LHS)(Action_Node.Item.Production.RHS).all &
+                                  "'Access"));
+
+                        when others =>
+                           raise SAL.Programmer_Error with "conflict second 
action verb: " &
+                             Parse.LR.Parse_Action_Verbs'Image 
(Action_Node.Item.Verb);
+                        end case;
+                     end if;
+                  end;
+                  Indent_Wrap (-Line & ");");
+                  Line_Count := Line_Count + 1;
+                  Indent     := Base_Indent;
+                  Node       := Node.Next;
+               end loop;
+            end if;
+         end Actions;
+
+         Gotos :
+         declare
+            use WisiToken.Parse.LR;
+            Node : Goto_Node_Ptr := Table.States (State_Index).Goto_List;
+         begin
+            loop
+               exit when Node = null;
+               Set_Col (Indent);
+               Put ("Add_Goto (Table.States (" & Trimmed_Image (State_Index) & 
"), ");
+               Put_Line (Trimmed_Image (Symbol (Node)) & ", " & Trimmed_Image 
(State (Node)) & ");");
+               Line_Count := Line_Count + 1;
+               Node := Next (Node);
+            end loop;
+         end Gotos;
+
+         if Table.States (State_Index).Minimal_Complete_Actions.Length > 0 then
+            Indent_Wrap
+              ("Set_Minimal_Action (Table.States (" & Trimmed_Image 
(State_Index) & ").Minimal_Complete_Actions, " &
+                 WisiToken.Parse.LR.Image (Table.States 
(State_Index).Minimal_Complete_Actions, Strict => True) & ");");
+         end if;
+
+         if Line_Count > Lines_Per_Subr then
+            Line_Count := 0;
+            Indent := Indent - 3;
+            Indent_Line ("end Subr_" & Trimmed_Image (Subr_Count) & ";");
+
+            if State_Index < Table.States'Last then
+               Subr_Count := Subr_Count + 1;
+               Last_Subr_Closed := False;
+               Indent_Line ("procedure Subr_" & Trimmed_Image (Subr_Count));
+               Indent_Line ("is begin");
+               Indent := Indent + 3;
+            else
+               Last_Subr_Closed := True;
+            end if;
+         end if;
+
+      end loop Declare_Subroutines;
+
+      if not Last_Subr_Closed then
+         Indent := Indent - 3;
+         Indent_Line ("end Subr_" & Trimmed_Image (Subr_Count) & ";");
+      end if;
+
+      Indent := Indent - 3;
+      Indent_Line ("begin");
+      Indent := Indent + 3;
+
+      for Subr in 1 .. Subr_Count loop
+         Indent_Line ("Subr_" & Trimmed_Image (Subr) & ";");
+      end loop;
+      Indent := Indent - 3;
+      Indent_Line ("end;");
+   end Create_LR_Parser_Table;
+
+   procedure LR_Create_Create_Parser
+     (Input_Data    :         in     WisiToken_Grammar_Runtime.User_Data_Type;
+      Common_Data   :         in out Output_Ada_Common.Common_Data;
+      Generate_Data : aliased in     
WisiToken.BNF.Generate_Utils.Generate_Data)
+   is
+      Table : WisiToken.Parse.LR.Parse_Table_Ptr renames 
Generate_Data.LR_Parse_Table;
+   begin
+      Indent_Line ("procedure Create_Parser");
+      case Common_Data.Interface_Kind is
+      when Process =>
+         if Input_Data.Language_Params.Error_Recover then
+            Indent_Line ("  (Parser                       :    out 
WisiToken.Parse.LR.Parser.Parser;");
+            Indent_Line ("   Language_Fixes               : in     
WisiToken.Parse.LR.Parser.Language_Fixes_Access;");
+            Indent_Line ("   Language_Use_Minimal_Complete_Actions : in");
+            Indent_Line ("  
WisiToken.Parse.LR.Parser.Language_Use_Minimal_Complete_Actions_Access;");
+            Indent_Line
+              ("   Language_String_ID_Set       : in     
WisiToken.Parse.LR.Parser.Language_String_ID_Set_Access;");
+         else
+            Indent_Line ("  (Parser                       :    out 
WisiToken.Parse.LR.Parser_No_Recover.Parser;");
+         end if;
+         Indent_Line ("   Trace                        : not null access 
WisiToken.Trace'Class;");
+         Indent_Start ("   User_Data                    : in     
WisiToken.Syntax_Trees.User_Data_Access");
+
+      when Module =>
+         Indent_Line ("  (Parser              :    out 
WisiToken.Parse.LR.Parser.Parser;");
+         Indent_Line ("   Env                 : in     Emacs_Env_Access;");
+         Indent_Start ("   Lexer_Elisp_Symbols : in     
Lexers.Elisp_Array_Emacs_Value");
+      end case;
+
+      if Common_Data.Text_Rep then
+         Put_Line (";");
+         Indent_Line ("   Text_Rep_File_Name : in String)");
+      else
+         Put_Line (")");
+      end if;
+
+      Indent_Line ("is");
+      Indent := Indent + 3;
+
+      Indent_Line ("use WisiToken.Parse.LR;");
+
+      if Common_Data.Text_Rep then
+         Create_LR_Parser_Core_1 (Common_Data, Generate_Data);
+         Indent_Line ("Table : constant Parse_Table_Ptr := Get_Text_Rep");
+         Indent_Line ("  (Text_Rep_File_Name, McKenzie_Param, Productions);");
+         Indent := Indent - 3;
+         Indent_Line ("begin");
+         Indent := Indent + 3;
+
+      else
+         if Input_Data.Language_Params.Error_Recover then
+            Create_LR_Parser_Core_1 (Common_Data, Generate_Data);
+         end if;
+
+         Indent_Line ("Table : constant Parse_Table_Ptr := new Parse_Table");
+         Indent_Line ("  (State_First       => 0,");
+         Indent := Indent + 3;
+         Indent_Line ("State_Last        =>" & State_Index'Image 
(Table.State_Last) & ",");
+         Indent_Line ("First_Terminal    =>" & Token_ID'Image 
(Table.First_Terminal) & ",");
+         Indent_Line ("Last_Terminal     =>" & Token_ID'Image 
(Table.Last_Terminal) & ",");
+         Indent_Line ("First_Nonterminal =>" & Token_ID'Image 
(Table.First_Nonterminal) & ",");
+         Indent_Line ("Last_Nonterminal  =>" & Token_ID'Image 
(Table.Last_Nonterminal) & ");");
+         Indent := Indent - 3;
+
+         Indent := Indent - 3;
+         Indent_Line ("begin");
+         Indent := Indent + 3;
+         if Input_Data.Language_Params.Error_Recover then
+            Indent_Line ("Table.McKenzie_Param := McKenzie_Param;");
+         end if;
+         Create_LR_Parser_Table (Input_Data, Generate_Data);
+         New_Line;
+      end if;
+
+      if Input_Data.Language_Params.Error_Recover then
+         Indent_Line ("WisiToken.Parse.LR.Parser.New_Parser");
+      else
+         Indent_Line ("WisiToken.Parse.LR.Parser_No_Recover.New_Parser");
+      end if;
+      Indent_Line ("  (Parser,");
+      case Common_Data.Interface_Kind is
+      when Process =>
+         Indent_Line ("   Trace,");
+         Indent_Line ("   Lexer.New_Lexer (Trace),");
+         Indent_Line ("   Table,");
+         if Input_Data.Language_Params.Error_Recover then
+            Indent_Line ("   Language_Fixes,");
+            Indent_Line ("   Language_Use_Minimal_Complete_Actions,");
+            Indent_Line ("   Language_String_ID_Set,");
+         end if;
+         Indent_Line ("   User_Data,");
+         Indent_Line ("   Max_Parallel         => 15,");
+         Indent_Line ("   Terminate_Same_State => True);");
+
+      when Module =>
+         Indent_Line ("   Lexer.New_Lexer (Env, Lexer_Elisp_Symbols),");
+         Indent_Line ("   Table, Max_Parallel => 15, Terminate_Same_State => 
True);");
+
+      end case;
+      Indent := Indent - 3;
+      Indent_Line ("end Create_Parser;");
+   end LR_Create_Create_Parser;
+
+   procedure Packrat_Create_Create_Parser
+     (Common_Data   :         in out Output_Ada_Common.Common_Data;
+      Generate_Data : aliased in     
WisiToken.BNF.Generate_Utils.Generate_Data;
+      Packrat_Data  :         in     WisiToken.Generate.Packrat.Data)
+   is
+      use Ada.Strings.Unbounded;
+
+      Text     : Unbounded_String;
+      Need_Bar : Boolean := True;
+   begin
+      Indent_Line ("function Create_Parser");
+      Indent_Line ("  (Trace     : not null access WisiToken.Trace'Class;");
+      Indent_Line ("   User_Data : in     
WisiToken.Syntax_Trees.User_Data_Access)");
+      Indent_Line ("  return WisiToken.Parse.Base_Parser'Class");
+
+      case Packrat_Generate_Algorithm'(Common_Data.Generate_Algorithm) is
+      when Packrat_Gen =>
+         Indent_Line ("is begin");
+         Indent := Indent + 3;
+         Indent_Line ("return Parser : 
WisiToken.Parse.Packrat.Generated.Parser do");
+         Indent := Indent + 3;
+         Indent_Line ("Parser.Trace := Trace;");
+         Indent_Line ("Parser.Lexer := Lexer.New_Lexer (Trace);");
+         Indent_Line ("Parser.User_Data := User_Data;");
+         Indent_Line ("Parser.Parse_WisiToken_Accept := 
Parse_wisitoken_accept_1'Access;");
+         Indent := Indent - 3;
+         Indent_Line ("end return;");
+
+      when Packrat_Proc =>
+         Indent_Line ("is");
+         Indent := Indent + 3;
+         Indent_Line ("use WisiToken;");
+         Indent_Line ("use WisiToken.Productions;");
+         Indent_Line ("Grammar               : Prod_Arrays.Vector;");
+         Indent_Line
+           ("Direct_Left_Recursive : constant WisiToken.Token_ID_Set (" &
+              Trimmed_Image (Generate_Data.Grammar.First_Index) & " .. " &
+              Trimmed_Image (Generate_Data.Grammar.Last_Index) & ") :=");
+
+         Need_Bar := False;
+         if Any (Packrat_Data.Direct_Left_Recursive) then
+            for I in Packrat_Data.Direct_Left_Recursive'Range loop
+               if Packrat_Data.Direct_Left_Recursive (I) then
+                  if Need_Bar then
+                     Text := Text & " | ";
+                  else
+                     Need_Bar := True;
+                  end if;
+                  Text := Text & Trimmed_Image (I);
+               end if;
+            end loop;
+            Indent_Start ("  (");
+            Indent := Indent + 3;
+            Indent_Wrap (-Text & " => True,");
+            Indent_Line ("others => False);");
+            Indent := Indent - 3;
+         else
+            Indent_Line ("  (others => False);");
+         end if;
+         Indent := Indent - 3;
+         Indent_Line ("begin");
+         Indent := Indent + 3;
+         WisiToken.BNF.Generate_Grammar (Generate_Data.Grammar, 
Generate_Data.Action_Names.all);
+
+         Indent_Line ("return WisiToken.Parse.Packrat.Procedural.Create");
+         Indent_Line
+           ("  (Grammar, Direct_Left_Recursive, " & Trimmed_Image 
(Generate_Data.Descriptor.Accept_ID) &
+              ", Trace, Lexer.New_Lexer (Trace), User_Data);");
+      end case;
+      Indent := Indent - 3;
+      Indent_Line ("end Create_Parser;");
+      New_Line;
+   end Packrat_Create_Create_Parser;
+
+   procedure External_Create_Create_Grammar
+     (Generate_Data : in WisiToken.BNF.Generate_Utils.Generate_Data)
+   is begin
+      Indent_Line ("function Create_Grammar return 
WisiToken.Productions.Prod_Arrays.Vector");
+      Indent_Line ("is");
+      Indent_Line ("   use WisiToken;");
+      Indent_Line ("   use WisiToken.Productions;");
+      Indent_Line ("begin");
+      Indent := Indent + 3;
+      Indent_Line ("return Grammar : WisiToken.Productions.Prod_Arrays.Vector 
do");
+      Indent := Indent + 3;
+      WisiToken.BNF.Generate_Grammar (Generate_Data.Grammar, 
Generate_Data.Action_Names.all);
+      Indent := Indent - 3;
+      Indent_Line ("end return;");
+      Indent := Indent - 3;
+      Indent_Line ("end Create_Grammar;");
+   end External_Create_Create_Grammar;
+
+   procedure Create_re2c
+     (Input_Data            :         in 
WisiToken_Grammar_Runtime.User_Data_Type;
+      Tuple                 :         in Generate_Tuple;
+      Generate_Data         : aliased in 
WisiToken.BNF.Generate_Utils.Generate_Data;
+      Output_File_Name_Root :         in String;
+      Elisp_Regexps         :         in WisiToken.BNF.String_Pair_Lists.List)
+   is
+      use Ada.Strings.Fixed;
+      use Generate_Utils;
+      use WisiToken.BNF.Utils;
+      File : File_Type;
+   begin
+      Create (File, Out_File, Output_File_Name_Root & ".re2c");
+      Set_Output (File);
+      Indent := 1;
+
+      Put_File_Header (C_Comment, " -*- mode: C -*-", Use_Tuple => True, Tuple 
=> Tuple);
+      Put_Raw_Code (C_Comment, Input_Data.Raw_Code (Copyright_License));
+      New_Line;
+
+      Indent_Line ("#include <stddef.h>"); -- size_t
+      Indent_Line ("#include <stdio.h>"); -- printf
+      Indent_Line ("#include <stdlib.h>"); -- malloc
+      New_Line;
+
+      Indent_Line ("typedef struct wisi_lexer");
+      Indent_Line ("{");
+      Indent := Indent + 3;
+      Indent_Line ("unsigned char* buffer;           // input text, in utf-8 
encoding");
+      Indent_Line ("unsigned char* buffer_last;      // last byte in buffer");
+      Indent_Line ("unsigned char* cursor;           // current byte");
+      Indent_Line ("unsigned char* byte_token_start; // byte position at start 
of current token");
+      Indent_Line ("size_t         char_pos;         // character position of 
current character");
+      Indent_Line ("size_t         char_token_start; // character position at 
start of current token");
+      Indent_Line ("int            line;             // 1 indexed");
+      Indent_Line ("int            line_token_start; // line at start of 
current token");
+      Indent_Line ("unsigned char* marker;           // saved cursor");
+      Indent_Line ("size_t         marker_pos;       // saved character 
position");
+      Indent_Line ("size_t         marker_line;      // saved line ");
+      Indent_Line ("unsigned char* context;          // saved cursor");
+      Indent_Line ("size_t         context_pos;      // saved character 
position");
+      Indent_Line ("int            context_line;     // saved line");
+      Indent_Line ("int            verbosity;");
+      New_Line;
+      Indent := Indent - 3;
+      Indent_Line ("} wisi_lexer;");
+      New_Line;
+      Indent_Line ("#define YYCTYPE unsigned char");
+      New_Line;
+
+      --  Status values:
+      Indent_Line ("#define NO_ERROR 0");
+      Indent_Line ("#define ERROR_unrecognized_character 1");
+
+      ----------
+      --  new_lexer, free_lexer, reset_lexer
+
+      --  It's normal to increment lexer->cursor one past the end of input,
+      --  but not to read that character. To support memory mapped files, we
+      --  enforce this strictly; YYPEEK returns EOT (end of text) when
+      --  reading past end of buffer; that's how we recognize the end of
+      --  text token.
+
+      Indent_Line ("wisi_lexer* " & Output_File_Name_Root & "_new_lexer");
+      Indent_Line ("   (unsigned char* input, size_t length, int verbosity)");
+      Indent_Line ("{");
+      Indent := Indent + 3;
+      Indent_Line ("wisi_lexer* result  = malloc (sizeof (wisi_lexer));");
+      Indent_Line ("result->buffer      = input;");
+      Indent_Line ("result->buffer_last = input + length - 1;");
+      Indent_Line ("result->cursor      = input;");
+      Indent_Line ("result->char_pos    = 1;");
+      Indent_Line ("result->line        = (*result->cursor == 0x0A) ? 2 : 1;");
+      Indent_Line ("result->verbosity   = verbosity;");
+      Indent_Line ("return result;");
+      Indent := Indent - 3;
+      Indent_Line ("}");
+      New_Line;
+
+      Indent_Line ("void");
+      Indent_Line (Output_File_Name_Root & "_free_lexer(wisi_lexer** lexer)");
+      Indent_Line ("{");
+      Indent := Indent + 3;
+      Indent_Line ("free(*lexer);");
+      Indent_Line ("*lexer = 0;");
+      Indent := Indent - 3;
+      Indent_Line ("}");
+      New_Line;
+
+      Indent_Line ("void");
+      Indent_Line (Output_File_Name_Root & "_reset_lexer(wisi_lexer* lexer)");
+      Indent_Line ("{");
+      Indent := Indent + 3;
+      Indent_Line ("lexer->cursor   = lexer->buffer;");
+      Indent_Line ("lexer->char_pos = 1;");
+      Indent_Line ("lexer->line     = (*lexer->cursor == 0x0A) ? 2 : 1;");
+      Indent := Indent - 3;
+      Indent_Line ("}");
+      New_Line;
+
+      ----------
+      --  next_token utils
+
+      Indent_Line ("static void debug(wisi_lexer* lexer, int state, unsigned 
char ch)");
+      Indent_Line ("{");
+      Indent := Indent + 3;
+      Indent_Line ("if (lexer->verbosity > 0)");
+      Indent_Line ("   {");
+      Indent_Line ("   if (ch < ' ')");
+      Indent_Line ("      printf (""lexer: %d, 0x%x\n"", state, ch);");
+      Indent_Line ("   else");
+      Indent_Line ("      printf (""lexer: %d, '%c' 0x%x\n"", state, ch, 
ch);");
+      Indent_Line ("   }");
+      Indent := Indent - 3;
+      Indent_Line ("}");
+      Indent_Line ("#define YYDEBUG(state, ch) debug(lexer, state, ch)");
+
+      --  YYCURSOR is only used in calls of YYDEBUG; we can't define it as
+      --  YYPEEK because it is used as '*YYCURSOR'.
+      Indent_Line ("#define YYCURSOR lexer->cursor");
+      New_Line;
+
+      Indent_Line ("#define YYPEEK() (lexer->cursor <= lexer->buffer_last) ? 
*lexer->cursor : 4");
+      New_Line;
+
+      --  Don't count UTF-8 continuation bytes, or first byte of DOS newline
+      Indent_Line ("#define DO_COUNT ((*lexer->cursor & 0xC0) != 0xC0) && 
(*lexer->cursor != 0x0D)");
+      New_Line;
+
+      Indent_Line ("static void skip(wisi_lexer* lexer)");
+      Indent_Line ("{");
+      Indent := Indent + 3;
+      Indent_Line ("if (lexer->cursor <= lexer->buffer_last) 
++lexer->cursor;");
+      Indent_Line ("if (lexer->cursor <= lexer->buffer_last)");
+      Indent_Line ("   if (DO_COUNT) ++lexer->char_pos;");
+      Indent_Line ("if (*lexer->cursor == 0x0A) ++lexer->line;");
+      Indent := Indent - 3;
+      Indent_Line ("}");
+      Indent_Start ("#define YYSKIP() skip(lexer)");
+      New_Line;
+
+      Indent_Line ("#define YYBACKUP() lexer->marker = lexer->cursor; 
lexer->marker_pos = lexer->char_pos;" &
+                     "lexer->marker_line = lexer->line");
+      Indent_Line ("#define YYRESTORE() lexer->cursor = lexer->marker; 
lexer->char_pos = lexer->marker_pos;" &
+                     "lexer->line = lexer->marker_line");
+      Indent_Line ("#define YYBACKUPCTX() lexer->context = lexer->cursor; 
lexer->context_pos = lexer->char_pos;" &
+                     "lexer->context_line = lexer->line");
+      Indent_Line ("#define YYRESTORECTX() lexer->cursor = lexer->context; 
lexer->char_pos = lexer->context_pos;" &
+                     "lexer->line = lexer->context_line");
+      New_Line;
+
+      if Is_In (Input_Data.Tokens.Tokens, "delimited-text") then
+         Indent_Line ("static void skip_to(wisi_lexer* lexer, char* target)");
+         Indent_Line ("{");
+         Indent_Line ("  int i;");
+         New_Line;
+         Indent_Line ("  while (lexer->cursor <= lexer->buffer_last)");
+         Indent_Line ("    {");
+         Indent_Line ("      if (*lexer->cursor == target[0])");
+         Indent_Line ("      {");
+         Indent_Line ("        i = 0;");
+         Indent_Line ("        do");
+         Indent_Line ("          i++;");
+         Indent_Line ("        while (0 != target[i] &&");
+         Indent_Line ("               lexer->cursor + i <= lexer->buffer_last 
&&");
+         Indent_Line ("               *(lexer->cursor + i) == target[i]);");
+         New_Line;
+         Indent_Line ("        if (0 == target[i])");
+         Indent_Line ("          {");
+         Indent_Line ("            for (i = 0; 0 != target[i]; i++)");
+         Indent_Line ("               skip(lexer);");
+         Indent_Line ("            break;");
+         Indent_Line ("          }");
+         Indent_Line ("      }");
+         Indent_Line ("      skip(lexer);");
+         Indent_Line ("    };");
+         Indent_Line ("}");
+         New_Line;
+      end if;
+
+      ----------
+      --  next_token
+      Indent_Line ("int " & Output_File_Name_Root & "_next_token");
+      Indent_Line ("  (wisi_lexer* lexer,");
+      Indent_Line ("   int* id,");
+      Indent_Line ("   size_t* byte_position,");
+      Indent_Line ("   size_t* byte_length,");
+      Indent_Line ("   size_t* char_position,");
+      Indent_Line ("   size_t* char_length,");
+      Indent_Line ("   int*    line_start)");
+      Indent_Line ("{");
+      Indent := Indent + 3;
+
+      Indent_Line ("int status = NO_ERROR;");
+      Indent_Line ("*id = -1;"); --  Token_ID'First = 0; see dragon_4_43.wy
+
+      Indent_Line ("if (lexer->cursor > lexer->buffer_last)");
+      Indent_Line ("{");
+      Indent := Indent + 3;
+      Indent_Line ("*id            =" & WisiToken.Token_ID'Image 
(Generate_Data.Descriptor.EOF_ID) & ";");
+      Indent_Line ("*byte_position = lexer->buffer_last - lexer->buffer + 1;");
+      Indent_Line ("*byte_length   = 0;");
+      Indent_Line ("*char_position = lexer->char_token_start;");
+      Indent_Line ("*char_length   = 0;");
+      Indent_Line ("*line_start    = lexer->line;");
+      Indent_Line ("return status;");
+      Indent := Indent - 3;
+      Indent_Line ("}");
+      New_Line;
+
+      Indent_Line ("lexer->byte_token_start = lexer->cursor;");
+      Indent_Line ("if (DO_COUNT)");
+      Indent_Line ("   lexer->char_token_start = lexer->char_pos;");
+      Indent_Line ("else");
+      Indent_Line ("   lexer->char_token_start = lexer->char_pos + 1;");
+      Indent_Line ("if (*lexer->cursor == 0x0A)");
+      Indent_Line ("   lexer->line_token_start = lexer->line-1;");
+      Indent_Line ("else");
+      Indent_Line ("   lexer->line_token_start = lexer->line;");
+      New_Line;
+
+      Indent_Line ("while (*id == -1 && status == 0)");
+      Indent_Line ("{");
+      Indent := Indent + 3;
+
+      Put_Line ("/*!re2c");
+      Indent_Line ("re2c:yyfill:enable   = 0;");
+      New_Line;
+
+      --  Regexps used in definitions
+      for Pair of Input_Data.Tokens.Regexps loop
+         Indent_Line (-Pair.Name & " = " & (-Pair.Value) & ";");
+      end loop;
+      New_Line;
+
+      --  definitions
+      for I in All_Tokens (Generate_Data).Iterate (Non_Grammar => True, 
Nonterminals => False) loop
+
+         declare
+            Val : constant String :=
+              (if Is_Present (Elisp_Regexps, Value (I))
+               then Value (Elisp_Regexps, Value (I))
+               else Value (I));
+         begin
+            if 0 /= Index (Source => Val, Pattern => "/") then
+               --  trailing context syntax; forbidden in definitions
+               null;
+
+            elsif Kind (I) = "EOI" then
+               Indent_Line (Name (I) & " = [\x04];");
+
+            elsif Kind (I) = "delimited-text" then
+               --  not declared in definitions
+               null;
+
+            elsif Kind (I) = "keyword" and 
Input_Data.Language_Params.Case_Insensitive then
+               Indent_Line (Name (I) & " = '" & Strip_Quotes (Val) & "';");
+
+            else
+               --  Other kinds have values that are regular expressions, in 
re2c syntax
+               Indent_Line (Name (I) & " = " & Val & ";");
+            end if;
+         end;
+      end loop;
+      New_Line;
+
+      --  lexer rules
+      for I in All_Tokens (Generate_Data).Iterate (Non_Grammar => True, 
Nonterminals => False) loop
+         declare
+            Val : constant String :=
+              (if Is_Present (Elisp_Regexps, Value (I))
+               then Value (Elisp_Regexps, Value (I))
+               else Value (I));
+         begin
+
+            if Kind (I) = "non-reporting" then
+               Indent_Line (Name (I) & " { lexer->byte_token_start = 
lexer->cursor;");
+               Indent_Line ("    lexer->char_token_start = lexer->char_pos;");
+               Indent_Line ("    if (*lexer->cursor == 0x0A)");
+               Indent_Line ("       lexer->line_token_start = lexer->line-1;");
+               Indent_Line ("    else");
+               Indent_Line ("       lexer->line_token_start = lexer->line;");
+               Indent_Line ("    continue; }");
+
+            elsif Kind (I) = "delimited-text" then
+               --  Val contains the start and end strings, separated by space
+               declare
+                  Start_Last : constant Integer := Index (Val, " ");
+               begin
+                  Indent_Line
+                    (Val (1 .. Start_Last - 1) & " {*id = " & 
WisiToken.Token_ID'Image (ID (I)) &
+                       "; skip_to(lexer, " & Val (Start_Last + 1 .. Val'Last) 
& "); continue;}");
+               end;
+
+            elsif 0 /= Index (Source => Val, Pattern => "/") then
+               Indent_Line (Val & " {*id = " & WisiToken.Token_ID'Image (ID 
(I)) & "; continue;}");
+
+            else
+               Indent_Line (Name (I) & " {*id = " & WisiToken.Token_ID'Image 
(ID (I)) & "; continue;}");
+            end if;
+         end;
+      end loop;
+      New_Line;
+
+      --  Default action
+      Indent_Line ("* {status = ERROR_unrecognized_character; continue;}");
+
+      Put_Line ("*/");
+      Indent_Line ("}");
+      Indent := Indent - 3;
+
+      Indent_Line ("*byte_position = lexer->byte_token_start - lexer->buffer + 
1;");
+      Indent_Line ("*byte_length   = lexer->cursor - 
lexer->byte_token_start;");
+      Indent_Line ("*char_position = lexer->char_token_start;");
+      Indent_Line ("if (DO_COUNT)");
+      Indent_Line ("   *char_length = lexer->char_pos - 
lexer->char_token_start;");
+      Indent_Line ("else");
+      Indent_Line ("   *char_length = lexer->char_pos - 
lexer->char_token_start + 1;");
+      Indent_Line ("*line_start     = lexer->line_token_start;");
+      Indent_Line ("return status;");
+      Indent_Line ("}");
+      Indent := Indent - 3;
+      Set_Output (Standard_Output);
+      Close (File);
+
+      declare
+         Ada_Name : constant String := Output_File_Name_Root & "_re2c_c";
+         --  Output_File_Name_Root is the file name of the grammar file -
+         --  assume it is a legal Ada name.
+      begin
+         Create (File, Out_File, Output_File_Name_Root & "_re2c_c.ads");
+         Set_Output (File);
+         Indent := 1;
+         Put_File_Header (Ada_Comment, Use_Tuple => True, Tuple => Tuple);
+         Put_Raw_Code (Ada_Comment, Input_Data.Raw_Code (Copyright_License));
+         New_Line;
+
+         Put_Line ("with Interfaces.C;");
+         Put_Line ("with WisiToken;");
+         Put_Line ("with System;");
+         Put_Line ("package " & Ada_Name & " is");
+         Indent := Indent + 3;
+         New_Line;
+
+         Indent_Line ("function New_Lexer");
+         Indent_Line ("  (Buffer    : in System.Address;");
+         Indent_Line ("   Length    : in Interfaces.C.size_t;");
+         Indent_Line ("   Verbosity : in Interfaces.C.int)");
+         Indent_Line ("  return System.Address");
+         Indent_Line ("with Import        => True,");
+         Indent_Line ("     Convention    => C,");
+         Indent_Line ("     External_Name => """ & Output_File_Name_Root & 
"_new_lexer"";");
+         Indent_Line ("--  Create the lexer object, passing it the full text 
to process.");
+         New_Line;
+         Indent_Line ("procedure Free_Lexer (Lexer : in out System.Address)");
+         Indent_Line ("with Import        => True,");
+         Indent_Line ("     Convention    => C,");
+         Indent_Line ("     External_Name => """ & Output_File_Name_Root & 
"_free_lexer"";");
+         Indent_Line ("--  Free the lexer object");
+         New_Line;
+
+         Indent_Line ("procedure Reset_Lexer (Lexer : in System.Address)");
+         Indent_Line ("with Import        => True,");
+         Indent_Line ("     Convention    => C,");
+         Indent_Line ("     External_Name => """ & Output_File_Name_Root & 
"_reset_lexer"";");
+         New_Line;
+
+         Indent_Line ("function Next_Token");
+         Indent_Line ("  (Lexer         : in     System.Address;");
+         Indent_Line ("   ID            :    out WisiToken.Token_ID;");
+         Indent_Line ("   Byte_Position :    out Interfaces.C.size_t;");
+         Indent_Line ("   Byte_Length   :    out Interfaces.C.size_t;");
+         Indent_Line ("   Char_Position :    out Interfaces.C.size_t;");
+         Indent_Line ("   Char_Length   :    out Interfaces.C.size_t;");
+         Indent_Line ("   Line_Start    :    out Interfaces.C.int)");
+         Indent_Line ("  return Interfaces.C.int");
+         Indent_Line ("with Import        => True,");
+         Indent_Line ("     Convention    => C,");
+         Indent_Line ("     External_Name => """ & Output_File_Name_Root & 
"_next_token"";");
+         New_Line;
+
+         Indent := Indent - 3;
+         Put_Line ("end " & Ada_Name & ";");
+         Set_Output (Standard_Output);
+         Close (File);
+      end;
+   end Create_re2c;
+
+   function File_Name_To_Ada (File_Name : in String) return String
+   is
+      Result : String := File_Name;
+   begin
+      Result (Result'First) := To_Upper (Result (Result'First));
+      for I in Result'Range loop
+         if Result (I) = '-' then
+            Result (I) := '.';
+            Result (I + 1) := To_Upper (Result (I + 1));
+         elsif Result (I) = '_' then
+            Result (I + 1) := To_Upper (Result (I + 1));
+         end if;
+      end loop;
+      return Result;
+   end File_Name_To_Ada;
+
+   function Initialize
+     (Input_Data        : in WisiToken_Grammar_Runtime.User_Data_Type;
+      Tuple             : in Generate_Tuple;
+      Output_File_Root  : in String;
+      Check_Interface   : in Boolean)
+     return Common_Data
+   is begin
+      return Data : Common_Data do
+         Data.Generate_Algorithm := Tuple.Gen_Alg;
+
+         Data.Output_Language := Ada_Output_Language (Tuple.Out_Lang);
+
+         if Tuple.Gen_Alg = External or else Input_Data.User_Lexer in 
Valid_Lexer then
+            Data.Lexer := Input_Data.User_Lexer;
+         else
+            raise SAL.Programmer_Error with "tuple.alg " & 
Generate_Algorithm'Image (Tuple.Gen_Alg) &
+              " input_data.user_lexer " & Lexer_Image 
(Input_Data.User_Lexer).all;
+         end if;
+
+         if Check_Interface then
+            if Tuple.Interface_Kind in Valid_Interface then
+               Data.Interface_Kind := Valid_Interface (Tuple.Interface_Kind);
+            else
+               Put_Error
+                 (Error_Message
+                    (Input_Data.Grammar_Lexer.File_Name, 1, "Interface_Kind 
not set"));
+            end if;
+         else
+            Data.Interface_Kind := Process;
+         end if;
+
+         Data.Text_Rep := Tuple.Text_Rep;
+
+         Data.Lower_File_Name_Root := +To_Lower (Output_File_Root);
+      end return;
+   end Initialize;
+
+   function To_Token_Ada_Name (WY_Name : in String) return String
+   is
+      --  Convert WY_Name to a valid Ada identifier:
+      --
+      --  Add "_ID" to avoid collision with Ada reserved words
+      --
+      --  Replace '-' with '_'
+      Image : String := WY_Name;
+   begin
+      for I in Image'Range loop
+         if Image (I) = '-' then
+            Image (I) := '_';
+         end if;
+      end loop;
+      return Image & "_ID";
+   end To_Token_Ada_Name;
+
+end WisiToken.BNF.Output_Ada_Common;
diff --git a/wisitoken-bnf-output_ada_common.ads 
b/wisitoken-bnf-output_ada_common.ads
new file mode 100644
index 0000000..b4d8923
--- /dev/null
+++ b/wisitoken-bnf-output_ada_common.ads
@@ -0,0 +1,91 @@
+--  Abstract :
+--
+--  Types and operations shared by Ada and Ada_Emacs outputs.
+--
+--  Copyright (C) 2017, 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with WisiToken.BNF.Generate_Utils;
+with WisiToken.Generate.Packrat;
+with WisiToken_Grammar_Runtime;
+package WisiToken.BNF.Output_Ada_Common is
+
+   function To_Token_Ada_Name (WY_Name : in String) return String;
+
+   type Common_Data is limited record
+      --  Validated versions of Tuple values
+      Generate_Algorithm : WisiToken.BNF.Valid_Generate_Algorithm;
+      Lexer              : Lexer_Type; --  'none' valid for Libadalang
+      Output_Language    : Ada_Output_Language;
+      Interface_Kind     : Valid_Interface;
+      Text_Rep           : Boolean;
+
+      Lower_File_Name_Root : Standard.Ada.Strings.Unbounded.Unbounded_String;
+   end record;
+
+   function Initialize
+     (Input_Data        : in WisiToken_Grammar_Runtime.User_Data_Type;
+      Tuple             : in Generate_Tuple;
+      Output_File_Root  : in String;
+      Check_Interface   : in Boolean)
+     return Common_Data;
+
+   function File_Name_To_Ada (File_Name : in String) return String;
+
+   procedure Create_Ada_Actions_Spec
+     (Output_File_Name :         in String;
+      Package_Name     :         in String;
+      Input_Data       :         in WisiToken_Grammar_Runtime.User_Data_Type;
+      Common_Data      :         in Output_Ada_Common.Common_Data;
+      Generate_Data    : aliased in 
WisiToken.BNF.Generate_Utils.Generate_Data);
+
+   procedure Create_Ada_Main_Spec
+     (Output_File_Name  : in String;
+      Main_Package_Name : in String;
+      Input_Data        : in WisiToken_Grammar_Runtime.User_Data_Type;
+      Common_Data       : in Output_Ada_Common.Common_Data)
+   with Pre => Common_Data.Generate_Algorithm /= External;
+
+   procedure Create_External_Main_Spec
+     (Main_Package_Name    : in String;
+      Tuple                : in Generate_Tuple;
+      Input_Data           : in WisiToken_Grammar_Runtime.User_Data_Type);
+
+   procedure LR_Create_Create_Parser
+     (Input_Data    :         in     WisiToken_Grammar_Runtime.User_Data_Type;
+      Common_Data   :         in out Output_Ada_Common.Common_Data;
+      Generate_Data : aliased in     
WisiToken.BNF.Generate_Utils.Generate_Data);
+   --  If not Common_Data.Text_Rep, includes LR parse table in generated
+   --  source. Otherwise, includes call to LR.Get_Text_Rep; caller must
+   --  call Put_Text_Rep to create file.
+
+   procedure Packrat_Create_Create_Parser
+     (Common_Data   :         in out Output_Ada_Common.Common_Data;
+      Generate_Data : aliased in     
WisiToken.BNF.Generate_Utils.Generate_Data;
+      Packrat_Data  :         in     WisiToken.Generate.Packrat.Data);
+
+   procedure External_Create_Create_Grammar
+     (Generate_Data : in WisiToken.BNF.Generate_Utils.Generate_Data);
+
+   procedure Create_re2c
+     (Input_Data            :         in 
WisiToken_Grammar_Runtime.User_Data_Type;
+      Tuple                 :         in Generate_Tuple;
+      Generate_Data         : aliased in 
WisiToken.BNF.Generate_Utils.Generate_Data;
+      Output_File_Name_Root :         in String;
+      Elisp_Regexps         :         in WisiToken.BNF.String_Pair_Lists.List);
+   --  Create_re2c is called from wisi-generate, which does not declare
+   --  Common_Data.
+
+end WisiToken.BNF.Output_Ada_Common;
diff --git a/wisitoken-bnf-output_ada_emacs.adb 
b/wisitoken-bnf-output_ada_emacs.adb
new file mode 100644
index 0000000..136c6d3
--- /dev/null
+++ b/wisitoken-bnf-output_ada_emacs.adb
@@ -0,0 +1,1519 @@
+--  Abstract :
+--
+--  Output Ada code implementing the grammar defined by input
+--  parameters, and a parser for that grammar. The parser actions
+--  assume the Emacs Ada mode wisi indentation engine
+--
+--  If run in a separate process communicating over pipes with the
+--  Emacs process, the parser actions output encoded elisp actions;
+--  the protocol is documented in Emacs Ada mode wisi-process-parse.el,
+--  function wisi-process-parse-execute.
+--
+--  If run in an Emacs dynamically loaded module, the parser actions
+--  call the elisp actions directly.
+--
+--  Copyright (C) 2012 - 2015, 2017, 2018 Stephen Leake.  All Rights Reserved.
+--
+--  The WisiToken package is free software; you can redistribute it
+--  and/or modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or
+--  (at your option) any later version. This library 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.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Exceptions;
+with Ada.Strings.Fixed;
+with Ada.Strings.Maps;
+with Ada.Text_IO; use Ada.Text_IO;
+with WisiToken.BNF.Generate_Packrat;
+with WisiToken.BNF.Generate_Utils;
+with WisiToken.BNF.Output_Ada_Common; use WisiToken.BNF.Output_Ada_Common;
+with WisiToken.BNF.Output_Elisp_Common; use WisiToken.BNF.Output_Elisp_Common;
+with WisiToken.Generate.Packrat;
+with WisiToken_Grammar_Runtime;
+procedure WisiToken.BNF.Output_Ada_Emacs
+  (Input_Data            :         in WisiToken_Grammar_Runtime.User_Data_Type;
+   Output_File_Name_Root :         in String;
+   Generate_Data         : aliased in 
WisiToken.BNF.Generate_Utils.Generate_Data;
+   Packrat_Data          :         in WisiToken.Generate.Packrat.Data;
+   Tuple                 :         in Generate_Tuple;
+   Test_Main             :         in Boolean;
+   Multiple_Tuples       :         in Boolean;
+   Language_Name         :         in String)
+is
+   use all type Ada.Containers.Count_Type;
+
+   Language_Runtime_Package : constant String := "Wisi." & Language_Name;
+
+   Blank_Set : constant Ada.Strings.Maps.Character_Set := 
Ada.Strings.Maps.To_Set (" ");
+
+   Common_Data : Output_Ada_Common.Common_Data := 
WisiToken.BNF.Output_Ada_Common.Initialize
+     (Input_Data, Tuple, Output_File_Name_Root, Check_Interface => True);
+
+   Gen_Alg_Name : constant String :=
+     (if Test_Main or Multiple_Tuples
+      then "_" & WisiToken.BNF.Generate_Algorithm_Image 
(Common_Data.Generate_Algorithm).all
+      else "");
+
+   function Split_Sexp
+     (Item            : in String;
+      Input_File_Name : in String;
+      Source_Line     : in WisiToken.Line_Number_Type)
+     return String_Lists.List
+   is
+      --  Return one sexp per element. Remove comments, newlines, and outer 
'(progn )'.
+
+      use WisiToken.Generate;
+
+      Progn_Index : constant Integer := Ada.Strings.Fixed.Index (Item, 
"(progn");
+
+      Item_I : Integer := Item'First;
+
+      Buffer       : String (Item'First .. Item'Last);
+      Buffer_J     : Integer := Buffer'First;
+      Buffer_First : Integer := Buffer'First;
+      Paren_Count  : Integer := 0;
+      In_Comment   : Boolean := False;
+      Result       : String_Lists.List;
+
+      Delete_Last_Paren : Boolean := False;
+   begin
+      --  Loop thru Item, copying chars to Buffer, ignoring comments, newlines.
+
+      if 0 /= Progn_Index then
+         Item_I := Progn_Index + 6;
+
+         Delete_Last_Paren := True;
+      end if;
+
+      loop
+         exit when Item_I > Item'Last;
+
+         if In_Comment then
+            if Item (Item_I) in ASCII.CR | ASCII.LF then
+               In_Comment := False;
+            end if;
+         else
+            if Item (Item_I) = '(' then
+               if Paren_Count = 0 then
+                  Buffer_First := Buffer_J;
+               end if;
+               Paren_Count := Paren_Count + 1;
+
+               Buffer (Buffer_J) := Item (Item_I);
+               Buffer_J := Buffer_J + 1;
+
+            elsif Item (Item_I) = ')' then
+               Paren_Count := Paren_Count - 1;
+               if Paren_Count = 0 then
+                  Buffer (Buffer_J) := Item (Item_I);
+                  Result.Append (Buffer (Buffer_First .. Buffer_J));
+                  Buffer_First := Buffer'First;
+                  Buffer_J     := Buffer'First;
+
+               elsif Paren_Count = -1 then
+                  if Delete_Last_Paren then
+                     --  all done
+                     return Result;
+                  else
+                     Put_Error (Error_Message (Input_File_Name, Source_Line, 
"mismatched parens"));
+                     return String_Lists.Empty_List;
+                  end if;
+               else
+                  Buffer (Buffer_J) := Item (Item_I);
+                  Buffer_J := Buffer_J + 1;
+               end if;
+
+            elsif Item (Item_I) in ASCII.CR | ASCII.LF then
+               null;
+
+            elsif Item (Item_I) = ';' and then Item_I < Item'Last and then 
Item (Item_I + 1) = ';' then
+               In_Comment := True;
+
+            else
+               Buffer (Buffer_J) := Item (Item_I);
+               Buffer_J := Buffer_J + 1;
+            end if;
+         end if;
+         Item_I := Item_I + 1;
+      end loop;
+      if Paren_Count /= 0 then
+         Put_Error
+           (Error_Message
+              (Input_File_Name, Source_Line, "mismatched parens"));
+      end if;
+      return Result;
+   end Split_Sexp;
+
+   procedure Create_Ada_Action
+     (Name          : in String;
+      RHS           : in RHS_Type;
+      Unsplit_Lines : in Ada.Strings.Unbounded.Unbounded_String;
+      Check         : in Boolean)
+   is
+      --  Create Action (if Check = False; Lines must be RHS.Action) or
+      --  Check (if Check = True; Lines must be RHS.Check) subprogram named
+      --  Name for RHS.
+
+      use Ada.Strings;
+      use Ada.Strings.Fixed;
+      use Ada.Strings.Unbounded;
+      use WisiToken.Generate;
+
+      Sexps : constant String_Lists.List := Split_Sexp
+        (-Unsplit_Lines, Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line);
+
+      use all type Ada.Strings.Maps.Character_Set;
+
+      Space_Paren_Set : constant Ada.Strings.Maps.Character_Set :=
+        Ada.Strings.Maps.To_Set ("])") or Blank_Set;
+
+      Navigate_Lines     : String_Lists.List;
+      Face_Line          : Unbounded_String;
+      Indent_Action_Line : Unbounded_String;
+      Check_Lines        : String_Lists.List;
+
+      function Statement_Params (Params : in String) return String
+      is
+         --  Input looks like: [1 function 2 other ...]
+         Last       : Integer := Index_Non_Blank (Params); -- skip [
+         First      : Integer;
+         Second     : Integer;
+         Need_Comma : Boolean := False;
+         Result     : Unbounded_String;
+         Count      : Integer := 0;
+      begin
+         loop
+            First  := Last + 1;
+            Second := Index (Params, Blank_Set, First);
+            exit when Second = 0;
+
+            Count := Count + 1;
+            Last  := Index (Params, Space_Paren_Set, Second + 1);
+
+            Result := Result & (if Need_Comma then ", " else "") &
+              "(" & Params (First .. Second - 1) & ", " &
+              Elisp_Name_To_Ada (Params (Second + 1 .. Last - 1), Append_ID => 
False, Trim => 0) & ")";
+
+            Need_Comma := True;
+         end loop;
+         if Count = 1 then
+            return " (Parse_Data, Tree, Nonterm, Tokens, (1 => " & (-Result) & 
"))";
+         else
+            return " (Parse_Data, Tree, Nonterm, Tokens, (" & (-Result) & "))";
+         end if;
+      end Statement_Params;
+
+      function Containing_Params (Params : in String) return String
+      is
+         --  Input looks like: 1 2)
+         First  : constant Integer := Index_Non_Blank (Params);
+         Second : constant Integer := Index (Params, Blank_Set, First);
+      begin
+         return " (Parse_Data, Tree, Nonterm, Tokens, " &
+           Params (First .. Second - 1) & ',' & Params (Second .. Params'Last);
+      end Containing_Params;
+
+      function Motion_Params (Params : in String) return String
+      is
+         --  Input looks like: [1 [2 EXCEPTION WHEN] 3 ...]
+         --  Result: (..., Motion_Param_Array'((1, Empty_IDs) & (2, (3 & 8)) & 
(3, Empty_IDs))
+         use Generate_Utils;
+         use Ada.Strings.Maps;
+
+         Delim : constant Character_Set := To_Set ("]") or Blank_Set;
+
+         Last   : Integer          := Index_Non_Blank (Params); -- skip [
+         First  : Integer;
+         Vector : Boolean;
+         Result : Unbounded_String := +" (Parse_Data, Tree, Nonterm, Tokens, 
(";
+
+         Index_First  : Integer;
+         Index_Last   : Integer;
+         IDs          : Unbounded_String;
+         IDs_Count    : Integer;
+         Need_Comma_1 : Boolean := False;
+         Need_Comma_2 : Boolean := False;
+      begin
+         loop
+            Last := Index_Non_Blank (Params, Integer'Min (Params'Last, Last + 
1));
+
+            exit when Params (Last) = ']' or Params (Last) = ')';
+
+            Vector := Params (Last) = '[';
+            if Vector then
+               Index_First  := Last + 1;
+               Last         := Index (Params, Delim, Index_First);
+               Index_Last   := Last - 1;
+               IDs_Count    := 0;
+               IDs          := Null_Unbounded_String;
+               Need_Comma_2 := False;
+               loop
+                  exit when Params (Last) = ']';
+                  First     := Last + 1;
+                  Last      := Index (Params, Delim, First);
+                  IDs_Count := IDs_Count + 1;
+                  begin
+                     IDs := IDs & (if Need_Comma_2 then " & " else "") &
+                       Trimmed_Image (Find_Token_ID (Generate_Data, Params 
(First .. Last - 1)));
+                     Need_Comma_2 := True;
+                  exception
+                  when E : Not_Found =>
+                     Put_Error
+                       (Error_Message
+                          (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line,
+                           Ada.Exceptions.Exception_Message (E)));
+                  end;
+               end loop;
+
+               Result := Result & (if Need_Comma_1 then " & " else "") & "(" &
+                 Params (Index_First .. Index_Last) & ", " &
+                 (if IDs_Count = 1 then "+" else "") & IDs & ")";
+            else
+               First  := Index_Non_Blank (Params, Last);
+               Last   := Index (Params, Delim, First);
+               Result := Result & (if Need_Comma_1 then " & " else "") &
+                 "(" & Params (First .. Last - 1) & ", Empty_IDs)";
+            end if;
+            Need_Comma_1 := True;
+         end loop;
+         return -(Result & "))");
+      end Motion_Params;
+
+      function Face_Apply_Params (Params : in String) return String
+      is
+         --  Params is a vector of triples: [1 nil font-lock-keyword-face 3 
nil font-lock-function-name-face ...]
+         --  Result: ((1, 3, 1), (3, 3, 2), ...)
+         use Ada.Strings.Maps;
+         Delim : constant Character_Set := To_Set ("]") or Blank_Set;
+
+         Last       : Integer          := Index_Non_Blank (Params); -- skip [
+         First      : Integer;
+         Result     : Unbounded_String;
+         Need_Comma : Boolean          := False;
+         Count      : Integer          := 0;
+      begin
+         loop
+            Last := Index_Non_Blank (Params, Last + 1);
+
+            exit when Params (Last) = ']' or Params (Last) = ')';
+
+            Count  := Count + 1;
+            First  := Last;
+            Last   := Index (Params, Delim, First);
+            Result := Result & (if Need_Comma then ", (" else "(") & Params 
(First .. Last - 1);
+
+            if Params (Last) = ']' then
+               Put_Error
+                 (Error_Message
+                    (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, 
"invalid wisi-face-apply argument"));
+               exit;
+            end if;
+
+            First  := Index_Non_Blank (Params, Last + 1);
+            Last   := Index (Params, Delim, First);
+            Result := Result & ',' & Integer'Image
+              (Find_Elisp_ID (Input_Data.User_Names.Faces, Params (First .. 
Last - 1)));
+
+            if Params (Last) = ']' then
+               Put_Error
+                 (Error_Message
+                    (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, 
"invalid wisi-face-apply argument"));
+               exit;
+            end if;
+
+            First  := Index_Non_Blank (Params, Last + 1);
+            Last   := Index (Params, Delim, First);
+            Result := Result & ',' &
+              Integer'Image (Find_Elisp_ID (Input_Data.User_Names.Faces, 
Params (First .. Last - 1))) & ")";
+
+            Need_Comma := True;
+         end loop;
+         if Count = 1 then
+            return " (Parse_Data, Tree, Nonterm, Tokens, (1 => " & (-Result) & 
"))";
+         else
+            return " (Parse_Data, Tree, Nonterm, Tokens, (" & (-Result) & "))";
+         end if;
+      exception
+      when E : others =>
+         Put_Error
+           (Error_Message
+              (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, "invalid 
syntax: " &
+              Ada.Exceptions.Exception_Message (E)));
+         return "";
+      end Face_Apply_Params;
+
+      function Face_Mark_Params (Params : in String) return String
+      is
+         --  Params is a vector of pairs: [1 prefix 3 suffix ...]
+         --  Result: ((1, Prefix), (3, Suffix), ...)
+         use Ada.Strings.Maps;
+         Delim : constant Character_Set := To_Set ("]") or Blank_Set;
+
+         Last       : Integer          := Index_Non_Blank (Params); -- skip [
+         First      : Integer;
+         Result     : Unbounded_String;
+         Need_Comma : Boolean          := False;
+         Count      : Integer          := 0;
+      begin
+         loop
+            Last := Index_Non_Blank (Params, Last + 1);
+
+            exit when Params (Last) = ']' or Params (Last) = ')';
+
+            Count  := Count + 1;
+            First  := Last;
+            Last   := Index (Params, Delim, First);
+            Result := Result & (if Need_Comma then ", (" else "(") & Params 
(First .. Last - 1);
+
+            if Params (Last) = ']' then
+               Put_Error
+                 (Error_Message
+                    (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, 
"invalid wisi-face-mark argument"));
+               exit;
+            end if;
+
+            First  := Index_Non_Blank (Params, Last + 1);
+            Last   := Index (Params, Delim, First);
+            Result := Result & ", " & Elisp_Name_To_Ada (Params (First .. Last 
- 1), False, 0) & ")";
+
+            Need_Comma := True;
+         end loop;
+         if Count = 1 then
+            return " (Parse_Data, Tree, Nonterm, Tokens, (1 => " & (-Result) & 
"))";
+         else
+            return " (Parse_Data, Tree, Nonterm, Tokens, (" & (-Result) & "))";
+         end if;
+      exception
+      when E : others =>
+         Put_Error
+           (Error_Message
+            (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, "invalid 
syntax: " &
+              Ada.Exceptions.Exception_Message (E)));
+         return "";
+      end Face_Mark_Params;
+
+      function Face_Remove_Params (Params : in String) return String
+      is
+         --  Params is a vector of token numbers: [1 3 ...]
+         --  Result: (1, 3, ...)
+         use Ada.Strings.Maps;
+         Delim : constant Character_Set := To_Set ("]") or Blank_Set;
+
+         Last       : Integer          := Index_Non_Blank (Params); -- skip [
+         First      : Integer;
+         Result     : Unbounded_String;
+         Need_Comma : Boolean          := False;
+         Count      : Integer          := 0;
+      begin
+         loop
+            Last := Index_Non_Blank (Params, Last + 1);
+
+            exit when Params (Last) = ']' or Params (Last) = ')';
+
+            Count  := Count + 1;
+            First  := Last;
+            Last   := Index (Params, Delim, First);
+            Result := Result & (if Need_Comma then ", " else "") & Params 
(First .. Last - 1);
+
+            Need_Comma := True;
+         end loop;
+         if Count = 1 then
+            return " (Parse_Data, Tree, Nonterm, Tokens, (1 => " & (-Result) & 
"))";
+         else
+            return " (Parse_Data, Tree, Nonterm, Tokens, (" & (-Result) & "))";
+         end if;
+      exception
+      when E : others =>
+         Put_Error
+           (Error_Message
+            (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, "invalid 
syntax: " &
+              Ada.Exceptions.Exception_Message (E)));
+         return "";
+      end Face_Remove_Params;
+
+      function Indent_Params (Params : in String; N : in String := "") return 
String
+      is
+         --  If N is non-empty, it is the first arg in wisi-indent-action*, 
followed by ','.
+         --
+         --  Params is a vector, one item for each token in Tokens. Each item 
is one of:
+         --
+         --  - an integer; copy to output
+         --
+         --  - a symbol; convert to Ada name syntax
+         --
+         --  - a lisp function call with arbitrary args; convert to 
Indent_Param type
+         --
+         --  - a vector with two elements [code_indent comment_indent]; 
convert to Indent_Pair.
+
+         use Ada.Strings.Maps;
+         use Ada.Containers;
+
+         Delim : constant Character_Set := To_Set ("])") or Blank_Set;
+
+         subtype Digit is Character range '0' .. '9';
+
+         Last          : Integer         := Index_Non_Blank (Params); -- skip [
+         Prefix        : constant String := " (Parse_Data, Tree, Nonterm, 
Tokens, " & N & "(";
+         Result        : Unbounded_String;
+         Need_Comma    : Boolean         := False;
+         Param_Count   : Count_Type      := 0;            -- in Params
+
+         function Indent_Label (Elisp_Name : in String) return String
+         is begin
+            if    Elisp_Name = "wisi-anchored"   then return "Anchored_0";
+            elsif Elisp_Name = "wisi-anchored%"  then return "Anchored_1";
+            elsif Elisp_Name = "wisi-anchored%-" then return "Anchored_2";
+            elsif Elisp_Name = "wisi-anchored*"  then return "Anchored_3";
+            elsif Elisp_Name = "wisi-anchored*-" then return "Anchored_4";
+            elsif Elisp_Name = "wisi-hanging"    then return "Hanging_0";
+            elsif Elisp_Name = "wisi-hanging%"   then return "Hanging_1";
+            elsif Elisp_Name = "wisi-hanging%-"  then return "Hanging_2";
+            else
+               Put_Error
+                 (Error_Message
+                  (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, 
"unrecognized wisi indent function: '" &
+                    Elisp_Name & "'"));
+               return "";
+            end if;
+         end Indent_Label;
+
+         function Ensure_Simple_Indent (Item : in String) return String
+         is begin
+            --  Return an aggregate for Simple_Indent_Param. Item can be 
anything
+            --  Expression returns except Hanging.
+
+            if Item (Item'First) = '(' then
+               --  Anchored or Language
+               return Item;
+
+            else
+               --  simple integer
+               return "(Int, " & Item & ")";
+            end if;
+         end Ensure_Simple_Indent;
+
+         function Expression (Param_First : in Integer) return String
+         is
+            --  Return a simple integer expression, or an aggregate for
+            --  Simple_Indent_Param or Indent_Param.
+            --
+            --  Handles this syntax:
+            --
+            --  integer literal:
+            --  2 => 2
+            --  -1 => -1
+            --
+            --  variable name:
+            --  ada-indent => Ada_Indent
+            --
+            --  token_id literal:
+            --  'TYPE => 13
+            --
+            --  simple expression with + - * :
+            --  (- ada-indent) => -Ada_Indent
+            --  (- ada-indent-when ada-indent) => Ada_Indent_When - Ada_Indent
+            --
+            --  if expression:
+            --  (if c a b) => (if c then a else b)
+            --
+            --  function call with expression args:
+            --  (wisi-hanging (wisi-anchored% 1 ada-indent)
+            --                (wisi-anchored% 1 (+ ada-indent 
ada-indent-broken)))
+
+            use Generate_Utils;
+
+            First : Integer := Index_Non_Blank (Params, Param_First);
+
+            Function_Name : Unbounded_String;
+            Args          : Unbounded_String;
+            Arg_Count     : Count_Type      := 0;
+         begin
+            if Params (First) in Digit or Params (First) = '-' then
+               Last := Index (Params, Delim, First);
+               return Params (First .. Last - 1);
+
+            elsif Params (First) = ''' then
+               Last := Index (Params, Delim, First);
+               return WisiToken.Trimmed_Image (Find_Token_ID (Generate_Data, 
Params (First + 1 .. Last - 1)));
+
+            elsif Params (First) = '(' then
+               First  := First + 1;
+               Last   := Index (Params, Delim, First);
+               Function_Name := +Params (First .. Last - 1);
+
+               if Length (Function_Name) = 1 then
+                  --  - + *
+                  Last := Index (Params, Delim, Last + 1);
+                  if Params (Last) = ')' then
+                     return Result : constant String := -Function_Name & 
Expression (First + 1)
+                     do
+                        Last := Last + 1; -- get past ')'
+                     end return;
+                  else
+                     Args := +Expression (First + 1);
+                     Args := Args & ' ' & Function_Name & ' ' & Expression 
(Last + 1);
+
+                     Last := Last + 1; -- get past ')'
+                     return -Args;
+                  end if;
+
+               elsif -Function_Name = "if" then
+                  Args := +Expression (Last + 1);
+                  Args := +"(if " & Args & " then " & Expression (Last + 1);
+                  Args := Args & " else " & Expression (Last + 1) & ')';
+
+                  Last := Last + 1; -- get past ')'
+                  return -Args;
+
+               elsif Is_Present (Input_Data.User_Names.Indents, 
-Function_Name) then
+                  --  Language-specific function call
+                  Function_Name := +Value (Input_Data.User_Names.Indents, 
-Function_Name);
+                  Arg_Count     := 0;
+                  loop
+                     exit when Params (Last) = ')';
+
+                     First := Last + 1;
+                     if Arg_Count = 0 then
+                        Args := +Expression (First);
+                     else
+                        Args := Args & " & " & Expression (First);
+                     end if;
+                     Arg_Count := Arg_Count + 1;
+                  end loop;
+
+                  Last := Last + 1; -- get past ')'
+
+                  return "(Language, " & (-Function_Name) & "'Access, " &
+                    (if Arg_Count = 0 then "Null_Args"
+                     elsif Arg_Count = 1 then '+' & (-Args)
+                     else -Args)
+                    & ')';
+
+               else
+                  --  wisi lisp function call
+                  Function_Name := +Indent_Label (-Function_Name);
+                  if Length (Function_Name) = 0 then
+                     --  not a recognized function
+                     Last := 1 + Index (Params, ")", Last);
+                     return "";
+
+                  elsif Slice (Function_Name, 1, 4) = "Hang" then
+                     --  Arguments are 2 Simple_Indent_Param
+                     Args := +Ensure_Simple_Indent (Expression (Last + 1));
+                     Args := Args & ", " & Ensure_Simple_Indent (Expression 
(Last + 1));
+                     Last := Last + 1; -- get past ')'
+                     return "(" & (-(Function_Name & ", " & Args)) & ")";
+                  else
+                     --  Arguments are 2 simple integer expressions
+                     Args := +Expression (Last + 1);
+                     Args := Args & ", " & Expression (Last + 1);
+                     Last := Last + 1; -- get past ')'
+                     return "(" & (-(Function_Name & ", " & Args)) & ")";
+                  end if;
+               end if;
+
+            else
+               --  Assume it is a language-specific integer indent option, 
like "ada-indent",
+               --  declared in Language_Runtime_Package, which is use-visible.
+               Last  := Index (Params, Delim, First);
+               return Elisp_Name_To_Ada (Params (First .. Last - 1), False, 0);
+            end if;
+         exception
+         when E : others =>
+            Put_Error
+              (Error_Message
+                 (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, 
Ada.Exceptions.Exception_Message (E)));
+            return "";
+         end Expression;
+
+         function Ensure_Indent_Param (Item : in String) return String
+         is begin
+            --  Return an aggregate for Indent_Param. Item can be anything
+            --  Expression returns.
+            if Item'Length = 0 then
+               --  Expression could not find an indent function
+               return Item;
+
+            elsif Item'Length >= 5 and then Item (Item'First .. Item'First + 
4) = "(Hang" then
+               return Item;
+
+            elsif Item (Item'First) = '(' then
+               --  Anchored or Language
+               return "(Simple, " & Item & ")";
+
+            else
+               --  simple integer
+               return "(Simple, (Int, " & Item & "))";
+            end if;
+         end Ensure_Indent_Param;
+
+      begin
+         loop
+            if Params (Last) /= ']' then
+               Last := Index_Non_Blank (Params, Last + 1);
+            end if;
+
+            exit when Params (Last) = ']';
+
+            if Need_Comma then
+               Result := Result & ", ";
+            else
+               Need_Comma := True;
+            end if;
+
+            case Params (Last) is
+            when '(' =>
+               Result := Result & "(False, " & Ensure_Indent_Param (Expression 
(Last)) & ')';
+
+            when '[' =>
+               --  vector
+               Result := Result & "(True, " & Ensure_Indent_Param (Expression 
(Last + 1));
+               Result := Result & ", " & Ensure_Indent_Param (Expression (Last 
+ 1)) & ')';
+               if Params (Last) /= ']' then
+                  Put_Error
+                    (Error_Message
+                       (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, 
"invalid indent syntax"));
+               end if;
+               Last := Last + 1;
+
+            when others =>
+               --  integer or symbol
+               Result := Result & "(False, " & Ensure_Indent_Param (Expression 
(Last)) & ')';
+
+            end case;
+            Param_Count := Param_Count + 1;
+         end loop;
+
+         if Param_Count /= RHS.Tokens.Length then
+            Put_Error
+              (Error_Message
+                 (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, "indent 
parameters count of" & Count_Type'Image
+                    (Param_Count) & " /= production token count of" & 
Count_Type'Image (RHS.Tokens.Length)));
+         end if;
+
+         if Param_Count = 1 then
+            Result := Prefix & "1 => " & Result;
+         else
+            Result := Prefix & Result;
+         end if;
+
+         return -(Result & "))");
+      end Indent_Params;
+
+      function Merge_Names_Params (Params : in String) return String
+      is
+         --  Input looks like "1 2)"
+         First  : constant Integer := Index_Non_Blank (Params);
+         Second : constant Integer := Index (Params, Blank_Set, First);
+      begin
+         return " (Nonterm, Tokens, " & Params (First .. Second - 1) & ',' &
+           Params (Second .. Params'Last);
+      end Merge_Names_Params;
+
+      function Match_Names_Params (Params : in String) return String
+      is
+         --  Input looks like: 1 2)
+         First  : constant Integer := Index_Non_Blank (Params);
+         Second : constant Integer := Index (Params, Blank_Set, First);
+      begin
+         return " (Lexer, Descriptor, Tokens, " &
+           Params (First .. Second - 1) & ',' &
+           Params (Second .. Params'Last - 1) & ", " &
+           (if Length (Input_Data.Language_Params.End_Names_Optional_Option) > 0
+            then -Input_Data.Language_Params.End_Names_Optional_Option
+            else "False") & ")";
+      end Match_Names_Params;
+
+      procedure Translate_Line (Line : in String)
+      is
+         Last       : constant Integer := Index (Line, Blank_Set);
+         Elisp_Name : constant String  := Line (Line'First + 1 .. Last - 1);
+      begin
+         --  wisi action/check functions, in same order as typically used in
+         --  .wy files; Navigate, Face, Indent, Check.
+         if Elisp_Name = "wisi-statement-action" then
+            Navigate_Lines.Append
+              (Elisp_Name_To_Ada (Elisp_Name, False, 5) &
+                 Statement_Params (Line (Last + 1 .. Line'Last)) & ";");
+
+         elsif Elisp_Name = "wisi-containing-action" then
+            Navigate_Lines.Append
+              (Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) &
+                 Containing_Params (Line (Last + 1 .. Line'Last)) & ";");
+
+         elsif Elisp_Name = "wisi-motion-action" then
+            Navigate_Lines.Append
+              (Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) &
+                 Motion_Params (Line (Last + 1 .. Line'Last)) & ";");
+
+         elsif Elisp_Name = "wisi-face-apply-action" then
+            if Length (Face_Line) = 0 then
+               Face_Line := +Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) &
+                 Face_Apply_Params (Line (Last + 1 .. Line'Last)) & ";";
+            else
+               Put_Error
+                 (Error_Message
+                    (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, 
"multiple face actions"));
+            end if;
+
+         elsif Elisp_Name = "wisi-face-apply-list-action" then
+            if Length (Face_Line) = 0 then
+               Face_Line := +Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) &
+                 Face_Apply_Params (Line (Last + 1 .. Line'Last)) & ";";
+            else
+               Put_Error
+                 (Error_Message
+                    (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, 
"multiple face actions"));
+            end if;
+
+         elsif Elisp_Name = "wisi-face-mark-action" then
+            if Length (Face_Line) = 0 then
+               Face_Line := +Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) &
+                 Face_Mark_Params (Line (Last + 1 .. Line'Last)) & ";";
+            else
+               Put_Error
+                 (Error_Message
+                    (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, 
"multiple face actions"));
+            end if;
+
+         elsif Elisp_Name = "wisi-face-remove-action" then
+            if Length (Face_Line) = 0 then
+               Face_Line := +Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) &
+                 Face_Remove_Params (Line (Last + 1 .. Line'Last)) & ";";
+            else
+               Put_Error
+                 (Error_Message
+                    (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, 
"multiple face actions"));
+            end if;
+
+         elsif Elisp_Name = "wisi-indent-action" then
+            if Length (Indent_Action_Line) = 0 then
+               Indent_Action_Line := +"Indent_Action_0" &
+                 Indent_Params (Line (Last + 1 .. Line'Last)) & ";";
+            else
+               Put_Error
+                 (Error_Message
+                    (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, 
"multiple indent actions"));
+            end if;
+
+         elsif Elisp_Name = "wisi-indent-action*" then
+            if Length (Indent_Action_Line) = 0 then
+               declare
+                  Temp : constant Integer := Index (Line, Blank_Set, Last + 1);
+               begin
+                  Indent_Action_Line := +"Indent_Action_1" &
+                    Indent_Params (Line (Temp + 1 .. Line'Last), Line (Last + 
1 .. Temp - 1) & ", ") & ";";
+               end;
+            else
+               Put_Error
+                 (Error_Message
+                    (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, 
"multiple indent actions"));
+            end if;
+
+         elsif Elisp_Name = "wisi-propagate-name" then
+            if not Check then
+               Put_Error
+                 (Error_Message
+                    (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, 
Elisp_Name & " used in action"));
+               return;
+            end if;
+            Check_Lines.Append
+              ("return " & Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) &
+                 " (Nonterm, Tokens, " & Line (Last + 1 .. Line'Last) & ";");
+
+         elsif Elisp_Name = "wisi-merge-names" then
+            if not Check then
+               Put_Error
+                 (Error_Message
+                    (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, 
Elisp_Name & " used in action"));
+               return;
+            end if;
+            Check_Lines.Append
+              ("return " & Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) &
+                 Merge_Names_Params (Line (Last + 1 .. Line'Last)) & ";");
+
+         elsif Elisp_Name = "wisi-match-names" then
+            if not Check then
+               Put_Error
+                 (Error_Message
+                    (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, 
Elisp_Name & " used in action"));
+               return;
+            end if;
+            Check_Lines.Append
+              ("return " & Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) &
+                 Match_Names_Params (Line (Last + 1 .. Line'Last)) & ";");
+
+         else
+            Put_Error
+              (Error_Message
+                 (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, 
"unrecognized elisp action: '" &
+                    Elisp_Name & "'"));
+         end if;
+      end Translate_Line;
+
+   begin
+      for Sexp of Sexps loop
+         begin
+            Translate_Line (Sexp);
+         exception
+         when E : Not_Found =>
+            Put_Error
+              (Error_Message
+                 (Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line, 
Ada.Exceptions.Exception_Message (E)));
+         end;
+      end loop;
+
+      if Check then
+         --  in a check
+         Indent_Line ("function " & Name);
+         Indent_Line (" (Lexer   : access constant 
WisiToken.Lexer.Instance'Class;");
+         Indent_Line ("  Nonterm : in out WisiToken.Recover_Token;");
+         Indent_Line ("  Tokens  : in     WisiToken.Recover_Token_Array)");
+         Indent_Line (" return WisiToken.Semantic_Checks.Check_Status");
+         declare
+            --  Tokens is always referenced.
+            Unref_Lexer   : constant Boolean := (for all Line of Check_Lines 
=> 0 = Index (Line, "Lexer"));
+            Unref_Nonterm : constant Boolean := (for all Line of Check_Lines 
=> 0 = Index (Line, "Nonterm"));
+         begin
+            if Unref_Lexer or Unref_Nonterm then
+               Indent_Line ("is");
+               if Unref_Lexer then
+                  Indent_Line ("   pragma Unreferenced (Lexer);");
+               end if;
+               if Unref_Nonterm then
+                  Indent_Line ("   pragma Unreferenced (Nonterm);");
+               end if;
+               Indent_Line ("begin");
+            else
+               Indent_Line ("is begin");
+            end if;
+         end;
+         Indent := Indent + 3;
+         for Line of Check_Lines loop
+            Indent_Line (Line);
+         end loop;
+      else
+         --  In an action
+         Indent_Line ("procedure " & Name);
+         Indent_Line (" (User_Data : in out 
WisiToken.Syntax_Trees.User_Data_Type'Class;");
+         Indent_Line ("  Tree      : in out WisiToken.Syntax_Trees.Tree;");
+         Indent_Line ("  Nonterm   : in     
WisiToken.Syntax_Trees.Valid_Node_Index;");
+         Indent_Line ("  Tokens    : in     
WisiToken.Syntax_Trees.Valid_Node_Index_Array)");
+         Indent_Line ("is");
+         Indent_Start ("   Parse_Data : Wisi.Parse_Data_Type renames");
+         Put_Line (" Wisi.Parse_Data_Type (User_Data);");
+         Indent_Line ("begin");
+         Indent := Indent + 3;
+
+         Indent_Line ("case Parse_Data.Post_Parse_Action is");
+         Indent_Line ("when Navigate =>");
+         if Navigate_Lines.Length > 0 then
+            Indent := Indent + 3;
+            for Line of Navigate_Lines loop
+               Indent_Wrap (Line);
+            end loop;
+            Indent := Indent - 3;
+         else
+            Indent_Line ("   null;");
+         end if;
+
+         Indent_Line ("when Face =>");
+         if Length (Face_Line) > 0 then
+            Indent := Indent + 3;
+            Indent_Wrap (-Face_Line);
+            Indent := Indent - 3;
+         else
+            Indent_Line ("   null;");
+         end if;
+
+         Indent_Line ("when Indent =>");
+         if Length (Indent_Action_Line) > 0 then
+            Indent := Indent + 3;
+            Indent_Wrap (-Indent_Action_Line);
+            Indent := Indent - 3;
+         else
+            Indent_Line ("   null;");
+         end if;
+         Indent_Line ("end case;");
+      end if;
+
+      Indent := Indent - 3;
+      Indent_Line ("end " & Name & ";");
+      New_Line;
+
+   end Create_Ada_Action;
+
+   function Any_Motion_Actions return Boolean
+   is begin
+      for Rule of Input_Data.Tokens.Rules loop
+         for RHS of Rule.Right_Hand_Sides loop
+            for Sexp of Split_Sexp (-RHS.Action, 
Input_Data.Grammar_Lexer.File_Name, RHS.Source_Line) loop
+               declare
+                  Last       : constant Integer := Ada.Strings.Fixed.Index 
(Sexp, Blank_Set);
+                  Elisp_Name : constant String  := Sexp (Sexp'First + 1 .. 
Last - 1);
+               begin
+                  if Elisp_Name = "wisi-motion-action" then
+                     return True;
+                  end if;
+               end;
+            end loop;
+         end loop;
+      end loop;
+      return False;
+   end Any_Motion_Actions;
+
+   procedure Create_Ada_Actions_Body
+     (Action_Names : not null access WisiToken.Names_Array_Array;
+      Check_Names  : not null access WisiToken.Names_Array_Array;
+      Package_Name : in              String)
+   is
+      use Ada.Strings.Unbounded;
+      use Generate_Utils;
+      use WisiToken.Generate;
+
+      File_Name : constant String := Output_File_Name_Root &
+        (case Common_Data.Interface_Kind is
+         when Process => "_process_actions",
+         when Module  => "_module_actions") &
+        ".adb";
+
+      Motion_Actions : constant Boolean := Any_Motion_Actions;
+
+      Body_File : File_Type;
+
+   begin
+      Create (Body_File, Out_File, File_Name);
+      Set_Output (Body_File);
+      Indent := 1;
+      Put_File_Header (Ada_Comment, Use_Tuple => True, Tuple => Tuple);
+      Put_Raw_Code (Ada_Comment, Input_Data.Raw_Code (Copyright_License));
+      New_Line;
+
+      Put_Line ("with Wisi; use Wisi;");
+      if Input_Data.Language_Params.Language_Runtime then
+         Put_Line ("with " & Language_Runtime_Package & "; use " & 
Language_Runtime_Package & ";");
+         --  For language-specific names in actions, checks.
+      end if;
+
+      case Common_Data.Interface_Kind is
+      when Process =>
+         null;
+
+      when Module =>
+         Put_Line ("with Emacs_Module_Aux; use Emacs_Module_Aux;");
+         Put_Line ("with Ada.Exceptions;");
+         Put_Line ("with Ada.Strings.Unbounded;");
+      end case;
+
+      Put_Line ("package body " & Package_Name & " is");
+      Indent := Indent + 3;
+      New_Line;
+
+      if Input_Data.Check_Count > 0 then
+         Indent_Line ("use WisiToken.Semantic_Checks;");
+      end if;
+      if Motion_Actions then
+         Indent_Line ("use all type Motion_Param_Array;");
+      end if;
+      New_Line;
+
+      --  generate Action and Check subprograms.
+
+      for Rule of Input_Data.Tokens.Rules loop
+         --  No need for a Token_Cursor here, since we only need the
+         --  nonterminals.
+         declare
+            LHS_ID     : constant WisiToken.Token_ID := Find_Token_ID 
(Generate_Data, -Rule.Left_Hand_Side);
+            Prod_Index : Integer                     := 0; -- Semantic_Action 
defines Prod_Index as zero-origin
+         begin
+            for RHS of Rule.Right_Hand_Sides loop
+               if Length (RHS.Action) > 0 then
+                  declare
+                     Name : constant String := Action_Names 
(LHS_ID)(Prod_Index).all;
+                  begin
+                     Create_Ada_Action (Name, RHS, RHS.Action, Check => False);
+                  end;
+               end if;
+
+               if Length (RHS.Check) > 0 then
+                  declare
+                     Name : constant String := Check_Names 
(LHS_ID)(Prod_Index).all;
+                  begin
+                     Create_Ada_Action (Name, RHS, RHS.Check, Check => True);
+                  end;
+               end if;
+               Prod_Index := Prod_Index + 1;
+            end loop;
+         end;
+      end loop;
+
+      Put_Line ("end " & Package_Name & ";");
+      Close (Body_File);
+
+      Set_Output (Standard_Output);
+
+   end Create_Ada_Actions_Body;
+
+   procedure Create_Ada_Main_Body
+     (Actions_Package_Name : in String;
+      Main_Package_Name    : in String)
+   is
+      use WisiToken.Generate;
+
+      File_Name : constant String := To_Lower (Main_Package_Name) & ".adb";
+      Body_File : File_Type;
+   begin
+      Create (Body_File, Out_File, File_Name);
+      Set_Output (Body_File);
+      Indent := 1;
+      Put_File_Header (Ada_Comment, Use_Tuple => True, Tuple => Tuple);
+      Put_Raw_Code (Ada_Comment, Input_Data.Raw_Code (Copyright_License));
+      New_Line;
+
+      Put_Line ("with " & Actions_Package_Name & "; use " & 
Actions_Package_Name & ";");
+
+      case Common_Data.Lexer is
+      when None | Elisp_Lexer =>
+         null;
+
+      when re2c_Lexer =>
+         Put_Line ("with WisiToken.Lexer.re2c;");
+         Put_Line ("with " & Output_File_Name_Root & "_re2c_c;");
+
+      end case;
+
+      case Common_Data.Generate_Algorithm is
+      when LR_Generate_Algorithm =>
+         if Tuple.Text_Rep then
+            Put_Line ("with WisiToken.Productions;");
+         end if;
+
+      when Packrat_Generate_Algorithm =>
+         Put_Line ("with WisiToken.Parse;");
+
+      when External =>
+         null;
+      end case;
+
+      Put_Line ("package body " & Main_Package_Name & " is");
+      Indent := Indent + 3;
+      New_Line;
+
+      case Common_Data.Lexer is
+      when None | Elisp_Lexer =>
+         null;
+
+      when re2c_Lexer =>
+         Indent_Line ("package Lexer is new WisiToken.Lexer.re2c");
+         Indent_Line ("  (" & Output_File_Name_Root & "_re2c_c.New_Lexer,");
+         Indent_Line ("   " & Output_File_Name_Root & "_re2c_c.Free_Lexer,");
+         Indent_Line ("   " & Output_File_Name_Root & "_re2c_c.Reset_Lexer,");
+         Indent_Line ("   " & Output_File_Name_Root & "_re2c_c.Next_Token);");
+         New_Line;
+      end case;
+
+      case Common_Data.Generate_Algorithm is
+      when LR_Generate_Algorithm =>
+         LR_Create_Create_Parser (Input_Data, Common_Data, Generate_Data);
+
+      when Packrat_Gen =>
+         WisiToken.BNF.Generate_Packrat (Packrat_Data, Generate_Data);
+         Packrat_Create_Create_Parser (Common_Data, Generate_Data, 
Packrat_Data);
+
+      when Packrat_Proc =>
+         Packrat_Create_Create_Parser (Common_Data, Generate_Data, 
Packrat_Data);
+
+      when External =>
+         External_Create_Create_Grammar (Generate_Data);
+      end case;
+
+      case Common_Data.Interface_Kind is
+      when Process =>
+         null;
+      when Module =>
+         Indent_Line ("Parser : LR_Parser.Instance;");
+         New_Line;
+
+         Indent_Line ("function Parse (Env : Emacs_Env_Access) return 
emacs_module_h.emacs_value");
+         Indent_Line ("is begin");
+         Indent := Indent + 3;
+         Indent_Line ("WisiToken.Trace_Parse := To_Integer (Env, Symbol_Value 
(Env, Elisp_Symbols (Wisi_Debug_ID)));");
+         Indent_Line ("Wisi_Cache_Max := To_Integer (Env, Symbol_Value (Env, 
Elisp_Symbols (Wisi_Cache_Max_ID)));");
+         Indent_Line ("Parser.Reset;");
+         Indent_Line ("Parser.Parse;");
+         Indent_Line ("return Env.Qnil;");
+         Indent := Indent - 3;
+         Indent_Line ("exception");
+         Indent_Line ("when E : WisiToken.Parse_Error | WisiToken.Syntax_Error 
=>");
+         Indent_Line ("   return To_Emacs (Env, 
Ada.Exceptions.Exception_Message (E));");
+         Indent_Line ("when E : others =>");
+         Indent_Line ("   declare");
+         Indent_Line ("      use Ada.Exceptions;");
+         Indent_Line ("   begin");
+         Indent_Line ("      return To_Emacs (Env, Exception_Name (E) & "": "" 
& Exception_Message (E));");
+         Indent_Line ("   end;");
+         Indent_Line ("end Parse;");
+         New_Line;
+
+         Indent_Line ("function Init (Env : Emacs_Env_Access) return 
Interfaces.C.int");
+         Indent_Line ("is");
+         Indent_Line ("   Lexer_Elisp_Symbols : 
Lexers.Elisp_Array_Emacs_Value;");
+         Indent_Line ("begin");
+         Indent_Line ("   " & Main_Package_Name & ".Env := Env;");
+         Indent_Line ("   Emacs_Module_Aux.Init (Env);");
+         Indent_Line ("   for I in Token_Symbols'Range loop");
+         Indent_Line ("      Token_Symbols (I) := Intern_Soft (Env, 
Token_Images (I).all);");
+         Indent_Line ("   end loop;");
+         Indent_Line ("   for I in Elisp_Symbols'Range loop");
+         Indent_Line ("      Elisp_Symbols (I) := Intern_Soft (Env, User_Names 
(I).all);");
+         Indent_Line ("   end loop;");
+         Indent_Line ("   for I in Elisp_Numbers'Range loop");
+         Indent_Line ("      Elisp_Numbers (I) := Env.make_fixnum (Env, 
emacs_module_h.int64_t (I));");
+         Indent_Line ("   end loop;");
+         Indent_Line ("   for I in Lexer_Elisp_Symbols'Range loop");
+         Indent_Line ("      Lexer_Elisp_Symbols (I) := Intern_Soft (Env, 
Lexers.User_Names (I).all);");
+         Indent_Line ("   end loop;");
+         Indent_Line ("   Parser := Create_Parser (Env, 
Lexer_Elisp_Symbols);");
+         Indent_Line ("   return 0;");
+         Indent_Line ("exception");
+         Indent_Line ("when E : others =>");
+         Indent_Line
+           ("   Signal_Error (Env, " &
+              "Ada.Exceptions.Exception_Name (E) & "": "" & 
Ada.Exceptions.Exception_Message (E), Env.Qnil);");
+         Indent_Line ("   return 1;");
+         Indent_Line ("end Init;");
+         New_Line;
+      end case;
+
+      Put_Line ("end " & Main_Package_Name & ";");
+      Close (Body_File);
+
+      Set_Output (Standard_Output);
+
+   end Create_Ada_Main_Body;
+
+   procedure Create_Process_Elisp
+   is
+      use Generate_Utils;
+      use WisiToken.Generate;
+
+      File : File_Type;
+
+      Paren_1_Done : Boolean := False;
+   begin
+      Create (File, Out_File, Output_File_Name_Root & "-process.el");
+      Set_Output (File);
+      Indent := 1;
+
+      Put_Line
+        (";;; " & Output_File_Name_Root & "-process.el --- Generated parser 
support file  -*- lexical-binding:t -*-");
+      Put_Command_Line (Elisp_Comment & "  ", Use_Tuple => True, Tuple => 
Tuple);
+      Put_Raw_Code (Elisp_Comment, Input_Data.Raw_Code (Copyright_License));
+      New_Line;
+      Put_Line ("(require 'wisi-process-parse)");
+      New_Line;
+
+      Indent_Line  ("(defconst " & Output_File_Name_Root & 
"-process-token-table");
+      Indent_Start ("  [");
+      Indent := Indent + 3;
+      for Cursor in All_Tokens (Generate_Data).Iterate loop
+         if Paren_1_Done then
+            Indent_Line (Name (Cursor));
+         else
+            Paren_1_Done := True;
+            Put_Line (Name (Cursor));
+         end if;
+
+      end loop;
+      Indent_Line ("])");
+      Indent := Indent - 3;
+      New_Line;
+
+      Output_Elisp_Common.Indent_Name_Table
+        (Output_File_Name_Root, "process-face-table", 
Input_Data.User_Names.Faces);
+
+      Put_Line ("(provide '" & Output_File_Name_Root & "-process)");
+      Set_Output (Standard_Output);
+      Close (File);
+
+   end Create_Process_Elisp;
+
+   procedure Create_Module_Elisp
+   is
+      use Ada.Strings.Unbounded;
+      use Generate_Utils;
+      use WisiToken.Generate;
+
+      Lower_Package_Name_Root : constant String := To_Lower (File_Name_To_Ada 
(Output_File_Name_Root));
+
+      function To_ID_Image (Name : in Ada.Strings.Unbounded.Unbounded_String) 
return String
+      is begin
+         --  Ada 'Val is 0 origin; Token_ID is 1 origin
+         return Token_ID'Image (-1 + Find_Token_ID (Generate_Data, -Name));
+      end To_ID_Image;
+
+      File : File_Type;
+   begin
+      Create (File, Out_File, Output_File_Name_Root & "-module.el");
+      Set_Output (File);
+      Indent := 1;
+
+      Put_Line (";; generated by WisiToken Wisi from " & 
Input_Data.Grammar_Lexer.File_Name);
+      Put_Command_Line (";; ", Use_Tuple => True, Tuple => Tuple);
+      Put_Line (";;");
+
+      --  don't need the prologue here
+
+      Put_Line ("(require 'wisi-parse-common)");
+      New_Line;
+
+      --  Lexer tables; also contain terminals for wisi-tokens
+      Indent_Keyword_Table (Output_File_Name_Root, "elisp", 
Input_Data.Tokens.Keywords, To_String'Access);
+      Indent_Keyword_Table (Output_File_Name_Root, "module", 
Input_Data.Tokens.Keywords, To_ID_Image'Access);
+      Indent_Token_Table (Output_File_Name_Root, "elisp", 
Input_Data.Tokens.Tokens, To_String'Access);
+      Indent_Token_Table (Output_File_Name_Root, "module", 
Input_Data.Tokens.Tokens, To_ID_Image'Access);
+
+      --  non-terminals. We only need the ones that actually have
+      --  actions, and thus will appear in a call to To_Emacs. But
+      --  Token_Symbols must be indexed by Token_ID, so we declare
+      --  all of them.
+      Indent_Line ("(defconst " & Output_File_Name_Root & "-module-nonterms");
+      Indent_Line (" '(");
+      Indent := Indent + 3;
+      Indent_Line (WisiToken_Accept_Name);
+      for Rule of Input_Data.Tokens.Rules loop
+         Indent_Line (-Rule.Left_Hand_Side);
+      end loop;
+      Indent_Line ("))");
+      Indent := Indent - 3;
+      New_Line;
+
+      Indent_Line
+        ("(cl-defstruct (" & Lower_Package_Name_Root &
+           "-wisi-module-parser (:include wisi-parser)))");
+      New_Line;
+      Indent_Line ("(defun " & Lower_Package_Name_Root & 
"-wisi-module-parser-make (dll-name)");
+      Indent_Line ("  (module-load dll-name)");
+      Indent_Line ("  (make-" & Lower_Package_Name_Root & 
"-wisi-module-parser))");
+      New_Line;
+
+      Indent_Line ("(defvar " & Lower_Package_Name_Root & "-module-lexer 
nil)");
+      Indent_Line
+        ("(declare-function " &
+           Lower_Package_Name_Root &
+           "-wisi-module-parse """ &
+           Lower_Package_Name_Root &
+           "-wisi-module-parse.c"")");
+      New_Line;
+
+      Indent_Line
+        ("(cl-defmethod wisi-parse-current ((parser " &
+           Lower_Package_Name_Root &
+           "-wisi-module-parser))");
+      Indent := Indent + 2;
+      Indent_Line ("(let* ((wisi-lexer " & Lower_Package_Name_Root & 
"-module-lexer)");
+      Indent_Line ("       (result (" & Lower_Package_Name_Root & 
"-wisi-module-parse)))");
+      --  Result is nil for no errors, a string for some error.
+      --  Ada code has already added line:column, but not file name
+      Indent_Line ("  (when result");
+      Indent_Line ("    (signal 'wisi-parse-error (format ""%s:%s"" 
(buffer-name) result)))))");
+      New_Line;
+      Indent := Indent - 2;
+
+      Indent_Line ("(provide '" & Output_File_Name_Root & "-module)");
+      Set_Output (Standard_Output);
+      Close (File);
+
+   end Create_Module_Elisp;
+
+   procedure Create_Module_Aux
+   is
+      use WisiToken.Generate;
+
+      Package_Name_Root       : constant String := File_Name_To_Ada 
(Output_File_Name_Root);
+      Lower_Package_Name_Root : constant String := To_Lower 
(Package_Name_Root);
+
+      File : File_Type;
+   begin
+      Create (File, Out_File, Output_File_Name_Root & 
"_wisi_module_parse.gpr");
+      Set_Output (File);
+      Indent := 1;
+      Put_Line ("-- generated by WisiToken Wisi from " & 
Input_Data.Grammar_Lexer.File_Name);
+      Put_Command_Line ("-- ", Use_Tuple => True, Tuple => Tuple);
+      Indent_Line ("with ""wisi_module_parse_common"";");
+      Indent_Line ("library project " & Package_Name_Root & 
"_Wisi_Module_Parse is");
+      New_Line;
+      Indent := Indent + 3;
+      Indent_Line ("for Languages use (""Ada"");");
+      Indent_Line ("for Source_Dirs use (""../.."", ""."");");
+      New_Line;
+      Indent_Line ("for Source_Files use");
+      Indent_Line ("  (");
+      Indent := Indent + 3;
+      Indent_Line ("""emacs_module_aux.ads"",");
+      Indent_Line ("""emacs_module_aux.adb"",");
+      Indent_Line ("""emacs_module_h.ads"",");
+      Indent_Line ("""fasttoken-lexer-wisi_elisp.adb"",");
+      Indent_Line ("""fasttoken-lexer-wisi_elisp.ads"",");
+      Indent_Line ("""" & Lower_Package_Name_Root & "_module.adb"",");
+      Indent_Line ("""" & Lower_Package_Name_Root & "_module.ads""");
+      Indent := Indent - 3;
+      Indent_Line ("  );");
+      New_Line;
+      Indent_Line ("for Object_Dir use ""libobjsjlj"";");
+      Indent_Line ("for Library_Name use """ & Lower_Package_Name_Root & 
"_wisi_module_parse"";");
+      Indent_Line ("for Library_Dir use ""libsjlj"";");
+      --  This library is linked with *_wisi_module_parse_wrapper.c to
+      --  make a dynamic library
+      Indent_Line ("for Library_Kind use ""static"";");
+      New_Line;
+      Indent_Line ("package Compiler is");
+      Indent := Indent + 3;
+      Indent_Line
+        ("for Default_Switches (""Ada"") use 
Wisi_Module_Parse_Common.Compiler'Default_Switches (""Ada"");");
+
+      --  Grammar files can get very large, so they need some special switches:
+      --
+      --  'Wisi_Module_Parse_Common.Compiler'Default_Switches' includes 
'gnatn', but that hangs
+      Indent_Line ("case Wisi_Module_Parse_Common.Build is");
+      Indent_Line ("when ""Debug"" =>");
+      Indent_Line ("   for Switches (""" & Lower_Package_Name_Root & 
"_module.adb"") use");
+      Indent_Line ("     Wisi_Module_Parse_Common.Compiler.Common_Switches &");
+      Indent_Line ("     Wisi_Module_Parse_Common.Compiler.Standard_Style &");
+      Indent_Line ("     (""-O0"");");
+      Indent_Line ("when ""Normal"" =>");
+      Indent_Line ("   for Switches (""" & Lower_Package_Name_Root & 
"_module.adb"") use");
+      Indent_Line ("     Wisi_Module_Parse_Common.Compiler.Common_Switches &");
+      Indent_Line ("     Wisi_Module_Parse_Common.Compiler.Standard_Style &");
+      Indent_Line ("     (""-O2"");");
+      Indent_Line ("end case;");
+
+      Indent := Indent - 3;
+      Indent_Line ("end Compiler;");
+      New_Line;
+      Indent_Line ("package Builder is");
+      Indent_Line
+        ("   for Default_Switches (""Ada"") use 
Wisi_Module_Parse_Common.Builder'Default_Switches (""Ada"");");
+      Indent_Line ("end Builder;");
+      Indent := Indent - 3;
+      New_Line;
+      Indent_Line ("end " & Package_Name_Root & "_Wisi_Module_Parse;");
+      Set_Output (Standard_Output);
+      Close (File);
+
+      Create (File, Out_File, Output_File_Name_Root & 
"_wisi_module_parse_agg.gpr");
+      Set_Output (File);
+      Indent := 1;
+      Put_Line ("-- generated by WisiToken Wisi from " & 
Input_Data.Grammar_Lexer.File_Name);
+      Put_Command_Line ("-- ", Use_Tuple => True, Tuple => Tuple);
+      Indent_Line ("aggregate project " & Package_Name_Root & 
"_Wisi_Module_Parse_Agg is");
+      Indent_Line ("   for Project_Path use (external (""WISI_FASTTOKEN""));");
+      Indent_Line ("   for Project_files use (""" & Lower_Package_Name_Root & 
"_wisi_module_parse.gpr"");");
+      Indent_Line ("end " & Package_Name_Root & "_Wisi_Module_Parse_Agg;");
+      Set_Output (Standard_Output);
+      Close (File);
+
+      Create (File, Out_File, Output_File_Name_Root & 
"_wisi_module_parse_wrapper.c");
+      Set_Output (File);
+      Indent := 1;
+      Put_Line ("// generated by WisiToken Wisi from " & 
Input_Data.Grammar_Lexer.File_Name);
+      Put_Command_Line ("// ", Use_Tuple => True, Tuple => Tuple);
+      Indent_Line ("//  This file is just a wrapper around the Ada code in");
+      Indent_Line ("//  *_wisi_module_parse.adb; it is needed to call 
adainit.");
+      Indent_Line ("#include <emacs_module.h>");
+      Indent_Line ("int plugin_is_GPL_compatible;");
+      Indent_Line ("extern void adainit(void);");
+      Indent_Line ("extern int " & Lower_Package_Name_Root & 
"_wisi_module_parse_init (emacs_env *env);");
+      Indent_Line ("/* Parse current buffer, using parser in current module. 
*/");
+      Indent_Line ("extern emacs_value " & Lower_Package_Name_Root & 
"_wisi_module_parse (emacs_env *env);");
+      Indent_Line ("static emacs_value Fparse (emacs_env *env, int nargs, 
emacs_value args[])");
+      Indent_Line ("{");
+      Indent_Line ("  return " & Lower_Package_Name_Root & "_wisi_module_parse 
(env);");
+      Indent_Line ("}");
+      New_Line;
+      Indent_Line ("int emacs_module_init (struct emacs_runtime *ert)");
+      Indent_Line ("{");
+      Indent_Line ("  emacs_env *env = ert->get_environment (ert);");
+      Indent_Line
+        ("  env->bind_function (env, """ & Lower_Package_Name_Root &
+           "-wisi-module-parse"", env->make_function (env, 1, 1, Fparse));");
+      Indent_Line ("  adainit();");
+      Indent_Line ("  return " & Lower_Package_Name_Root & 
"_wisi_module_parse_init (env);");
+      Indent_Line ("}");
+      Set_Output (Standard_Output);
+      Close (File);
+   end Create_Module_Aux;
+
+begin
+   case Common_Data.Lexer is
+   when None | re2c_Lexer =>
+      null;
+
+   when Elisp_Lexer =>
+      raise User_Error with WisiToken.Generate.Error_Message
+        (Input_Data.Grammar_Lexer.File_Name, 1, "Ada_Emacs output language 
does not support " &
+           Lexer_Image (Common_Data.Lexer).all & " lexer");
+   end case;
+
+   declare
+      Actions_Package_Name : constant String := File_Name_To_Ada 
(Output_File_Name_Root) &
+        (case Common_Data.Interface_Kind is
+         when Process => "_Process_Actions",
+         when Module  => "_Module_Actions");
+
+      Main_Package_Name : constant String := File_Name_To_Ada 
(Output_File_Name_Root) &
+        (case Common_Data.Interface_Kind is
+         when Process => "_Process",
+         when Module  => "_Module") &
+        Gen_Alg_Name & "_Main";
+   begin
+      Create_Ada_Actions_Body (Generate_Data.Action_Names, 
Generate_Data.Check_Names, Actions_Package_Name);
+
+      Create_Ada_Actions_Spec
+        (Output_File_Name => Output_File_Name_Root &
+           (case Common_Data.Interface_Kind is
+            when Process  => "_process_actions.ads",
+            when Module   => "_module_actions.ads"),
+         Package_Name     => Actions_Package_Name,
+         Input_Data       => Input_Data,
+         Common_Data      => Common_Data,
+         Generate_Data    => Generate_Data);
+
+      if Tuple.Gen_Alg = External then
+         Create_External_Main_Spec (Main_Package_Name, Tuple, Input_Data);
+
+         Create_Ada_Main_Body (Actions_Package_Name, Main_Package_Name);
+      else
+         Create_Ada_Main_Body (Actions_Package_Name, Main_Package_Name);
+
+         Create_Ada_Main_Spec
+           (Output_File_Name  => Output_File_Name_Root & "_" &
+              To_Lower (Interface_Type'Image (Common_Data.Interface_Kind)) &
+              To_Lower (Gen_Alg_Name) & "_main.ads",
+            Main_Package_Name => Main_Package_Name,
+            Common_Data       => Common_Data,
+            Input_Data        => Input_Data);
+      end if;
+   end;
+
+   case Common_Data.Interface_Kind is
+   when Process =>
+      Create_Process_Elisp;
+
+   when Module =>
+      Create_Module_Elisp;
+      Create_Module_Aux;
+   end case;
+exception
+when others =>
+   Set_Output (Standard_Output);
+   raise;
+end WisiToken.BNF.Output_Ada_Emacs;
diff --git a/wisitoken-bnf-output_elisp.adb b/wisitoken-bnf-output_elisp.adb
new file mode 100644
index 0000000..8317ac7
--- /dev/null
+++ b/wisitoken-bnf-output_elisp.adb
@@ -0,0 +1,293 @@
+--  Abstract :
+--
+--  Output Elisp code implementing the grammar defined by the parameters.
+--
+--  Copyright (C) 2012 - 2015, 2017, 2018 Stephen Leake.  All Rights Reserved.
+--
+--  The WisiToken package is free software; you can redistribute it
+--  and/or modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or
+--  (at your option) any later version. This library 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.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Text_IO; use Ada.Text_IO;
+with WisiToken.BNF.Generate_Utils;
+with WisiToken.BNF.Output_Elisp_Common;
+with WisiToken.Generate.Packrat;
+with WisiToken.Parse.LR;
+with WisiToken_Grammar_Runtime;
+procedure WisiToken.BNF.Output_Elisp
+  (Input_Data    :         in WisiToken_Grammar_Runtime.User_Data_Type;
+   Elisp_Package :         in String;
+   Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data;
+   Packrat_Data  :         in WisiToken.Generate.Packrat.Data;
+   Tuple         :         in Generate_Tuple)
+is
+   pragma Unreferenced (Packrat_Data);
+
+   procedure Action_Table (Table : in WisiToken.Parse.LR.Parse_Table; 
Descriptor : in WisiToken.Descriptor)
+   is
+      use WisiToken.Parse.LR;
+   begin
+      Put ("     [");
+      for State in Table.States'Range loop
+         if State = Table.States'First then
+            Put ("(");
+         else
+            Put ("      (");
+         end if;
+
+         Put ("(default . error)");
+
+         declare
+            Action : Action_Node_Ptr := Table.States (State).Action_List;
+         begin
+            loop
+               declare
+                  Parse_Action_Node : Parse_Action_Node_Ptr := Action.Action;
+                  Conflict          : constant Boolean      := 
Parse_Action_Node.Next /= null;
+               begin
+                  Put (" (" & Image (Action.Symbol, Descriptor) & " . ");
+
+                  if Conflict then
+                     Put ("(");
+                  end if;
+
+                  loop
+                     declare
+                        Parse_Action : Parse_Action_Rec renames 
Parse_Action_Node.Item;
+                     begin
+                        case Parse_Action.Verb is
+                        when Accept_It =>
+                           Put ("accept");
+
+                        when Error =>
+                           Put ("error");
+
+                        when Reduce =>
+                           Put
+                             ("(" & Image (Parse_Action.Production.LHS, 
Descriptor) & " ." &
+                                Integer'Image (Parse_Action.Production.RHS) & 
")");
+
+                        when Shift =>
+                           Put (State_Index'Image (Parse_Action.State));
+
+                        end case;
+
+                        if Parse_Action_Node.Next = null then
+                           if Conflict then
+                              Put (")");
+                           end if;
+                           Put (")");
+                           exit;
+                        else
+                           Put (" ");
+                           Parse_Action_Node := Parse_Action_Node.Next;
+                        end if;
+                     end;
+                  end loop;
+               end;
+
+               Action := Action.Next;
+
+               if Action.Next = null then
+                  if Action.Action.Item.Verb /= Error then
+                     raise SAL.Programmer_Error with "state" &
+                       State_Index'Image (State) & ": default action is not 
error";
+                  end if;
+                  --  let default handle it
+                  Action := null;
+               end if;
+
+               if Action = null then
+                  if State = Table.States'Last then
+                     Put (")");
+                  else
+                     Put_Line (")");
+                  end if;
+                  exit;
+               end if;
+            end loop;
+         end;
+      end loop;
+      Put_Line ("]");
+   end Action_Table;
+
+   procedure Goto_Table (Table : in WisiToken.Parse.LR.Parse_Table; Descriptor 
: in WisiToken.Descriptor)
+   is
+      use WisiToken.Parse.LR;
+
+      subtype Nonterminals is Token_ID range Descriptor.First_Nonterminal .. 
Descriptor.Last_Nonterminal;
+
+      function Count_Nonterminals (List : in Goto_Node_Ptr) return Integer
+      is
+         Item  : Goto_Node_Ptr := List;
+         Count : Integer       := 0;
+      begin
+         while Item /= null loop
+            if Symbol (Item) in Nonterminals then
+               Count := Count + 1;
+            end if;
+            Item := Next (Item);
+         end loop;
+         return Count;
+      end Count_Nonterminals;
+
+   begin
+      Put ("     [");
+      for State in Table.States'Range loop
+         declare
+            Nonterminal_Count : constant Integer := Count_Nonterminals 
(Table.States (State).Goto_List);
+            Gotos             : Goto_Node_Ptr    := Table.States 
(State).Goto_List;
+         begin
+            if Nonterminal_Count = 0 then
+               if State = Table.States'First then
+                  Put_Line ("nil");
+               else
+                  if State = Table.States'Last then
+                     Put ("      nil");
+                  else
+                     Put_Line ("      nil");
+                  end if;
+               end if;
+            else
+               if State = Table.States'First then
+                  Put ("(");
+               else
+                  Put ("      (");
+               end if;
+               loop
+                  if Symbol (Gotos) in Nonterminals then
+                     Put ("(" & Image (Symbol (Gotos), Descriptor) & " ." &
+                            State_Index'Image (Parse.LR.State (Gotos)) & ")");
+                  end if;
+                  Gotos := Next (Gotos);
+                  exit when Gotos = null;
+               end loop;
+               if State = Table.States'Last then
+                  Put (")");
+               else
+                  Put_Line (")");
+               end if;
+            end if;
+         end;
+      end loop;
+      Put ("]");
+   end Goto_Table;
+
+   procedure Output
+     (Elisp_Package : in String;
+      Tokens        : in WisiToken.BNF.Tokens;
+      Parser        : in WisiToken.Parse.LR.Parse_Table_Ptr;
+      Descriptor    : in WisiToken.Descriptor)
+   is
+      use Ada.Strings.Unbounded;
+      use Ada.Containers; -- count_type
+
+      Rule_Length : constant Count_Type := Tokens.Rules.Length;
+      Rule_Count  : Count_Type := 1;
+
+      RHS_Length : Count_Type;
+      RHS_Count  : Count_Type;
+   begin
+      Put_Line ("(defconst " & Elisp_Package & "-elisp-parse-table");
+      Put_Line ("   (wisi-compile-grammar");
+
+      --  nonterminal productions
+      Put ("   '((");
+      for Rule of Tokens.Rules loop
+         if Rule_Count = 1 then
+            Put ("(");
+         else
+            Put ("      (");
+         end if;
+         Put_Line (-Rule.Left_Hand_Side);
+
+         RHS_Length := Rule.Right_Hand_Sides.Length;
+         RHS_Count  := 1;
+         for RHS of Rule.Right_Hand_Sides loop
+            Put ("       ((");
+            for Token of RHS.Tokens loop
+               Put (Token & " ");
+            end loop;
+            if Length (RHS.Action) = 0 then
+               Put (")");
+            else
+               Put_Line (")");
+               Put ("        " & (-RHS.Action));
+            end if;
+
+            if RHS_Count = RHS_Length then
+               Put (")");
+            else
+               Put_Line (")");
+            end if;
+            RHS_Count := RHS_Count + 1;
+         end loop;
+         if Rule_Count = Rule_Length then
+            Put (")");
+         else
+            Put_Line (")");
+         end if;
+         Rule_Count := Rule_Count + 1;
+      end loop;
+      Put_Line (")");
+
+      Action_Table (Parser.all, Descriptor);
+      Goto_Table (Parser.all, Descriptor);
+      Put_Line ("))");
+
+      Put_Line ("  ""Parser table."")");
+   end Output;
+
+   procedure Create_Elisp (Algorithm : in LR_Generate_Algorithm)
+   is
+      use Ada.Strings.Unbounded;
+      File            : File_Type;
+      Elisp_Package_1 : constant String :=
+        (case Algorithm is
+         when LALR => Elisp_Package & "-lalr",
+         when LR1  => Elisp_Package & "-lr1");
+   begin
+      Create (File, Out_File, Elisp_Package_1 & "-elisp.el");
+      Set_Output (File);
+
+      Put_Line (";;; " & Elisp_Package_1 & "-elisp.el --- Generated parser 
support file  -*- lexical-binding:t -*-");
+      Put_Command_Line (Elisp_Comment & "  ", Use_Tuple => True, Tuple => 
Tuple);
+      Put_Raw_Code (Elisp_Comment, Input_Data.Raw_Code (Copyright_License));
+      Put_Raw_Code (Elisp_Comment, Input_Data.Raw_Code (Actions_Spec_Context));
+      New_Line;
+
+      Put_Line ("(require 'wisi)");
+      Put_Line ("(require 'wisi-compile)");
+      Put_Line ("(require 'wisi-elisp-parse)");
+      New_Line;
+      Output_Elisp_Common.Indent_Keyword_Table
+        (Elisp_Package_1, "elisp", Input_Data.Tokens.Keywords, 
To_String'Access);
+      New_Line;
+      Output_Elisp_Common.Indent_Token_Table (Elisp_Package_1, "elisp", 
Input_Data.Tokens.Tokens, To_String'Access);
+      New_Line;
+      Output (Elisp_Package_1, Input_Data.Tokens, 
Generate_Data.LR_Parse_Table, Generate_Data.Descriptor.all);
+      New_Line;
+      Put_Line ("(provide '" & Elisp_Package_1 & "-elisp)");
+      Put_Line (";; end of file");
+      Close (File);
+
+      Set_Output (Standard_Output);
+   end Create_Elisp;
+
+begin
+   Create_Elisp (Tuple.Gen_Alg);
+
+   if WisiToken.Trace_Generate > 0 then
+      WisiToken.BNF.Generate_Utils.Put_Stats (Input_Data, Generate_Data);
+   end if;
+end WisiToken.BNF.Output_Elisp;
diff --git a/wisitoken-bnf-output_elisp_common.adb 
b/wisitoken-bnf-output_elisp_common.adb
new file mode 100644
index 0000000..fc37469
--- /dev/null
+++ b/wisitoken-bnf-output_elisp_common.adb
@@ -0,0 +1,145 @@
+--  Abstract :
+--
+--  See spec
+--
+--  Copyright (C) 2012, 2013, 2015, 2017, 2018 Stephen Leake.  All Rights 
Reserved.
+--
+--  This program is free software; you can redistribute it and/or
+--  modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or (at
+--  your option) any later version. This program 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
+--  distributed with this program; see file COPYING. If not, write to
+--  the Free Software Foundation, 51 Franklin Street, Suite 500, Boston,
+--  MA 02110-1335, USA.
+
+pragma License (GPL);
+
+with Ada.Text_IO;
+with WisiToken.Generate;
+package body WisiToken.BNF.Output_Elisp_Common is
+
+   function Find_Elisp_ID (List : in String_Lists.List; Elisp_Name : in 
String) return Integer
+   is
+      I : Integer := 0; -- match elisp array
+   begin
+      for Name of List loop
+         if Name = Elisp_Name then
+            return I;
+         end if;
+         I := I + 1;
+      end loop;
+      raise Not_Found with "unknown elisp name: '" & Elisp_Name & "'";
+   end Find_Elisp_ID;
+
+   function Elisp_Name_To_Ada
+     (Elisp_Name : in String;
+      Append_ID  : in Boolean;
+      Trim       : in Integer)
+     return String
+   is
+      Result : String := Elisp_Name (Elisp_Name'First + Trim .. 
Elisp_Name'Last);
+   begin
+      Result (Result'First) := To_Upper (Result (Result'First));
+      for I in Result'Range loop
+         if Result (I) = '-' then
+            Result (I) := '_';
+            Result (I + 1) := To_Upper (Result (I + 1));
+         elsif Result (I) = '_' then
+            Result (I + 1) := To_Upper (Result (I + 1));
+         end if;
+      end loop;
+      if Append_ID then
+         return Result & "_ID"; -- Some elisp names may be Ada reserved words;
+      else
+         return Result;
+      end if;
+   end Elisp_Name_To_Ada;
+
+   procedure Indent_Keyword_Table
+     (Output_File_Root : in     String;
+      Label            : in     String;
+      Keywords         : in     String_Pair_Lists.List;
+      Image            : access function (Name : in 
Ada.Strings.Unbounded.Unbounded_String) return String)
+   is
+      use Ada.Text_IO;
+      use WisiToken.Generate;
+   begin
+      Indent_Line ("(defconst " & Output_File_Root & "-" & Label & 
"-keyword-table-raw");
+      Indent_Line ("  '(");
+      Indent := Indent + 3;
+      for Pair of Keywords loop
+         Indent_Line ("(" & (-Pair.Value) & " . " & Image (Pair.Name) & ")");
+      end loop;
+      Indent_Line ("))");
+      Indent := Indent - 3;
+   end Indent_Keyword_Table;
+
+   procedure Indent_Token_Table
+     (Output_File_Root : in     String;
+      Label            : in     String;
+      Tokens           : in     Token_Lists.List;
+      Image            : access function (Name : in 
Ada.Strings.Unbounded.Unbounded_String) return String)
+   is
+      use Ada.Strings.Unbounded;
+      use Ada.Text_IO;
+      use WisiToken.Generate;
+   begin
+      Indent_Line ("(defconst " & Output_File_Root & "-" & Label & 
"-token-table-raw");
+      Indent_Line ("  '(");
+      Indent := Indent + 3;
+      for Kind of Tokens loop
+         --  We don't use All_Tokens.Iterate here, because we need the
+         --  Kind/token nested list structure, and the order is not important.
+         if not (-Kind.Kind = "line_comment" or -Kind.Kind = "whitespace") then
+            Indent_Line ("(""" & (-Kind.Kind) & """");
+            Indent := Indent + 1;
+            for Token of Kind.Tokens loop
+               if 0 = Length (Token.Value) then
+                  Indent_Line ("(" & Image (Token.Name) & ")");
+               else
+                  if -Kind.Kind = "number" then
+                     --  allow for (<token> <number-p> <require>)
+                     Indent_Line ("(" & Image (Token.Name) & " " & 
(-Token.Value) & ")");
+                  elsif -Kind.Kind = "symbol" or
+                    -Kind.Kind = "string-double" or
+                    -Kind.Kind = "string-single"
+                  then
+                     --  value not used by elisp
+                     Indent_Line ("(" & Image (Token.Name) & " . """")");
+                  else
+                     Indent_Line ("(" & Image (Token.Name) & " . " & 
(-Token.Value) & ")");
+                  end if;
+               end if;
+            end loop;
+            Indent_Line (")");
+            Indent := Indent - 1;
+         end if;
+      end loop;
+      Indent_Line ("))");
+      Indent := Indent - 3;
+   end Indent_Token_Table;
+
+   procedure Indent_Name_Table
+     (Output_File_Root : in     String;
+      Label            : in     String;
+      Names            : in     String_Lists.List)
+   is
+      use Ada.Text_IO;
+      use WisiToken.Generate;
+   begin
+      Indent_Line ("(defconst " & Output_File_Root & "-" & Label);
+      Indent_Line ("  [");
+      Indent := Indent + 3;
+      for Name of Names loop
+         Indent_Line (Name);
+      end loop;
+      Indent_Line ("])");
+      Indent := Indent - 3;
+      New_Line;
+   end Indent_Name_Table;
+
+end WisiToken.BNF.Output_Elisp_Common;
diff --git a/wisitoken-bnf-output_elisp_common.ads 
b/wisitoken-bnf-output_elisp_common.ads
new file mode 100644
index 0000000..cb4e94b
--- /dev/null
+++ b/wisitoken-bnf-output_elisp_common.ads
@@ -0,0 +1,49 @@
+--  Abstract :
+--
+--  Subprograms common to Output_Elisp and Output_Ada_Emacs
+--
+--  Copyright (C) 2012, 2013, 2015, 2017, 2018 Stephen Leake. All Rights 
Reserved.
+--
+--  The WisiToken package is free software; you can redistribute it
+--  and/or modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or
+--  (at your option) any later version. This library 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.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+package WisiToken.BNF.Output_Elisp_Common is
+
+   function Find_Elisp_ID (List : in WisiToken.BNF.String_Lists.List; 
Elisp_Name : in String) return Integer;
+
+   function Elisp_Name_To_Ada
+     (Elisp_Name : in String;
+      Append_ID  : in Boolean;
+      Trim       : in Integer)
+     return String;
+   --  Drop Trim chars from beginning of Elisp_Name, capitalize.
+
+   procedure Indent_Keyword_Table
+     (Output_File_Root : in     String;
+      Label            : in     String;
+      Keywords         : in     String_Pair_Lists.List;
+      Image            : access function (Name : in 
Ada.Strings.Unbounded.Unbounded_String) return String);
+
+   procedure Indent_Token_Table
+     (Output_File_Root : in     String;
+      Label            : in     String;
+      Tokens           : in     Token_Lists.List;
+      Image            : access function (Name : in 
Ada.Strings.Unbounded.Unbounded_String) return String);
+
+   procedure Indent_Name_Table
+     (Output_File_Root : in     String;
+      Label            : in     String;
+      Names            : in     String_Lists.List);
+
+end WisiToken.BNF.Output_Elisp_Common;
diff --git a/wisitoken-bnf-utils.adb b/wisitoken-bnf-utils.adb
new file mode 100644
index 0000000..4ff91b6
--- /dev/null
+++ b/wisitoken-bnf-utils.adb
@@ -0,0 +1,45 @@
+--  Abstract :
+--
+--  See spec
+--
+--  Copyright (C) 2012, 2013, 2015, 2017, 2018 Stephen Leake.  All Rights 
Reserved.
+--
+--  This program is free software; you can redistribute it and/or
+--  modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or (at
+--  your option) any later version. This program 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
+--  distributed with this program; see file COPYING. If not, write to
+--  the Free Software Foundation, 51 Franklin Street, Suite 500, Boston,
+--  MA 02110-1335, USA.
+
+pragma License (GPL);
+
+package body WisiToken.BNF.Utils is
+
+   function Strip_Quotes (Item : in String) return String
+   is begin
+      if Item'Length < 2 then
+         return Item;
+      else
+         return Item
+           ((if Item (Item'First) = '"' then Item'First + 1 else Item'First) ..
+              (if Item (Item'Last) = '"' then Item'Last - 1 else Item'Last));
+      end if;
+   end Strip_Quotes;
+
+   function Strip_Parens (Item : in String) return String
+   is begin
+      if Item'Length < 2 then
+         return Item;
+      else
+         return Item
+           ((if Item (Item'First) = '(' then Item'First + 1 else Item'First) ..
+              (if Item (Item'Last) = ')' then Item'Last - 1 else Item'Last));
+      end if;
+   end Strip_Parens;
+
+end WisiToken.BNF.Utils;
diff --git a/wisitoken-bnf-utils.ads b/wisitoken-bnf-utils.ads
new file mode 100644
index 0000000..4d82f32
--- /dev/null
+++ b/wisitoken-bnf-utils.ads
@@ -0,0 +1,29 @@
+--  Abstract :
+--
+--  Utilities for generating source code from  Wisi source files
+--
+--  Copyright (C) 2012, 2013, 2015, 2017, 2018 Stephen Leake. All Rights 
Reserved.
+--
+--  The WisiToken package is free software; you can redistribute it
+--  and/or modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or
+--  (at your option) any later version. This library 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.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+package WisiToken.BNF.Utils is
+
+   function Strip_Quotes (Item : in String) return String;
+   --  Remove leading and trailing '"', if any.
+
+   function Strip_Parens (Item : in String) return String;
+   --  Remove leading and trailing '()', if any.
+
+end WisiToken.BNF.Utils;
diff --git a/wisitoken-bnf.adb b/wisitoken-bnf.adb
new file mode 100644
index 0000000..cd49de7
--- /dev/null
+++ b/wisitoken-bnf.adb
@@ -0,0 +1,337 @@
+--  Abstract :
+--
+--  see spec
+--
+--  Copyright (C) 2012 - 2015, 2017, 2018 Stephen Leake.  All Rights Reserved.
+--
+--  This program is free software; you can redistribute it and/or
+--  modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or (at
+--  your option) any later version. This program 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
+--  distributed with this program; see file COPYING. If not, write to
+--  the Free Software Foundation, 51 Franklin Street, Suite 500, Boston,
+--  MA 02110-1335, USA.
+
+pragma License (GPL);
+
+with Ada.Command_Line;
+with Ada.Directories;
+with Ada.Text_IO;
+with Ada.Strings.Fixed;
+package body WisiToken.BNF is
+
+   procedure Add
+     (Set   : in out Generate_Set_Access;
+      Tuple : in     Generate_Tuple)
+   is
+      Prev : Generate_Set_Access := Set;
+      Last : constant Integer    := (if Prev = null then 1 else 
Prev.all'Length + 1);
+   begin
+      Set := new Generate_Set (1 .. Last);
+      for I in 1 .. Last - 1 loop
+         Set (I) := Prev (I);
+      end loop;
+      Set (Last) := Tuple;
+      Free (Prev);
+   end Add;
+
+   function To_Output_Language (Item : in String) return Output_Language
+   is begin
+      for I in Output_Language loop
+         if To_Lower (Output_Language_Image (I).all) = To_Lower (Item) then
+            return I;
+         end if;
+      end loop;
+      raise User_Error with "invalid output language name: '" & Item & "'";
+   end To_Output_Language;
+
+   function To_Lexer (Item : in String) return Lexer_Type
+   is begin
+      for I in Valid_Lexer loop
+         if Lexer_Image (I).all = To_Lower (Item) then
+            return I;
+         end if;
+      end loop;
+      raise User_Error with "invalid lexer name: '" & Item & "'";
+   end To_Lexer;
+
+   function Split_Lines (Item : in String) return String_Lists.List
+   is
+      CR : Character renames ASCII.CR;
+      LF : Character renames ASCII.LF;
+
+      Result    : WisiToken.BNF.String_Lists.List;
+      I         : Integer   := Item'First;
+      First     : Integer   := Item'First;
+      Last_Char : Character := ' ';
+   begin
+      loop
+         exit when I > Item'Last;
+         if Item (I) = LF then
+            Result.Append (Item (First .. I - (if Last_Char = CR then 2 else 
1)));
+            First := I + 1;
+
+         elsif I = Item'Last then
+            Result.Append (Item (First .. I));
+         end if;
+
+         Last_Char := Item (I);
+
+         I := I + 1;
+      end loop;
+      return Result;
+   end Split_Lines;
+
+   function Trim (Item : in String_Lists.List; Comment_Start : in String) 
return String_Lists.List
+   is
+      use Ada.Strings;
+      use Ada.Strings.Fixed;
+      Result : String_Lists.List;
+      Comment : Integer;
+
+      procedure Maybe_Append (Line : in String)
+      is begin
+         if Line'Length > 0 then
+            Result.Append (Line);
+         end if;
+      end Maybe_Append;
+
+   begin
+      for Line of Item loop
+         Comment := Index (Line, Comment_Start, Going => Backward);
+         if Comment /= 0 then
+            Maybe_Append (Trim (Line (Line'First .. Comment - 1), Both));
+         else
+            Maybe_Append (Trim (Line, Both));
+         end if;
+      end loop;
+      return Result;
+   end Trim;
+
+   procedure Put_Raw_Code
+     (Comment_Syntax : in String_2;
+      Code           : in String_Lists.List;
+      Comment_Only   : in Boolean := False)
+   is
+      use Ada.Text_IO;
+      Real_Comment_Only : Boolean := Comment_Only;
+   begin
+      for Line of Code loop
+         if Line'Length >= 2 and then
+           ((Line (Line'First) = Line (Line'First + 1)) and
+              Line (Line'First) /= ' ')
+         then
+            --  The line is a comment.
+            Real_Comment_Only := Real_Comment_Only or Line (Line'First .. 
Line'First + 1) /= Comment_Syntax;
+
+            Put_Line (Comment_Syntax & Line (Line'First + 2 .. Line'Last));
+
+         elsif Comment_Syntax = Elisp_Comment and (Line'Length > 0 and then 
Line (Line'First) /= '(') then
+            null;
+
+         elsif not Comment_Only then
+            Put_Line (Line);
+         end if;
+      end loop;
+   end Put_Raw_Code;
+
+   procedure Put_File_Header
+     (Comment_Syntax : in String_2;
+      Emacs_Mode     : in String         := "";
+      Use_Tuple      : in Boolean        := False;
+      Tuple          : in Generate_Tuple := (others => <>))
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line (Comment_Syntax & "  generated parser support file." & 
Emacs_Mode);
+      Put_Command_Line  (Comment_Syntax & "  ", Use_Tuple, Tuple);
+      Put_Line (Comment_Syntax);
+   end Put_File_Header;
+
+   function Is_Present (List : in WisiToken.BNF.String_Pair_Lists.List; Name : 
in String) return Boolean
+   is
+      use all type Ada.Strings.Unbounded.Unbounded_String;
+   begin
+      for Pair of List loop
+         if Pair.Name = Name then
+            return True;
+         end if;
+      end loop;
+      return False;
+   end Is_Present;
+
+   function Value (List : in WisiToken.BNF.String_Pair_Lists.List; Name : in 
String) return String
+   is
+      use all type Ada.Strings.Unbounded.Unbounded_String;
+   begin
+      for Pair of List loop
+         if Pair.Name = Name then
+            return -Pair.Value;
+         end if;
+      end loop;
+      raise Not_Found;
+   end Value;
+
+   function Count (Tokens : in Token_Lists.List) return Integer
+   is
+      Result : Integer := 0;
+   begin
+      for Kind of Tokens loop
+         Result := Result + Integer (Kind.Tokens.Length);
+      end loop;
+      return Result;
+   end Count;
+
+   procedure Add_Token
+     (Tokens : in out Token_Lists.List;
+      Kind   : in     String;
+      Name   : in     String;
+      Value  : in     String)
+   is
+      use type Ada.Strings.Unbounded.Unbounded_String;
+   begin
+      for Token_Kind of Tokens loop
+         if Token_Kind.Kind = Kind then
+            Token_Kind.Tokens.Append ((+Name, +Value));
+            return;
+         end if;
+      end loop;
+
+      --  Kind not found; add it
+      declare
+         Temp : String_Pair_Lists.List;
+      begin
+         Temp.Append ((+Name, +Value));
+         Tokens.Append ((+Kind, Temp));
+      end;
+   end Add_Token;
+
+   function Is_In (Tokens : in Token_Lists.List; Kind : in String) return 
Boolean
+   is begin
+      for Token of Tokens loop
+         if -Token.Kind = Kind then
+            return True;
+         end if;
+      end loop;
+      return False;
+   end Is_In;
+
+   function Is_In
+     (Tokens : in Token_Lists.List;
+      Kind   : in String;
+      Value  : in String)
+     return Boolean
+   is begin
+      for Token of Tokens loop
+         if -Token.Kind = Kind then
+            for Item of Token.Tokens loop
+               if -Item.Value = Value then
+                  return True;
+               end if;
+            end loop;
+         end if;
+      end loop;
+      return False;
+   end Is_In;
+
+   function Is_Present (Rules : in Rule_Lists.List; LHS : in String) return 
Boolean
+   is
+      use Rule_Lists;
+
+      Found : Boolean := False;
+
+      procedure Process (Position : in Cursor)
+      is begin
+         if -Rules (Position).Left_Hand_Side = LHS then
+            Found := True;
+         end if;
+      end Process;
+
+   begin
+      Rules.Iterate (Process'Access);
+      return Found;
+   end Is_Present;
+
+   function "+" (List : in String_Lists.List; Item : in String) return 
String_Lists.List
+   is
+      Result : String_Lists.List := List;
+   begin
+      Result.Append (Item);
+      return Result;
+   end "+";
+
+   function String_To_String_List (Item : in String) return String_Lists.List
+   is
+      Result : String_Lists.List;
+   begin
+      Result.Append (Item);
+      return Result;
+   end String_To_String_List;
+
+   function RHS_To_RHS_List (Item : in RHS_Type) return RHS_Lists.List
+   is
+      Result : RHS_Lists.List;
+   begin
+      Result.Append (Item);
+      return Result;
+   end RHS_To_RHS_List;
+
+   function "+" (List : in RHS_Lists.List; Item : in RHS_Type) return 
RHS_Lists.List
+   is
+      Result : RHS_Lists.List := List;
+   begin
+      Result.Append (Item);
+      return Result;
+   end "+";
+
+   procedure Put_Command_Line
+     (Comment_Prefix : in String;
+      Use_Tuple      : in Boolean        := False;
+      Tuple          : in Generate_Tuple := (others => <>))
+   is
+      use Ada.Command_Line;
+      use Ada.Text_IO;
+
+      Max_Line_Length : constant := 120;
+      Col : Integer := 0;
+
+      procedure Put (Item : in String; Leading_Space : in Boolean)
+      is begin
+         if Col > 0 and Col + Item'Length + 1 > Max_Line_Length then
+            New_Line;
+            Col := Comment_Prefix'Length;
+            Put (Comment_Prefix);
+         else
+            if Leading_Space then
+               Put (" ");
+               Col := Col + 1;
+            end if;
+         end if;
+
+         Col := Col + Item'Length;
+         Put (Item);
+      end Put;
+   begin
+      Put (Comment_Prefix & "command line:", False);
+      Put (Ada.Directories.Simple_Name (Command_Name), True);
+      if Use_Tuple then
+         Put (" --generate " & Generate_Algorithm'Image (Tuple.Gen_Alg) & " " &
+                Output_Language_Image (Tuple.Out_Lang).all &
+                (if Tuple.Lexer /= None then " " & Lexer_Image 
(Tuple.Lexer).all else "") &
+                (if Tuple.Interface_Kind /= None then " " & 
Interface_Type'Image (Tuple.Interface_Kind) else "") &
+                (if Tuple.Text_Rep then " text_rep" else "") &
+                " " & Argument (Argument_Count), --  .wy file
+              True);
+      else
+         for I in 1 .. Argument_Count loop
+            Put (Argument (I), True);
+         end loop;
+      end if;
+      New_Line;
+   end Put_Command_Line;
+
+end WisiToken.BNF;
diff --git a/wisitoken-bnf.ads b/wisitoken-bnf.ads
new file mode 100644
index 0000000..60fb96a
--- /dev/null
+++ b/wisitoken-bnf.ads
@@ -0,0 +1,310 @@
+--  Abstract :
+--
+--  Root package for generating a parser from a BNF source file; see [2]
+--
+--  The input file syntax is based on BNF syntax [1] with declarations
+--  and grammar actions.
+--
+--  The Elisp and Ada_Emacs output languages are for use with the
+--  Emacs wisi package.
+--
+--  Reference :
+--
+--  [1] https://en.wikipedia.org/wiki/Backus%E2%80%93Naur_form
+--  [2] http://www.nongnu.org/ada-mode/wisi/wisi-user_guide.html, (info 
"(wisi-user_guide)Top")
+--
+--  Copyright (C) 2012 - 2015, 2017, 2018 Stephen Leake.  All Rights Reserved.
+--
+--  The WisiToken package is free software; you can redistribute it
+--  and/or modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or
+--  (at your option) any later version. This library 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.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Characters.Handling;
+with Ada.Containers.Doubly_Linked_Lists;
+with Ada.Containers.Indefinite_Doubly_Linked_Lists;
+with Ada.Strings.Unbounded;
+with Ada.Unchecked_Deallocation;
+with WisiToken;
+package WisiToken.BNF is
+
+   --  See also WisiToken exceptions
+
+   Not_Found : exception;
+   --  something not found; should be handled and converted to Syntax_ or 
Grammar_Error
+
+   type Generate_Algorithm is (None, LALR, LR1, Packrat_Gen, Packrat_Proc, 
External);
+   subtype Valid_Generate_Algorithm is Generate_Algorithm range LALR .. 
Generate_Algorithm'Last;
+   subtype LR_Generate_Algorithm is Generate_Algorithm range LALR .. LR1;
+   subtype Packrat_Generate_Algorithm is Generate_Algorithm range Packrat_Gen 
.. Packrat_Proc;
+
+   Generate_Algorithm_Image : constant array (Valid_Generate_Algorithm) of 
access constant String :=
+     (LALR         => new String'("LALR"),
+      LR1          => new String'("LR1"),
+      Packrat_Gen  => new String'("Packrat_Gen"),
+      Packrat_Proc => new String'("Packrat_Proc"),
+      External     => new String'("External"));
+   --  Suitable for Ada package names.
+
+   type Generate_Algorithm_Set is array (Generate_Algorithm) of Boolean;
+   type Generate_Algorithm_Set_Access is access Generate_Algorithm_Set;
+
+   type Output_Language is (Ada_Lang, Ada_Emacs_Lang, Elisp_Lang);
+   subtype Ada_Output_Language is Output_Language range Ada_Lang .. 
Ada_Emacs_Lang;
+   --  _Lang to avoid colliding with the standard package Ada and
+   --  WisiToken packages named *.Ada. In the grammar file, they
+   --  are named by (case insensitive):
+   Output_Language_Image : constant array (Output_Language) of access constant 
String :=
+     (Ada_Lang       => new String'("Ada"),
+      Ada_Emacs_Lang => new String'("Ada_Emacs"),
+      Elisp_Lang     => new String'("elisp"));
+
+   function To_Output_Language (Item : in String) return Output_Language;
+   --  Raises User_Error for invalid Item
+
+   type Lexer_Type is (None, Elisp_Lexer, re2c_Lexer);
+   subtype Valid_Lexer is Lexer_Type range Elisp_Lexer .. Lexer_Type'Last;
+   --  We append "_Lexer" to these names to avoid colliding with the
+   --  similarly-named WisiToken packages. In the grammar file, they
+   --  are named by:
+   Lexer_Image : constant array (Lexer_Type) of access constant String :=
+     (None        => new String'("none"),
+      Elisp_Lexer => new String'("elisp"),
+      re2c_Lexer  => new String'("re2c"));
+
+   function To_Lexer (Item : in String) return Lexer_Type;
+   --  Raises User_Error for invalid Item
+
+   type Lexer_Set is array (Lexer_Type) of Boolean;
+
+   type Lexer_Generate_Algorithm_Set is array (Lexer_Type) of 
Generate_Algorithm_Set;
+   --  %if lexer change change the generated parse table
+
+   type Interface_Type is (None, Process, Module);
+   subtype Valid_Interface is Interface_Type range Process .. Module;
+
+   type Generate_Tuple is record
+      Gen_Alg        : Valid_Generate_Algorithm;
+      Out_Lang       : Output_Language;
+      Lexer          : Lexer_Type     := None;
+      Interface_Kind : Interface_Type := None;
+      Text_Rep       : Boolean        := False;
+   end record;
+
+   type Generate_Set is array (Natural range <>) of Generate_Tuple;
+   type Generate_Set_Access is access Generate_Set;
+   procedure Free is new Ada.Unchecked_Deallocation (Generate_Set, 
Generate_Set_Access);
+
+   procedure Add
+     (Set   : in out Generate_Set_Access;
+      Tuple : in     Generate_Tuple);
+
+   package String_Lists is new Ada.Containers.Indefinite_Doubly_Linked_Lists 
(String);
+
+   type Language_Param_Type is record
+      --  Set by grammar file declarations or command line options. Error
+      --  recover parameters are in McKenzie_Recover_Param_Type below.
+      Case_Insensitive              : Boolean := False;
+      Embedded_Quote_Escape_Doubled : Boolean := False;
+      End_Names_Optional_Option     : Ada.Strings.Unbounded.Unbounded_String;
+      Language_Runtime              : Boolean := True;
+      Declare_Enums                 : Boolean := True;
+      Error_Recover                 : Boolean := False;
+      Start_Token                   : Ada.Strings.Unbounded.Unbounded_String;
+   end record;
+
+   type Raw_Code_Location is
+     (Copyright_License,
+      Actions_Spec_Context, Actions_Spec_Pre, Actions_Spec_Post,
+      Actions_Body_Context, Actions_Body_Pre, Actions_Body_Post);
+   --  So far we have not needed raw code other than license in the main
+   --  package.
+
+   type Raw_Code is array (Raw_Code_Location) of String_Lists.List;
+
+   subtype String_2 is String (1 .. 2);
+
+   Ada_Comment   : constant String_2 := "--";
+   C_Comment     : constant String_2 := "//";
+   Elisp_Comment : constant String_2 := ";;";
+
+   function Split_Lines (Item : in String) return String_Lists.List;
+
+   function Trim (Item : in String_Lists.List; Comment_Start : in String) 
return String_Lists.List;
+   --  From each element, delete trailing comments starting with
+   --  Comment_Start; delete leading and trailing spaces.
+
+   procedure Put_Raw_Code
+     (Comment_Syntax : in String_2;
+      Code           : in String_Lists.List;
+      Comment_Only   : in Boolean := False);
+   --  Output Code to Ada.Text_IO.Current_Output.
+   --
+   --  If first two characters of a line are the same and not ' ', it is
+   --  assumed to be a comment; ensure the output line has
+   --  Comment_Syntax.
+   --
+   --  If Comment_Only is True, or if the comment syntax used in Code
+   --  does not equal Comment_Syntax, only output comment lines.
+   --
+   --  If Comment_Syntax is Elisp_Comment, only output lines that are
+   --  valid elisp comments or forms (ie start with ';;' or '(').
+   --
+   --  Otherwise output all lines.
+
+   procedure Put_File_Header
+     (Comment_Syntax : in String_2;
+      Emacs_Mode     : in String         := "";
+      Use_Tuple      : in Boolean        := False;
+      Tuple          : in Generate_Tuple := (others => <>));
+   --  Output "parser support file <emacs_mode> /n command line: " comment to 
Ada.Text_IO.Current_Output.
+
+   type String_Pair_Type is record
+      Name  : aliased Ada.Strings.Unbounded.Unbounded_String;
+      Value : Ada.Strings.Unbounded.Unbounded_String;
+   end record;
+
+   package String_Pair_Lists is new Ada.Containers.Doubly_Linked_Lists 
(String_Pair_Type);
+
+   function Is_Present (List : in String_Pair_Lists.List; Name : in String) 
return Boolean;
+   function Value (List : in String_Pair_Lists.List; Name : in String) return 
String;
+
+   type McKenzie_Recover_Param_Type is record
+      Source_Line : WisiToken.Line_Number_Type := 
WisiToken.Invalid_Line_Number;
+      --  Of the %mckenzie_cost_default declaration; we assume the others
+      --  are near.
+
+      Default_Insert          : Natural               := 0;
+      Default_Delete_Terminal : Natural               := 0;
+      Default_Push_Back       : Natural               := 0;
+      Delete                  : String_Pair_Lists.List;
+      Insert                  : String_Pair_Lists.List;
+      Push_Back               : String_Pair_Lists.List;
+      Ignore_Check_Fail       : Natural               := 0;
+      Cost_Limit              : Natural               := Integer'Last;
+      Check_Limit             : WisiToken.Token_Index := 
WisiToken.Token_Index'Last;
+      Check_Delta_Limit       : Natural               := Integer'Last;
+      Enqueue_Limit           : Natural               := Integer'Last;
+   end record;
+
+   type Token_Kind_Type is record
+      Kind   : Ada.Strings.Unbounded.Unbounded_String;
+      Tokens : String_Pair_Lists.List;
+   end record;
+
+   package Token_Lists is new Ada.Containers.Doubly_Linked_Lists 
(Token_Kind_Type);
+
+   function Count (Tokens : in Token_Lists.List) return Integer;
+   --  Count of all leaves.
+
+   procedure Add_Token
+     (Tokens : in out Token_Lists.List;
+      Kind   : in     String;
+      Name   : in     String;
+      Value  : in     String);
+   --  Add Name, Value to Kind list in Tokens.
+
+   function Is_In (Tokens : in Token_Lists.List; Kind : in String) return 
Boolean;
+   function Is_In
+     (Tokens : in Token_Lists.List;
+      Kind   : in String;
+      Value  : in String)
+     return Boolean;
+
+   type Conflict is record
+      Source_Line : WisiToken.Line_Number_Type;
+      Action_A    : Ada.Strings.Unbounded.Unbounded_String;
+      LHS_A       : Ada.Strings.Unbounded.Unbounded_String;
+      Action_B    : Ada.Strings.Unbounded.Unbounded_String;
+      LHS_B       : Ada.Strings.Unbounded.Unbounded_String;
+      On          : Ada.Strings.Unbounded.Unbounded_String;
+   end record;
+
+   package Conflict_Lists is new Ada.Containers.Doubly_Linked_Lists (Conflict);
+
+   type RHS_Type is record
+      Tokens      : String_Lists.List;
+      Action      : Ada.Strings.Unbounded.Unbounded_String;
+      Check       : Ada.Strings.Unbounded.Unbounded_String;
+      Source_Line : WisiToken.Line_Number_Type := 
WisiToken.Invalid_Line_Number;
+   end record;
+   package RHS_Lists is new Ada.Containers.Doubly_Linked_Lists (RHS_Type, "=");
+
+   type Rule_Type is record
+      Left_Hand_Side   : aliased Ada.Strings.Unbounded.Unbounded_String;
+      Right_Hand_Sides : RHS_Lists.List;
+      Source_Line      : WisiToken.Line_Number_Type;
+   end record;
+
+   package Rule_Lists is new Ada.Containers.Doubly_Linked_Lists (Rule_Type);
+
+   function Is_Present (Rules : in Rule_Lists.List; LHS : in String) return 
Boolean;
+
+   type Tokens is record
+      Non_Grammar      : Token_Lists.List;
+      Keywords         : String_Pair_Lists.List;
+      Tokens           : Token_Lists.List;
+      Rules            : Rule_Lists.List;
+      --  Rules included here because they define the nonterminal tokens, as
+      --  well as the productions.
+
+      Regexps : String_Pair_Lists.List;
+      --  Regexps included here because they are used in defining the
+      --  Tokens.
+   end record;
+
+   type User_Names is record
+      --  Specified in grammar file declarations, used in other declarations
+      --  or actions. Faces, Indents only used if .wy action language is
+      --  elisp and output language is not elisp.
+
+      Faces   : String_Lists.List;      -- %elisp_face
+      Indents : String_Pair_Lists.List; -- %elisp_indent
+      Regexps : String_Pair_Lists.List; -- %regexp_name
+   end record;
+
+   function "+" (Item : in String) return 
Ada.Strings.Unbounded.Unbounded_String
+     renames Ada.Strings.Unbounded.To_Unbounded_String;
+
+   function "-" (Item : in Ada.Strings.Unbounded.Unbounded_String) return 
String
+     renames Ada.Strings.Unbounded.To_String;
+
+   function To_Lower (Item : in String) return String
+     renames Ada.Characters.Handling.To_Lower;
+
+   function To_Upper (Item : in String) return String
+     renames Ada.Characters.Handling.To_Upper;
+
+   function To_Upper (Item : in Character) return Character
+     renames Ada.Characters.Handling.To_Upper;
+
+   function "+" (List : in String_Lists.List; Item : in String) return 
String_Lists.List;
+
+   function String_To_String_List (Item : in String) return String_Lists.List;
+   function "+" (Item : in String) return String_Lists.List renames 
String_To_String_List;
+
+   function RHS_To_RHS_List (Item : in RHS_Type) return RHS_Lists.List;
+   function "+" (Item : in RHS_Type) return RHS_Lists.List renames 
RHS_To_RHS_List;
+
+   function "+" (List : in RHS_Lists.List; Item : in RHS_Type) return 
RHS_Lists.List;
+
+   function Image (Item : in Boolean) return String
+     is (if Item then "True" else "False");
+   --  Match casing in Standard.
+
+   procedure Put_Command_Line
+     (Comment_Prefix : in String;
+      Use_Tuple      : in Boolean        := False;
+      Tuple          : in Generate_Tuple := (others => <>));
+   --  Put command line to current output; indicate current tuple.
+
+end WisiToken.BNF;
diff --git a/wisitoken-gen_token_enum.adb b/wisitoken-gen_token_enum.adb
new file mode 100644
index 0000000..87e5f6d
--- /dev/null
+++ b/wisitoken-gen_token_enum.adb
@@ -0,0 +1,133 @@
+--  Abstract :
+--
+--  See spec
+--
+--  Copyright (C) 2017, 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (GPL);
+
+with Ada.Characters.Handling;
+with WisiToken.Wisi_Ada;
+package body WisiToken.Gen_Token_Enum is
+
+   function Token_Enum_Image return Token_ID_Array_String
+   is
+      use Ada.Characters.Handling;
+      Result : Token_ID_Array_String (Token_ID'First .. +Last_Nonterminal);
+   begin
+      for I in Token_Enum_ID loop
+         if I <= Last_Terminal then
+            Result (+I) := new String'(Token_Enum_ID'Image (I));
+         else
+            Result (+I) := new String'(To_Lower (Token_Enum_ID'Image (I)));
+         end if;
+      end loop;
+      return Result;
+   end Token_Enum_Image;
+
+   function To_Syntax (Item : in Enum_Syntax) return 
WisiToken.Lexer.Regexp.Syntax
+   is
+      Result : WisiToken.Lexer.Regexp.Syntax (Token_ID'First .. 
+Last_Terminal);
+   begin
+      for I in Result'Range loop
+         Result (I) := Item (-I);
+      end loop;
+      return Result;
+   end To_Syntax;
+
+   function "&" (Left, Right : in Token_Enum_ID) return Token_ID_Arrays.Vector
+   is begin
+      return Result : Token_ID_Arrays.Vector do
+         Result.Append (+Left);
+         Result.Append (+Right);
+      end return;
+   end "&";
+
+   function "&"
+     (Left  : in Token_ID_Arrays.Vector;
+      Right : in Token_Enum_ID)
+     return Token_ID_Arrays.Vector
+   is begin
+      return Result : Token_ID_Arrays.Vector := Left do
+         Result.Append (+Right);
+      end return;
+   end "&";
+
+   function "+"
+     (Left  : in Token_Enum_ID;
+      Right : in WisiToken.Syntax_Trees.Semantic_Action)
+     return WisiToken.Productions.Right_Hand_Side
+   is begin
+      return WisiToken.Wisi_Ada."+" (+Left, Right);
+   end "+";
+
+   function "<="
+     (Left  : in Token_Enum_ID;
+      Right : in WisiToken.Productions.Right_Hand_Side)
+     return WisiToken.Productions.Instance
+   is begin
+      return WisiToken.Wisi_Ada."<=" (+Left, Productions.RHS_Arrays.To_Vector 
(Right, 1));
+   end "<=";
+
+   function To_Nonterminal_Array_Token_Set
+     (Item : in Nonterminal_Array_Token_Set)
+     return WisiToken.Token_Array_Token_Set
+   is
+      Result : Token_Array_Token_Set :=
+        (LR1_Descriptor.First_Nonterminal .. LR1_Descriptor.Last_Nonterminal =>
+           (LR1_Descriptor.First_Terminal .. LR1_Descriptor.Last_Nonterminal 
=> False));
+   begin
+      for I in Item'Range (1) loop
+         for J in Item'Range (2) loop
+            Result (+I, +J) := Item (I, J);
+         end loop;
+      end loop;
+      return Result;
+   end To_Nonterminal_Array_Token_Set;
+
+   function To_Nonterminal_Array_Terminal_Set
+     (Item : in Nonterminal_Array_Terminal_Set)
+     return WisiToken.Token_Array_Token_Set
+   is
+      Result : Token_Array_Token_Set :=
+        (LR1_Descriptor.First_Nonterminal .. LR1_Descriptor.Last_Nonterminal =>
+           (LR1_Descriptor.First_Terminal .. LR1_Descriptor.Last_Terminal => 
False));
+   begin
+      for I in Item'Range (1) loop
+         for J in Item'Range (2) loop
+            Result (+I, +J) := Item (I, J);
+         end loop;
+      end loop;
+      return Result;
+   end To_Nonterminal_Array_Terminal_Set;
+
+   function "+" (Item : in Token_Array) return WisiToken.Token_ID_Set
+   is
+      Result : Token_ID_Set := (LR1_Descriptor.First_Terminal .. 
LR1_Descriptor.Last_Terminal => False);
+   begin
+      for I in Item'Range loop
+         Result (+Item (I)) := True;
+      end loop;
+      return Result;
+   end "+";
+
+   function "+" (Item : in Token_Enum_ID) return WisiToken.Token_ID_Set
+   is begin
+      return +Token_Array'(1 => Item);
+   end "+";
+
+begin
+   LR1_Descriptor.Image := Token_Enum_Image;
+   LALR_Descriptor.Image := LR1_Descriptor.Image;
+end WisiToken.Gen_Token_Enum;
diff --git a/wisitoken-gen_token_enum.ads b/wisitoken-gen_token_enum.ads
new file mode 100644
index 0000000..b14be0d
--- /dev/null
+++ b/wisitoken-gen_token_enum.ads
@@ -0,0 +1,130 @@
+--  Abstract :
+--
+--  Support for an enumerated token type
+--
+--  Copyright (C) 2017, 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (GPL);
+
+with WisiToken.Lexer.Regexp;
+with WisiToken.Productions;
+with WisiToken.Syntax_Trees;
+generic
+   type Token_Enum_ID is (<>);
+   First_Terminal    : Token_Enum_ID;
+   Last_Terminal     : Token_Enum_ID;
+   First_Nonterminal : Token_Enum_ID;
+   Last_Nonterminal  : Token_Enum_ID;
+   EOF_ID            : Token_Enum_ID;
+   Accept_ID         : Token_Enum_ID;
+   Case_Insensitive  : Boolean;
+package WisiToken.Gen_Token_Enum is
+
+   function "+" (Item : in Token_Enum_ID) return Token_ID
+     is (Token_ID'First + Token_Enum_ID'Pos (Item));
+
+   function "-" (Item : in Token_ID) return Token_Enum_ID
+     is (Token_Enum_ID'Val (Item - Token_ID'First));
+
+   function Token_Enum_Image return Token_ID_Array_String;
+
+   subtype Terminal_Enum_ID is Token_Enum_ID range First_Terminal .. 
Last_Terminal;
+   subtype Nonterminal_Enum_ID is Token_Enum_ID range First_Nonterminal .. 
Last_Nonterminal;
+
+   LR1_Descriptor : aliased WisiToken.Descriptor :=
+     (First_Terminal                => +First_Terminal,
+      Last_Terminal                 => +Last_Terminal,
+      First_Nonterminal             => +First_Nonterminal,
+      Last_Nonterminal              => +Last_Nonterminal,
+      EOF_ID                        => +EOF_ID,
+      Accept_ID                     => +Accept_ID,
+      Case_Insensitive              => Case_Insensitive,
+      New_Line_ID                   => Invalid_Token_ID,
+      Comment_ID                    => Invalid_Token_ID,
+      Left_Paren_ID                 => Invalid_Token_ID,
+      Right_Paren_ID                => Invalid_Token_ID,
+      String_1_ID                   => Invalid_Token_ID,
+      String_2_ID                   => Invalid_Token_ID,
+      Embedded_Quote_Escape_Doubled => False,
+      Image                         => (others => null), --  set in body 
elaboration time code
+      Terminal_Image_Width          => Terminal_Enum_ID'Width,
+      Image_Width                   => Token_Enum_ID'Width,
+      Last_Lookahead                => +Last_Terminal);
+
+   LALR_Descriptor : aliased WisiToken.Descriptor :=
+     (First_Terminal                => +First_Terminal,
+      Last_Terminal                 => +Last_Terminal,
+      First_Nonterminal             => +First_Nonterminal,
+      Last_Nonterminal              => +Last_Nonterminal,
+      EOF_ID                        => +EOF_ID,
+      Accept_ID                     => +Accept_ID,
+      Case_Insensitive              => Case_Insensitive,
+      New_Line_ID                   => Invalid_Token_ID,
+      Comment_ID                    => Invalid_Token_ID,
+      Left_Paren_ID                 => Invalid_Token_ID,
+      Right_Paren_ID                => Invalid_Token_ID,
+      String_1_ID                   => Invalid_Token_ID,
+      String_2_ID                   => Invalid_Token_ID,
+      Embedded_Quote_Escape_Doubled => False,
+      Image                         => (others => null),
+      Terminal_Image_Width          => Terminal_Enum_ID'Width,
+      Image_Width                   => Token_Enum_ID'Width,
+      Last_Lookahead                => +First_Nonterminal);
+
+   type Enum_Syntax is array (Token_Enum_ID range Token_Enum_ID'First .. 
Last_Terminal) of
+     WisiToken.Lexer.Regexp.Syntax_Item;
+
+   function To_Syntax (Item : in Enum_Syntax) return 
WisiToken.Lexer.Regexp.Syntax;
+
+   function "&" (Left, Right : in Token_Enum_ID) return Token_ID_Arrays.Vector;
+
+   function "&"
+     (Left  : in Token_ID_Arrays.Vector;
+      Right : in Token_Enum_ID)
+     return Token_ID_Arrays.Vector;
+
+   function "+" (Left : in Token_Enum_ID; Right : in 
Syntax_Trees.Semantic_Action) return Productions.Right_Hand_Side;
+
+   function "<="
+     (Left  : in Token_Enum_ID;
+      Right : in WisiToken.Productions.Right_Hand_Side)
+     return WisiToken.Productions.Instance;
+
+   ----------
+   --  For unit tests
+
+   subtype Terminal_ID is Token_Enum_ID range First_Terminal .. Last_Terminal;
+   subtype Nonterminal_ID is Token_Enum_ID range First_Nonterminal .. 
Last_Nonterminal;
+   subtype Grammar_ID is Token_Enum_ID range First_Terminal .. 
Last_Nonterminal;
+
+   type Nonterminal_Array_Token_Set is array (Nonterminal_ID, Grammar_ID) of 
Boolean;
+
+   function To_Nonterminal_Array_Token_Set
+     (Item : in Nonterminal_Array_Token_Set)
+     return WisiToken.Token_Array_Token_Set;
+
+   type Nonterminal_Array_Terminal_Set is array (Nonterminal_ID, Terminal_ID) 
of Boolean;
+
+   function To_Nonterminal_Array_Terminal_Set
+     (Item : in Nonterminal_Array_Terminal_Set)
+     return WisiToken.Token_Array_Token_Set;
+
+   type Nonterminal_ID_Set is array (Nonterminal_ID) of Boolean;
+
+   type Token_Array is array (Positive range <>) of Token_Enum_ID;
+
+   function "+" (Item : in Token_Array) return WisiToken.Token_ID_Set;
+   function "+" (Item : in Token_Enum_ID) return WisiToken.Token_ID_Set;
+
+end WisiToken.Gen_Token_Enum;
diff --git a/wisitoken-generate-lr-lalr_generate.adb 
b/wisitoken-generate-lr-lalr_generate.adb
new file mode 100644
index 0000000..d886077
--- /dev/null
+++ b/wisitoken-generate-lr-lalr_generate.adb
@@ -0,0 +1,593 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2002 - 2005, 2008 - 2015, 2017, 2018 Stephe Leake
+--  Copyright (C) 1999 Ted Dennison
+--
+--  This file is part of the WisiToken package.
+--
+--  The WisiToken package is free software; you can redistribute it
+--  and/or modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or
+--  (at your option) any later version. This library is distributed in
+--  the hope that it will be useful, but WITHOUT ANY WARRANTY; without
+--  even the implied warranty of MERCHAN- TABILITY or FITNESS FOR A
+--  PARTICULAR PURPOSE.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Containers;
+with Ada.Text_IO;
+with SAL.Gen_Definite_Doubly_Linked_Lists;
+package body WisiToken.Generate.LR.LALR_Generate is
+
+   package Item_List_Cursor_Lists is new SAL.Gen_Definite_Doubly_Linked_Lists 
(LR1_Items.Item_Lists.Cursor);
+
+   type Item_Map is record
+      --  Keep track of all copies of Item, so Lookaheads can be updated
+      --  after they are initially copied.
+      From : LR1_Items.Item_Lists.Cursor;
+      To   : Item_List_Cursor_Lists.List;
+   end record;
+
+   package Item_Map_Lists is new SAL.Gen_Definite_Doubly_Linked_Lists 
(Item_Map);
+   --  IMPROVEME: should be a 3D array indexed by Prod, rhs_index,
+   --  dot_index. But it's not broken or slow, so we're not fixing it.
+
+   function Propagate_Lookahead (Descriptor : in WisiToken.Descriptor) return 
access LR1_Items.Lookahead
+   is begin
+      return new Token_ID_Set'(LR1_Items.To_Lookahead 
(Descriptor.Last_Lookahead, Descriptor));
+   end Propagate_Lookahead;
+
+   function Null_Lookahead (Descriptor : in WisiToken.Descriptor) return 
access LR1_Items.Lookahead
+   is begin
+      return new Token_ID_Set'(Descriptor.First_Terminal .. 
Descriptor.Last_Lookahead => False);
+   end Null_Lookahead;
+
+   ----------
+   --  Debug output
+
+   procedure Put
+     (Grammar      : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor   : in WisiToken.Descriptor;
+      Propagations : in Item_Map_Lists.List)
+   is
+      use LR1_Items.Item_Lists;
+   begin
+      for Map of Propagations loop
+         Ada.Text_IO.Put ("From ");
+         LR1_Items.Put (Grammar, Descriptor, Constant_Ref (Map.From), 
Show_Lookaheads => True);
+         Ada.Text_IO.New_Line;
+
+         for Cur of Map.To loop
+            Ada.Text_IO.Put ("To   ");
+            LR1_Items.Put (Grammar, Descriptor, Constant_Ref (Cur), 
Show_Lookaheads => True);
+            Ada.Text_IO.New_Line;
+         end loop;
+      end loop;
+   end Put;
+
+   ----------
+   --  Generate utils
+
+   function LALR_Goto_Transitions
+     (Kernel            : in LR1_Items.Item_Set;
+      Symbol            : in Token_ID;
+      First_Nonterm_Set : in Token_Array_Token_Set;
+      Grammar           : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor        : in WisiToken.Descriptor)
+     return LR1_Items.Item_Set
+   is
+      use Token_ID_Arrays;
+      use LR1_Items;
+      use LR1_Items.Item_Lists;
+
+      Goto_Set : Item_Set;
+      Dot_ID   : Token_ID;
+   begin
+      for Item of Kernel.Set loop
+
+         if Has_Element (Item.Dot) then
+
+            Dot_ID := Element (Item.Dot);
+            --  ID of token after Dot
+
+            --  If Symbol = EOF_Token, this is the start symbol accept
+            --  production; don't need a kernel with dot after EOF.
+            if (Dot_ID = Symbol and Symbol /= Descriptor.EOF_ID) and then
+              not Has_Element (Find (Item.Prod, Next (Item.Dot), Goto_Set))
+            then
+               Goto_Set.Set.Insert
+                 ((Prod       => Item.Prod,
+                   Dot        => Next (Item.Dot),
+                   Lookaheads => new Token_ID_Set'(Item.Lookaheads.all)));
+
+               if Trace_Generate > Detail then
+                  Ada.Text_IO.Put_Line ("LALR_Goto_Transitions 1 " & Image 
(Symbol, Descriptor));
+                  Put (Grammar, Descriptor, Goto_Set);
+               end if;
+            end if;
+
+            if Dot_ID in Descriptor.First_Nonterminal .. 
Descriptor.Last_Nonterminal and then
+              First_Nonterm_Set (Dot_ID, Symbol)
+            then
+               --  Find the production(s) that create Dot_ID with first token 
Symbol
+               --  and put them in.
+               --
+               --  This is equivalent to Filter (LR1_Items.Closure, 
In_Kernel), but
+               --  more efficient, because it does not generate non-kernel 
items. See
+               --  Test/compare_goto_transitions.adb.
+               for Prod of Grammar loop
+                  for RHS_2_I in Prod.RHSs.First_Index .. Prod.RHSs.Last_Index 
loop
+                     declare
+                        P_ID  : constant Production_ID          := (Prod.LHS, 
RHS_2_I);
+                        Dot_2 : constant Token_ID_Arrays.Cursor := Prod.RHSs 
(RHS_2_I).Tokens.First;
+                     begin
+                        if (Dot_ID = Prod.LHS or First_Nonterm_Set (Dot_ID, 
Prod.LHS)) and
+                          (Has_Element (Dot_2) and then Element (Dot_2) = 
Symbol)
+                        then
+                           if not Has_Element (Find (P_ID, Next (Dot_2), 
Goto_Set)) then
+                              Goto_Set.Set.Insert
+                                ((Prod       => P_ID,
+                                  Dot        => Next (Dot_2),
+                                  Lookaheads => Null_Lookahead (Descriptor)));
+
+                              if Trace_Generate > Detail then
+                                 Ada.Text_IO.Put_Line ("LALR_Goto_Transitions 
2 " & Image (Symbol, Descriptor));
+                                 Put (Grammar, Descriptor, Goto_Set);
+                              end if;
+
+                              --  else already in goto set
+                           end if;
+                        end if;
+                     end;
+                  end loop;
+               end loop;
+            end if;
+         end if; -- item.dot /= null
+      end loop;
+
+      return Goto_Set;
+   end LALR_Goto_Transitions;
+
+   function LALR_Kernels
+     (Grammar           : in WisiToken.Productions.Prod_Arrays.Vector;
+      First_Nonterm_Set : in Token_Array_Token_Set;
+      Descriptor        : in WisiToken.Descriptor)
+     return LR1_Items.Item_Set_List
+   is
+      use all type Token_ID_Arrays.Cursor;
+      use all type Ada.Containers.Count_Type;
+      use LR1_Items;
+
+      First_State_Index : constant State_Index := 0;
+      Kernels           : LR1_Items.Item_Set_List;
+      Kernel_Tree       : LR1_Items.Item_Set_Trees.Tree; -- for fast find
+      States_To_Check   : State_Index_Queues.Queue;
+      Checking_State    : State_Index;
+
+      New_Item_Set : Item_Set :=
+        (Set            => Item_Lists.To_List
+           ((Prod       => (Grammar.First_Index, 0),
+             Dot        => Grammar (Grammar.First_Index).RHSs (0).Tokens.First,
+             Lookaheads => Null_Lookahead (Descriptor))),
+         Goto_List      => <>,
+         Dot_IDs        => <>,
+         State          => First_State_Index);
+
+      Found_State : Unknown_State_Index;
+   begin
+      Kernels.Set_First (First_State_Index);
+
+      Add (New_Item_Set, Kernels, Kernel_Tree, Descriptor, Include_Lookaheads 
=> False);
+
+      States_To_Check.Put (First_State_Index);
+      loop
+         exit when States_To_Check.Is_Empty;
+         Checking_State := States_To_Check.Get;
+
+         if Trace_Generate > Detail then
+            Ada.Text_IO.Put ("Checking ");
+            Put (Grammar, Descriptor, Kernels (Checking_State));
+         end if;
+
+         for Symbol in Descriptor.First_Terminal .. 
Descriptor.Last_Nonterminal loop
+            --  LALR_Goto_Transitions does _not_ ignore Symbol if it is not in
+            --  Item_Set.Dot_IDs, so we can't iterate on that here as we do in
+            --  LR1_Generate.
+
+            New_Item_Set := LALR_Goto_Transitions
+              (Kernels (Checking_State), Symbol, First_Nonterm_Set, Grammar, 
Descriptor);
+
+            if New_Item_Set.Set.Length > 0 then
+
+               Found_State := Find (New_Item_Set, Kernel_Tree, 
Match_Lookaheads => False);
+
+               if Found_State = Unknown_State then
+                  New_Item_Set.State := Kernels.Last_Index + 1;
+
+                  States_To_Check.Put (New_Item_Set.State);
+
+                  Add (New_Item_Set, Kernels, Kernel_Tree, Descriptor, 
Include_Lookaheads => False);
+
+                  if Trace_Generate > Detail then
+                     Ada.Text_IO.Put_Line ("  adding state" & 
Unknown_State_Index'Image (Kernels.Last_Index));
+                  end if;
+
+                  Kernels (Checking_State).Goto_List.Insert ((Symbol, 
Kernels.Last_Index));
+               else
+
+                  --  If there's not already a goto entry between these two 
sets, create one.
+                  if not Is_In ((Symbol, Found_State), Kernels 
(Checking_State).Goto_List) then
+                     if Trace_Generate > Detail then
+                        Ada.Text_IO.Put_Line
+                          ("  state" & Unknown_State_Index'Image 
(Checking_State) &
+                             " adding goto on " & Image (Symbol, Descriptor) & 
" to state" &
+                             Unknown_State_Index'Image (Found_State));
+
+                     end if;
+
+                     Kernels (Checking_State).Goto_List.Insert ((Symbol, 
Found_State));
+                  end if;
+               end if;
+            end if;
+         end loop;
+      end loop;
+
+      if Trace_Generate > Detail then
+         Ada.Text_IO.New_Line;
+      end if;
+
+      return Kernels;
+   end LALR_Kernels;
+
+   --  Add a propagation entry (if it doesn't already exist) from From in
+   --  From_Set to To_Item.
+   procedure Add_Propagation
+     (From         : in     LR1_Items.Item;
+      From_Set     : in     LR1_Items.Item_Set;
+      To_Item      : in     LR1_Items.Item_Lists.Cursor;
+      Propagations : in out Item_Map_Lists.List)
+   is
+      use Item_Map_Lists;
+      use Item_List_Cursor_Lists;
+      use LR1_Items;
+      use LR1_Items.Item_Lists;
+
+      From_Cur : constant Item_Lists.Cursor := Find (From, From_Set);
+
+      From_Match : Item_Map_Lists.Cursor := Propagations.First;
+      To_Match   : Item_List_Cursor_Lists.Cursor;
+   begin
+      Find_From :
+      loop
+         exit Find_From when not Has_Element (From_Match);
+
+         declare
+            Map : Item_Map renames Constant_Ref (From_Match);
+         begin
+            if From_Cur = Map.From then
+
+               To_Match := Map.To.First;
+               loop
+                  exit when not Has_Element (To_Match);
+
+                  declare
+                     use all type SAL.Compare_Result;
+                     Cur       : Item_Lists.Cursor renames Constant_Ref 
(To_Match);
+                     Test_Item : LR1_Items.Item renames Constant_Ref (Cur);
+                  begin
+                     if Equal = LR1_Items.Item_Compare (Test_Item, 
Constant_Ref (To_Item)) then
+                        exit Find_From;
+                     end if;
+                  end;
+                  Next (To_Match);
+               end loop;
+               exit Find_From;
+            end if;
+         end;
+
+         Next (From_Match);
+      end loop Find_From;
+
+      if not Has_Element (From_Match) then
+         Propagations.Append ((From_Cur, To_List (To_Item)));
+
+      elsif not Has_Element (To_Match) then
+         Ref (From_Match).To.Append (To_Item);
+
+      else
+         raise SAL.Programmer_Error with "Add_Propagation: unexpected case";
+      end if;
+   end Add_Propagation;
+
+   --  Calculate the lookaheads from Closure_Item for Source_Item.
+   --  Source_Item must be one of the kernel items in Source_Set.
+   --  Closure_Item must be an item in the lookahead closure of Source_Item 
for #.
+   --
+   --  Spontaneous lookaheads are put in Source_Item.Lookahead,
+   --  propagated lookaheads in Propagations.
+   --
+   --  Set Used_Tokens = True for all tokens in lookaheads.
+   procedure Generate_Lookahead_Info
+     (Source_Item  : in     LR1_Items.Item;
+      Source_Set   : in     LR1_Items.Item_Set;
+      Closure_Item : in     LR1_Items.Item;
+      Propagations : in out Item_Map_Lists.List;
+      Descriptor   : in     WisiToken.Descriptor;
+      Grammar      : in     WisiToken.Productions.Prod_Arrays.Vector;
+      Kernels      : in out LR1_Items.Item_Set_List)
+   is
+      use LR1_Items;
+      use LR1_Items.Item_Lists;
+      use Token_ID_Arrays;
+
+      Spontaneous_Count : Integer := 0;
+   begin
+      if Trace_Generate > Outline then
+         Ada.Text_IO.Put_Line ("  closure_item: ");
+         LR1_Items.Put (Grammar, Descriptor, Closure_Item);
+         Ada.Text_IO.New_Line;
+      end if;
+
+      if not Has_Element (Closure_Item.Dot) then
+         return;
+      end if;
+
+      declare
+         ID         : constant Token_ID               := Element 
(Closure_Item.Dot);
+         Next_Dot   : constant Token_ID_Arrays.Cursor := Next 
(Closure_Item.Dot);
+         Goto_State : constant Unknown_State_Index    := LR1_Items.Goto_State 
(Source_Set, ID);
+         To_Item    : constant Item_Lists.Cursor      :=
+           (if Goto_State = Unknown_State then Item_Lists.No_Element
+            else LR1_Items.Find (Closure_Item.Prod, Next_Dot, Kernels 
(Goto_State)));
+      begin
+         if Closure_Item.Lookaheads (Descriptor.Last_Lookahead) and 
Has_Element (To_Item) then
+            Add_Propagation
+              (From         => Source_Item,
+               From_Set     => Source_Set,
+               To_Item      => To_Item,
+               Propagations => Propagations);
+         end if;
+
+         if Has_Element (To_Item) then
+            if Trace_Generate > Outline then
+               Spontaneous_Count := Spontaneous_Count + 1;
+               Ada.Text_IO.Put_Line ("  spontaneous: " & Lookahead_Image 
(Closure_Item.Lookaheads.all, Descriptor));
+            end if;
+
+            LR1_Items.Include (Ref (To_Item), Closure_Item.Lookaheads.all, 
Descriptor);
+         end if;
+      end;
+   end Generate_Lookahead_Info;
+
+   procedure Propagate_Lookaheads
+     (List       : in Item_Map_Lists.List;
+      Descriptor : in WisiToken.Descriptor)
+   is
+      --  In List, update all To lookaheads from From lookaheads,
+      --  recursively.
+
+      use LR1_Items.Item_Lists;
+
+      More_To_Check : Boolean := True;
+      Added_One     : Boolean;
+   begin
+      while More_To_Check loop
+
+         More_To_Check := False;
+         for Mapping of List loop
+            for Copy of Mapping.To loop
+               LR1_Items.Include (Ref (Copy), Constant_Ref 
(Mapping.From).Lookaheads.all, Added_One, Descriptor);
+
+               More_To_Check := More_To_Check or Added_One;
+            end loop;
+         end loop;
+      end loop;
+   end Propagate_Lookaheads;
+
+   --  Calculate the LALR(1) lookaheads for Grammar.
+   --  Kernels should be the sets of LR(0) kernels on input, and will
+   --  become the set of LALR(1) kernels on output.
+   procedure Fill_In_Lookaheads
+     (Grammar                 : in     
WisiToken.Productions.Prod_Arrays.Vector;
+      Has_Empty_Production    : in     Token_ID_Set;
+      First_Terminal_Sequence : in     Token_Sequence_Arrays.Vector;
+      Kernels                 : in out LR1_Items.Item_Set_List;
+      Descriptor              : in     WisiToken.Descriptor)
+   is
+      pragma Warnings (Off, """Kernel_Item_Set"" is not modified, could be 
declared constant");
+      --  WORKAROUND: GNAT GPL 2018 complains Kernel_Item_Set could be a 
constant, but
+      --  when we declare that, it complains the target of the assignment of
+      --  .Prod, .Dot below must be a variable.
+
+      Kernel_Item_Set : LR1_Items.Item_Set := -- used for temporary arg to 
Closure
+        (Set            => LR1_Items.Item_Lists.To_List
+           ((Prod       => <>,
+             Dot        => <>,
+             Lookaheads => Propagate_Lookahead (Descriptor))),
+         Goto_List      => <>,
+         Dot_IDs        => <>,
+         State          => <>);
+
+      Closure : LR1_Items.Item_Set;
+
+      Propagation_List : Item_Map_Lists.List;
+
+   begin
+      for Kernel of Kernels loop
+         if Trace_Generate > Outline then
+            Ada.Text_IO.Put ("Adding lookaheads for ");
+            LR1_Items.Put (Grammar, Descriptor, Kernel);
+         end if;
+
+         for Kernel_Item of Kernel.Set loop
+            Kernel_Item_Set.Set (Kernel_Item_Set.Set.First).Prod := 
Kernel_Item.Prod;
+            Kernel_Item_Set.Set (Kernel_Item_Set.Set.First).Dot  := 
Kernel_Item.Dot;
+
+            Closure := LR1_Items.Closure
+              (Kernel_Item_Set, Has_Empty_Production, First_Terminal_Sequence, 
Grammar, Descriptor);
+
+            for Closure_Item of Closure.Set loop
+               Generate_Lookahead_Info
+                 (Kernel_Item, Kernel, Closure_Item, Propagation_List, 
Descriptor, Grammar, Kernels);
+            end loop;
+         end loop;
+      end loop;
+
+      if Trace_Generate > Outline then
+         Ada.Text_IO.New_Line;
+         Ada.Text_IO.Put_Line ("Propagations:");
+         Put (Grammar, Descriptor, Propagation_List);
+         Ada.Text_IO.New_Line;
+      end if;
+
+      Propagate_Lookaheads (Propagation_List, Descriptor);
+   end Fill_In_Lookaheads;
+
+   --  Add actions for all Kernels to Table.
+   procedure Add_Actions
+     (Kernels                 : in     LR1_Items.Item_Set_List;
+      Grammar                 : in     
WisiToken.Productions.Prod_Arrays.Vector;
+      Has_Empty_Production    : in     Token_ID_Set;
+      First_Nonterm_Set       : in     Token_Array_Token_Set;
+      First_Terminal_Sequence : in     Token_Sequence_Arrays.Vector;
+      Conflicts               :    out Conflict_Lists.List;
+      Table                   : in out Parse_Table;
+      Descriptor              : in     WisiToken.Descriptor)
+   is
+      Closure : LR1_Items.Item_Set;
+   begin
+      for Kernel of Kernels loop
+         --  IMPROVEME: there are three "closure" computations that could
+         --  probably be refactored to save computation; in
+         --  LALR_Goto_Transitions, Fill_In_Lookaheads, and here.
+         Closure := LR1_Items.Closure (Kernel, Has_Empty_Production, 
First_Terminal_Sequence, Grammar, Descriptor);
+
+         Add_Actions (Closure, Table, Grammar, Has_Empty_Production, 
First_Nonterm_Set, Conflicts, Descriptor);
+      end loop;
+
+      if Trace_Generate > Detail then
+         Ada.Text_IO.New_Line;
+      end if;
+   end Add_Actions;
+
+   function Generate
+     (Grammar         : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor      : in WisiToken.Descriptor;
+      Known_Conflicts : in Conflict_Lists.List := Conflict_Lists.Empty_List;
+      McKenzie_Param  : in McKenzie_Param_Type := Default_McKenzie_Param;
+      Put_Parse_Table : in Boolean := False)
+     return Parse_Table_Ptr
+   is
+      use all type Ada.Containers.Count_Type;
+
+      Ignore_Unused_Tokens     : constant Boolean := WisiToken.Trace_Generate 
> Detail;
+      Ignore_Unknown_Conflicts : constant Boolean := WisiToken.Trace_Generate 
> Detail;
+      Unused_Tokens            : constant Boolean := 
WisiToken.Generate.Check_Unused_Tokens (Descriptor, Grammar);
+
+      Table : Parse_Table_Ptr;
+
+      Has_Empty_Production : constant Token_ID_Set := 
WisiToken.Generate.Has_Empty_Production (Grammar);
+
+      Minimal_Terminal_First : constant Token_Array_Token_ID :=
+        WisiToken.Generate.LR.Minimal_Terminal_First (Grammar, Descriptor);
+
+      Ancestors : constant Token_Array_Token_Set := 
WisiToken.Generate.Ancestors (Grammar, Descriptor);
+
+      First_Nonterm_Set : constant Token_Array_Token_Set := 
WisiToken.Generate.First
+        (Grammar, Has_Empty_Production, Descriptor.First_Terminal);
+
+      First_Terminal_Sequence : constant Token_Sequence_Arrays.Vector :=
+        WisiToken.Generate.To_Terminal_Sequence_Array (First_Nonterm_Set, 
Descriptor);
+
+      Kernels : LR1_Items.Item_Set_List := LALR_Kernels (Grammar, 
First_Nonterm_Set, Descriptor);
+
+      Unknown_Conflicts    : Conflict_Lists.List;
+      Known_Conflicts_Edit : Conflict_Lists.List := Known_Conflicts;
+
+   begin
+      WisiToken.Generate.Error := False; -- necessary in unit tests; some 
previous test might have encountered an error.
+
+      Fill_In_Lookaheads (Grammar, Has_Empty_Production, 
First_Terminal_Sequence, Kernels, Descriptor);
+
+      if Unused_Tokens then
+         WisiToken.Generate.Error := not Ignore_Unused_Tokens;
+         Ada.Text_IO.New_Line;
+      end if;
+
+      if Trace_Generate > Detail then
+         Ada.Text_IO.New_Line;
+         Ada.Text_IO.Put_Line ("LR(1) Kernels:");
+         LR1_Items.Put (Grammar, Descriptor, Kernels, Show_Lookaheads => True);
+      end if;
+
+      Table := new Parse_Table
+        (State_First       => Kernels.First_Index,
+         State_Last        => Kernels.Last_Index,
+         First_Terminal    => Descriptor.First_Terminal,
+         Last_Terminal     => Descriptor.Last_Terminal,
+         First_Nonterminal => Descriptor.First_Nonterminal,
+         Last_Nonterminal  => Descriptor.Last_Nonterminal);
+
+      if McKenzie_Param = Default_McKenzie_Param then
+         --  Descriminants in Default are wrong
+         Table.McKenzie_Param :=
+           (First_Terminal    => Descriptor.First_Terminal,
+            Last_Terminal     => Descriptor.Last_Terminal,
+            First_Nonterminal => Descriptor.First_Nonterminal,
+            Last_Nonterminal  => Descriptor.Last_Nonterminal,
+            Insert            => (others => 0),
+            Delete            => (others => 0),
+            Push_Back         => (others => 0),
+            Ignore_Check_Fail => Default_McKenzie_Param.Ignore_Check_Fail,
+            Task_Count        => Default_McKenzie_Param.Task_Count,
+            Cost_Limit        => Default_McKenzie_Param.Cost_Limit,
+            Check_Limit       => Default_McKenzie_Param.Check_Limit,
+            Check_Delta_Limit => Default_McKenzie_Param.Check_Delta_Limit,
+            Enqueue_Limit     => Default_McKenzie_Param.Enqueue_Limit);
+      else
+         Table.McKenzie_Param := McKenzie_Param;
+      end if;
+
+      Add_Actions
+        (Kernels, Grammar, Has_Empty_Production, First_Nonterm_Set, 
First_Terminal_Sequence, Unknown_Conflicts,
+         Table.all, Descriptor);
+
+      --  Set Table.States.Productions, Minimal_Terminal_First for 
McKenzie_Recover
+      for State in Table.States'Range loop
+         Table.States (State).Productions := LR1_Items.Productions (Kernels 
(State));
+         WisiToken.Generate.LR.Set_Minimal_Complete_Actions
+           (Table.States (State), Kernels (State), Minimal_Terminal_First, 
Ancestors, Descriptor, Grammar);
+      end loop;
+
+      if Put_Parse_Table then
+         WisiToken.Generate.LR.Put_Parse_Table
+           (Table, "LALR", Grammar, Kernels, Ancestors, Unknown_Conflicts, 
Descriptor);
+      end if;
+
+      Delete_Known (Unknown_Conflicts, Known_Conflicts_Edit);
+
+      if Unknown_Conflicts.Length > 0 then
+         Ada.Text_IO.Put_Line (Ada.Text_IO.Current_Error, "unknown 
conflicts:");
+         Put (Unknown_Conflicts, Ada.Text_IO.Current_Error, Descriptor);
+         Ada.Text_IO.New_Line (Ada.Text_IO.Current_Error);
+         WisiToken.Generate.Error := WisiToken.Generate.Error or not 
Ignore_Unknown_Conflicts;
+      end if;
+
+      if Known_Conflicts_Edit.Length > 0 then
+         Ada.Text_IO.Put_Line (Ada.Text_IO.Current_Error, "excess known 
conflicts:");
+         Put (Known_Conflicts_Edit, Ada.Text_IO.Current_Error, Descriptor);
+         Ada.Text_IO.New_Line (Ada.Text_IO.Current_Error);
+         WisiToken.Generate.Error := WisiToken.Generate.Error or not 
Ignore_Unknown_Conflicts;
+      end if;
+
+      return Table;
+   end Generate;
+
+end WisiToken.Generate.LR.LALR_Generate;
diff --git a/wisitoken-generate-lr-lalr_generate.ads 
b/wisitoken-generate-lr-lalr_generate.ads
new file mode 100644
index 0000000..01c65ca
--- /dev/null
+++ b/wisitoken-generate-lr-lalr_generate.ads
@@ -0,0 +1,67 @@
+--  Abstract :
+--
+--  Generalized LALR parse table generator.
+--
+--  Copyright (C) 2002 - 2003, 2009 - 2010, 2013 - 2015, 2017, 2018 Stephe 
Leake
+--  Copyright (C) 1999 Ted Dennison
+--
+--  This file is part of the WisiToken package.
+--
+--  The WisiToken package is free software; you can redistribute it
+--  and/or modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or
+--  (at your option) any later version. This library is distributed in
+--  the hope that it will be useful, but WITHOUT ANY WARRANTY; without
+--  even the implied warranty of MERCHAN- TABILITY or FITNESS FOR A
+--  PARTICULAR PURPOSE.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with WisiToken.Generate.LR1_Items;
+with WisiToken.Productions;
+package WisiToken.Generate.LR.LALR_Generate is
+
+   function Generate
+     (Grammar         : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor      : in WisiToken.Descriptor;
+      Known_Conflicts : in Conflict_Lists.List := Conflict_Lists.Empty_List;
+      McKenzie_Param  : in McKenzie_Param_Type := Default_McKenzie_Param;
+      Put_Parse_Table : in Boolean := False)
+     return Parse_Table_Ptr
+   with Pre =>
+     Descriptor.Last_Lookahead = Descriptor.First_Nonterminal and
+     Descriptor.First_Nonterminal = Descriptor.Accept_ID;
+   --  Generate a generalized LALR parse table for Grammar. The
+   --  grammar start symbol is the LHS of the first production in
+   --  Grammar.
+   --
+   --  Unless Ignore_Unused_Tokens is True, raise Grammar_Error if
+   --  there are unused tokens.
+   --
+   --  Unless Ignore_Unknown_Conflicts is True, raise Grammar_Error if there
+   --  are unknown conflicts.
+
+   ----------
+   --  Visible for unit tests
+
+   function LALR_Goto_Transitions
+     (Kernel            : in LR1_Items.Item_Set;
+      Symbol            : in Token_ID;
+      First_Nonterm_Set : in Token_Array_Token_Set;
+      Grammar           : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor        : in WisiToken.Descriptor)
+     return LR1_Items.Item_Set;
+   --  Return the Item_Set that is the goto for Symbol from Kernel.
+   --  If there is no such Item_Set, Result.Set is null.
+
+   function LALR_Kernels
+     (Grammar           : in WisiToken.Productions.Prod_Arrays.Vector;
+      First_Nonterm_Set : in Token_Array_Token_Set;
+      Descriptor        : in WisiToken.Descriptor)
+     return LR1_Items.Item_Set_List;
+
+end WisiToken.Generate.LR.LALR_Generate;
diff --git a/wisitoken-generate-lr-lr1_generate.adb 
b/wisitoken-generate-lr-lr1_generate.adb
new file mode 100644
index 0000000..14fa5db
--- /dev/null
+++ b/wisitoken-generate-lr-lr1_generate.adb
@@ -0,0 +1,315 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2017, 2018 Stephe Leake
+--
+--  This file is part of the WisiToken package.
+--
+--  The WisiToken package is free software; you can redistribute it
+--  and/or modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or
+--  (at your option) any later version. This library is distributed in
+--  the hope that it will be useful, but WITHOUT ANY WARRANTY; without
+--  even the implied warranty of MERCHAN- TABILITY or FITNESS FOR A
+--  PARTICULAR PURPOSE.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Containers;
+with Ada.Text_IO;
+with WisiToken.Generate;
+package body WisiToken.Generate.LR.LR1_Generate is
+
+   function LR1_Goto_Transitions
+     (Set                     : in LR1_Items.Item_Set;
+      Symbol                  : in Token_ID;
+      Has_Empty_Production    : in Token_ID_Set;
+      First_Terminal_Sequence : in Token_Sequence_Arrays.Vector;
+      Grammar                 : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor              : in WisiToken.Descriptor)
+     return LR1_Items.Item_Set
+   is
+      use all type Ada.Containers.Count_Type;
+      use Token_ID_Arrays;
+      use LR1_Items;
+
+      Goto_Set : Item_Set;
+   begin
+      for Item of Set.Set loop
+         if Item.Dot /= No_Element then
+            if Element (Item.Dot) = Symbol and
+              --  We don't need a state with dot after EOF in the
+              --  accept production. EOF should only appear in the
+              --  accept production.
+              Symbol /= Descriptor.EOF_ID
+            then
+               Goto_Set.Set.Insert ((Item.Prod, Next (Item.Dot), new 
Token_ID_Set'(Item.Lookaheads.all)));
+            end if;
+         end if;
+      end loop;
+
+      if Goto_Set.Set.Length > 0 then
+         return Closure (Goto_Set, Has_Empty_Production, 
First_Terminal_Sequence, Grammar, Descriptor);
+      else
+         return Goto_Set;
+      end if;
+   end LR1_Goto_Transitions;
+
+   function LR1_Item_Sets
+     (Has_Empty_Production    : in Token_ID_Set;
+      First_Terminal_Sequence : in Token_Sequence_Arrays.Vector;
+      Grammar                 : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor              : in WisiToken.Descriptor)
+     return LR1_Items.Item_Set_List
+   is
+      use all type Ada.Containers.Count_Type;
+
+      --  [dragon] algorithm 4.9 pg 231; figure 4.38 pg 232; procedure
+      --  "items", with some optimizations.
+
+      use LR1_Items;
+
+      First_State_Index : constant State_Index := 0;
+
+      C               : LR1_Items.Item_Set_List;       -- result
+      C_Tree          : LR1_Items.Item_Set_Trees.Tree; -- for fast find
+      States_To_Check : State_Index_Queues.Queue;
+      --  [dragon] specifies 'until no more items can be added', but we use
+      --  a queue to avoid checking unecessary states. Ada LR1 has over
+      --  100,000 states, so this is a significant gain (reduced time from
+      --  600 seconds to 40).
+
+      I       : State_Index;
+      Dot_IDs : Token_ID_Arrays.Vector;
+
+      New_Item_Set : Item_Set := Closure
+        ((Set            => Item_Lists.To_List
+            ((Prod       => (Grammar.First_Index, 0),
+              Dot        => Grammar (Grammar.First_Index).RHSs 
(0).Tokens.First,
+              Lookaheads => new Token_ID_Set'(To_Lookahead (Descriptor.EOF_ID, 
Descriptor)))),
+          Goto_List      => <>,
+          Dot_IDs        => <>,
+          State          => First_State_Index),
+        Has_Empty_Production, First_Terminal_Sequence, Grammar, Descriptor);
+
+      Found_State  : Unknown_State_Index;
+
+   begin
+      C.Set_First (First_State_Index);
+
+      Add (New_Item_Set, C, C_Tree, Descriptor, Include_Lookaheads => True);
+
+      States_To_Check.Put (First_State_Index);
+      loop
+         exit when States_To_Check.Is_Empty;
+         I := States_To_Check.Get;
+
+         if Trace_Generate > Outline then
+            Ada.Text_IO.Put ("Checking ");
+            Put (Grammar, Descriptor, C (I), Show_Lookaheads => True, 
Show_Goto_List => True);
+         end if;
+
+         Dot_IDs := C (I).Dot_IDs;
+         --  We can't iterate on C (I).Dot_IDs when the loop adds items to C;
+         --  it might be reallocated to grow.
+
+         for Symbol of Dot_IDs loop
+            --  [dragon] has 'for each grammar symbol X', but 
LR1_Goto_Transitions
+            --  rejects Symbol that is not in Dot_IDs, so we iterate over that.
+
+            New_Item_Set := LR1_Goto_Transitions
+              (C (I), Symbol, Has_Empty_Production, First_Terminal_Sequence, 
Grammar, Descriptor);
+
+            if New_Item_Set.Set.Length > 0 then -- 'goto (I, X) not empty'
+
+               Found_State := Find (New_Item_Set, C_Tree, Match_Lookaheads => 
True); -- 'not in C'
+
+               if Found_State = Unknown_State then
+                  New_Item_Set.State := C.Last_Index + 1;
+
+                  States_To_Check.Put (New_Item_Set.State);
+
+                  Add (New_Item_Set, C, C_Tree, Descriptor, Include_Lookaheads 
=> True);
+
+                  if Trace_Generate > Outline then
+                     Ada.Text_IO.Put_Line
+                       ("  adding state" & Unknown_State_Index'Image 
(C.Last_Index) & ": from state" &
+                          Unknown_State_Index'Image (I) & " on " & Image 
(Symbol, Descriptor));
+                     Put (Grammar, Descriptor, New_Item_Set, Show_Lookaheads 
=> True);
+                  end if;
+
+                  C (I).Goto_List.Insert ((Symbol, C.Last_Index));
+               else
+
+                  --  If there's not already a goto entry between these two 
sets, create one.
+                  if not Is_In ((Symbol, Found_State), Goto_List => C 
(I).Goto_List) then
+                     if Trace_Generate > Outline then
+                        Ada.Text_IO.Put_Line
+                          ("  adding goto on " & Image (Symbol, Descriptor) & 
" to state" &
+                             Unknown_State_Index'Image (Found_State));
+
+                     end if;
+
+                     C (I).Goto_List.Insert ((Symbol, Found_State));
+                  end if;
+               end if;
+            end if;
+         end loop;
+      end loop;
+
+      if Trace_Generate > Outline then
+         Ada.Text_IO.New_Line;
+      end if;
+
+      return C;
+   end LR1_Item_Sets;
+
+   procedure Add_Actions
+     (Item_Sets            : in     LR1_Items.Item_Set_List;
+      Grammar              : in     WisiToken.Productions.Prod_Arrays.Vector;
+      Has_Empty_Production : in     Token_ID_Set;
+      First_Nonterm_Set    : in     Token_Array_Token_Set;
+      Conflicts            :    out Conflict_Lists.List;
+      Table                : in out Parse_Table;
+      Descriptor           : in     WisiToken.Descriptor)
+   is
+      --  Add actions for all Item_Sets to Table.
+   begin
+      for Item_Set of Item_Sets loop
+         Add_Actions (Item_Set, Table, Grammar, Has_Empty_Production, 
First_Nonterm_Set, Conflicts, Descriptor);
+      end loop;
+
+      if Trace_Generate > Outline then
+         Ada.Text_IO.New_Line;
+      end if;
+   end Add_Actions;
+
+   function Generate
+     (Grammar         : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor      : in WisiToken.Descriptor;
+      Known_Conflicts : in Conflict_Lists.List := Conflict_Lists.Empty_List;
+      McKenzie_Param  : in McKenzie_Param_Type := Default_McKenzie_Param;
+      Put_Parse_Table : in Boolean := False)
+     return Parse_Table_Ptr
+   is
+      use type Ada.Containers.Count_Type;
+
+      Ignore_Unused_Tokens     : constant Boolean := WisiToken.Trace_Generate 
> Detail;
+      Ignore_Unknown_Conflicts : constant Boolean := WisiToken.Trace_Generate 
> Detail;
+      Unused_Tokens            : constant Boolean := 
WisiToken.Generate.Check_Unused_Tokens (Descriptor, Grammar);
+
+      Table : Parse_Table_Ptr;
+
+      Has_Empty_Production : constant Token_ID_Set := 
WisiToken.Generate.Has_Empty_Production (Grammar);
+
+      Minimal_Terminal_First : constant Token_Array_Token_ID :=
+        WisiToken.Generate.LR.Minimal_Terminal_First (Grammar, Descriptor);
+
+      Ancestors : constant Token_Array_Token_Set := 
WisiToken.Generate.Ancestors (Grammar, Descriptor);
+
+      First_Nonterm_Set : constant Token_Array_Token_Set := 
WisiToken.Generate.First
+        (Grammar, Has_Empty_Production, Descriptor.First_Terminal);
+
+      First_Terminal_Sequence : constant Token_Sequence_Arrays.Vector :=
+        WisiToken.Generate.To_Terminal_Sequence_Array (First_Nonterm_Set, 
Descriptor);
+
+      Item_Sets : constant LR1_Items.Item_Set_List := LR1_Item_Sets
+        (Has_Empty_Production, First_Terminal_Sequence, Grammar, Descriptor);
+
+      Unknown_Conflicts    : Conflict_Lists.List;
+      Known_Conflicts_Edit : Conflict_Lists.List := Known_Conflicts;
+   begin
+      if Trace_Generate > Outline then
+         Ada.Text_IO.New_Line;
+         Ada.Text_IO.Put_Line ("LR(1) Item_Sets:");
+         LR1_Items.Put (Grammar, Descriptor, Item_Sets);
+      end if;
+
+      Table := new Parse_Table
+        (State_First       => Item_Sets.First_Index,
+         State_Last        => Item_Sets.Last_Index,
+         First_Terminal    => Descriptor.First_Terminal,
+         Last_Terminal     => Descriptor.Last_Terminal,
+         First_Nonterminal => Descriptor.First_Nonterminal,
+         Last_Nonterminal  => Descriptor.Last_Nonterminal);
+
+      if McKenzie_Param = Default_McKenzie_Param then
+         --  Descriminants in Default are wrong
+         Table.McKenzie_Param :=
+           (First_Terminal    => Descriptor.First_Terminal,
+            Last_Terminal     => Descriptor.Last_Terminal,
+            First_Nonterminal => Descriptor.First_Nonterminal,
+            Last_Nonterminal  => Descriptor.Last_Nonterminal,
+            Insert            => (others => 0),
+            Delete            => (others => 0),
+            Push_Back         => (others => 0),
+            Ignore_Check_Fail => Default_McKenzie_Param.Ignore_Check_Fail,
+            Task_Count        => Default_McKenzie_Param.Task_Count,
+            Cost_Limit        => Default_McKenzie_Param.Cost_Limit,
+            Check_Limit       => Default_McKenzie_Param.Check_Limit,
+            Check_Delta_Limit => Default_McKenzie_Param.Check_Delta_Limit,
+            Enqueue_Limit     => Default_McKenzie_Param.Enqueue_Limit);
+      else
+         Table.McKenzie_Param := McKenzie_Param;
+      end if;
+
+      Add_Actions
+        (Item_Sets, Grammar, Has_Empty_Production, First_Nonterm_Set, 
Unknown_Conflicts, Table.all, Descriptor);
+
+      --  Set Table.States.Productions, Minimal_Terminal_First for 
McKenzie_Recover
+      for State in Table.States'Range loop
+         Table.States (State).Productions := LR1_Items.Productions
+           (LR1_Items.Filter (Item_Sets (State), Grammar, Descriptor, 
LR1_Items.In_Kernel'Access));
+         WisiToken.Generate.LR.Set_Minimal_Complete_Actions
+           (Table.States (State),
+            LR1_Items.Filter (Item_Sets (State), Grammar, Descriptor, 
LR1_Items.In_Kernel'Access),
+            Minimal_Terminal_First, Ancestors, Descriptor, Grammar);
+      end loop;
+
+      if Put_Parse_Table then
+         WisiToken.Generate.LR.Put_Parse_Table
+           (Table, "LR1", Grammar, Item_Sets, Ancestors, Unknown_Conflicts, 
Descriptor);
+      end if;
+
+      if Trace_Generate > Outline then
+         Ada.Text_IO.New_Line;
+         Ada.Text_IO.Put_Line ("Has_Empty_Production: " & Image 
(Has_Empty_Production, Descriptor));
+
+         Ada.Text_IO.New_Line;
+         Ada.Text_IO.Put_Line ("Minimal_Terminal_First:");
+         for ID in Minimal_Terminal_First'Range loop
+            Ada.Text_IO.Put_Line
+              (Image (ID, Descriptor) & " =>" &
+                 (if Minimal_Terminal_First (ID) = Invalid_Token_ID
+                  then ""
+                  else ' ' & Image (Minimal_Terminal_First (ID), Descriptor)));
+         end loop;
+      end if;
+
+      Delete_Known (Unknown_Conflicts, Known_Conflicts_Edit);
+
+      if Unknown_Conflicts.Length > 0 then
+         Ada.Text_IO.Put_Line (Ada.Text_IO.Current_Error, "unknown 
conflicts:");
+         Put (Unknown_Conflicts, Ada.Text_IO.Current_Error, Descriptor);
+         Ada.Text_IO.New_Line (Ada.Text_IO.Current_Error);
+         WisiToken.Generate.Error := WisiToken.Generate.Error or not 
Ignore_Unknown_Conflicts;
+      end if;
+
+      if Known_Conflicts_Edit.Length > 0 then
+         Ada.Text_IO.Put_Line (Ada.Text_IO.Current_Error, "excess known 
conflicts:");
+         Put (Known_Conflicts_Edit, Ada.Text_IO.Current_Error, Descriptor);
+         Ada.Text_IO.New_Line (Ada.Text_IO.Current_Error);
+         WisiToken.Generate.Error := WisiToken.Generate.Error or not 
Ignore_Unknown_Conflicts;
+      end if;
+
+      WisiToken.Generate.Error := WisiToken.Generate.Error or (Unused_Tokens 
and not Ignore_Unused_Tokens);
+
+      return Table;
+   end Generate;
+
+end WisiToken.Generate.LR.LR1_Generate;
diff --git a/wisitoken-generate-lr-lr1_generate.ads 
b/wisitoken-generate-lr-lr1_generate.ads
new file mode 100644
index 0000000..7dea371
--- /dev/null
+++ b/wisitoken-generate-lr-lr1_generate.ads
@@ -0,0 +1,76 @@
+--  Abstract :
+--
+--  LR1 (Left-to-right scanning 1 look-ahead) parser table generator.
+--
+--  References:
+--
+--  [dragon] "Compilers Principles, Techniques, and Tools" by Aho,
+--  Sethi, and Ullman (aka: "The [Red] Dragon Book").
+--
+--  Copyright (C) 2017, 2018 Stephe Leake
+--
+--  This file is part of the WisiToken package.
+--
+--  The WisiToken package is free software; you can redistribute it
+--  and/or modify it under terms of the GNU General Public License as
+--  published by the Free Software Foundation; either version 3, or
+--  (at your option) any later version. This library is distributed in
+--  the hope that it will be useful, but WITHOUT ANY WARRANTY; without
+--  even the implied warranty of MERCHAN- TABILITY or FITNESS FOR A
+--  PARTICULAR PURPOSE.
+--
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with WisiToken.Generate.LR1_Items;
+with WisiToken.Productions;
+package WisiToken.Generate.LR.LR1_Generate is
+
+   function Generate
+     (Grammar         : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor      : in WisiToken.Descriptor;
+      Known_Conflicts : in Conflict_Lists.List := Conflict_Lists.Empty_List;
+      McKenzie_Param  : in McKenzie_Param_Type := Default_McKenzie_Param;
+      Put_Parse_Table : in Boolean := False)
+     return Parse_Table_Ptr
+   with Pre => Descriptor.First_Nonterminal = Descriptor.Accept_ID;
+   --  Generate a generalized LR1 parse table for Grammar. The
+   --  grammar start symbol is the LHS of the first production in
+   --  Grammar.
+   --
+   --  If Trace, output debug info to Standard_Error about generation
+   --  process. We don't use WisiToken.Trace here; we often want to
+   --  see a trace of the parser execution without the parser
+   --  generation.
+   --
+   --  Unless Ignore_Unused_Tokens is True, raise Grammar_Error if
+   --  there are unused tokens.
+   --
+   --  Unless Ignore_Unknown_Conflicts is True, raise Grammar_Error if there
+   --  are unknown conflicts.
+
+   ----------
+   --  visible for unit test
+
+   function LR1_Goto_Transitions
+     (Set                     : in LR1_Items.Item_Set;
+      Symbol                  : in Token_ID;
+      Has_Empty_Production    : in Token_ID_Set;
+      First_Terminal_Sequence : in Token_Sequence_Arrays.Vector;
+      Grammar                 : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor              : in WisiToken.Descriptor)
+     return LR1_Items.Item_Set;
+   --  'goto' from [dragon] algorithm 4.9
+
+   function LR1_Item_Sets
+     (Has_Empty_Production    : in Token_ID_Set;
+      First_Terminal_Sequence : in Token_Sequence_Arrays.Vector;
+      Grammar                 : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor              : in WisiToken.Descriptor)
+     return LR1_Items.Item_Set_List;
+   --  [dragon] algorithm 4.9 pg 231; figure 4.38 pg 232; procedure "items"
+
+end WisiToken.Generate.LR.LR1_Generate;
diff --git a/wisitoken-generate-lr.adb b/wisitoken-generate-lr.adb
new file mode 100644
index 0000000..32689c0
--- /dev/null
+++ b/wisitoken-generate-lr.adb
@@ -0,0 +1,1141 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2017, 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (GPL);
+
+with Ada.Strings.Fixed;
+with Ada.Text_IO;
+with System.Multiprocessors;
+with WisiToken.Generate;
+package body WisiToken.Generate.LR is
+
+   ----------
+   --  Body subprograms, alphabetical
+
+   function Count_Reduce (List : in Parse.LR.Minimal_Action_Lists.List) return 
Integer
+   is
+      Count : Integer := 0;
+   begin
+      for Item of List loop
+         if Item.Verb = Reduce then
+            Count := Count + 1;
+         end if;
+      end loop;
+      return Count;
+   end Count_Reduce;
+
+   function Find
+     (Symbol      : in Token_ID;
+      Action_List : in Action_Node_Ptr)
+     return Action_Node_Ptr
+   is
+      Action_Node : Action_Node_Ptr := Action_List;
+   begin
+      while Action_Node /= null loop
+         if Action_Node.Symbol = Symbol then
+            return Action_Node;
+         end if;
+         Action_Node := Action_Node.Next;
+      end loop;
+
+      return null;
+   end Find;
+
+   procedure Terminal_Sequence
+     (Grammar       : in     WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor    : in     WisiToken.Descriptor;
+      All_Sequences : in out Token_Sequence_Arrays.Vector;
+      All_Set       : in out Token_ID_Set;
+      Recursing     : in out Token_ID_Set;
+      Nonterm       : in     Token_ID)
+   is
+      use Ada.Containers;
+      Prod : Productions.Instance renames Grammar (Nonterm);
+
+      Temp              : Token_Sequence_Arrays.Vector;
+      Min_Length        : Count_Type := Count_Type'Last;
+      Skipped_Recursive : Boolean    := False;
+   begin
+      --  We get here because All_Sequences (Nonterm) has not been comptued
+      --  yet. Attempt to compute All_Sequences (Nonterm); if successful, set
+      --  All_Set (Nonterm) True.
+
+      --  First fill Temp with terminals from each production for Nonterm.
+      for L in Prod.RHSs.First_Index .. Prod.RHSs.Last_Index loop
+
+         if Prod.RHSs (L).Tokens.Length = 0 then
+            All_Set (Nonterm) := True;
+
+            if Trace_Generate > Detail then
+               Ada.Text_IO.Put_Line (Image (Nonterm, Descriptor) & " => ()");
+            end if;
+
+            return;
+         end if;
+
+         if Prod.RHSs (L).Tokens (1) = Nonterm then
+            --  The first RHS token = LHS; a recursive list. This will never be
+            --  the shortest production, so just skip it.
+            null;
+
+         else
+            declare
+               Sequence : Token_ID_Arrays.Vector;
+            begin
+               for ID of Prod.RHSs (L).Tokens loop
+                  if ID in Descriptor.First_Terminal .. 
Descriptor.Last_Terminal then
+                     Sequence.Append (ID);
+
+                  else
+                     if not All_Set (ID) then
+                        if Recursing (ID) then
+                           --  This nonterm is mutually recursive with some 
other. This
+                           --  production will never be the shortest unless 
it's the only one,
+                           --  so skip it.
+                           if Trace_Generate > Detail then
+                              Ada.Text_IO.Put_Line (Image (ID, Descriptor) & " 
mutual recurse skipped");
+                           end if;
+                           Skipped_Recursive := True;
+                           goto Skip;
+                        else
+                           Recursing (ID) := True;
+                           if Trace_Generate > Detail then
+                              Ada.Text_IO.Put_Line (Image (ID, Descriptor) & " 
recurse");
+                           end if;
+                           Terminal_Sequence (Grammar, Descriptor, 
All_Sequences, All_Set, Recursing, ID);
+                           Recursing (ID) := False;
+
+                           if not All_Set (ID) then
+                              --  abandoned because of recursion
+                              Skipped_Recursive := True;
+                              goto Skip;
+                           end if;
+                        end if;
+                     end if;
+                     Sequence.Append (All_Sequences (ID));
+                  end if;
+               end loop;
+
+               if Trace_Generate > Detail then
+                  Ada.Text_IO.Put_Line (Image (Nonterm, Descriptor) & " -> " & 
Image (Sequence, Descriptor));
+               end if;
+               Temp.Append (Sequence);
+            end;
+         end if;
+
+         <<Skip>>
+         null;
+      end loop;
+
+      --  Now find the minimum length.
+      if Temp.Length = 0 and Skipped_Recursive then
+         --  better luck next time.
+         return;
+      end if;
+
+      for S of Temp loop
+         if S.Length <= Min_Length then
+            Min_Length := S.Length;
+
+            All_Sequences (Nonterm) := S;
+         end if;
+      end loop;
+
+      if Trace_Generate > Detail then
+         Ada.Text_IO.Put_Line (Image (Nonterm, Descriptor) & " ==> " & Image 
(All_Sequences (Nonterm), Descriptor));
+      end if;
+
+      All_Set (Nonterm) := True;
+   end Terminal_Sequence;
+
+   ----------
+   --  Public subprograms, declaration order
+
+   procedure Put
+     (Item       : in Conflict_Lists.List;
+      File       : in Ada.Text_IO.File_Type;
+      Descriptor : in WisiToken.Descriptor)
+   is begin
+      for Conflict of Item loop
+         Ada.Text_IO.Put_Line (File, Image (Conflict, Descriptor));
+      end loop;
+   end Put;
+
+   procedure Add_Action
+     (Symbol               : in     Token_ID;
+      Action               : in     Parse_Action_Rec;
+      Action_List          : in out Action_Node_Ptr;
+      Closure              : in     LR1_Items.Item_Set;
+      Grammar              : in     WisiToken.Productions.Prod_Arrays.Vector;
+      Has_Empty_Production : in     Token_ID_Set;
+      First_Nonterm_Set    : in     Token_Array_Token_Set;
+      Conflicts            : in out Conflict_Lists.List;
+      Descriptor           : in     WisiToken.Descriptor)
+   is
+      Matching_Action : constant Action_Node_Ptr := Find (Symbol, Action_List);
+   begin
+      if Trace_Generate > Outline then
+         Ada.Text_IO.Put (Image (Symbol, Descriptor) & " => ");
+         Put (Descriptor, Action);
+         Ada.Text_IO.New_Line;
+      end if;
+
+      if Matching_Action /= null then
+         if Equal (Matching_Action.Action.Item, Action) then
+            --  Matching_Action is identical to Action, so there is no
+            --  conflict; just don't add it again.
+            if Trace_Generate > Outline then
+               Ada.Text_IO.Put_Line (" - already present");
+            end if;
+            return;
+         else
+            --  There is a conflict. Report it and add it, so the
+            --  generalized parser can follow both paths
+            declare
+               --  Enforce canonical Shift/Reduce or Accept/Reduce
+               --  order, to simplify searching and code generation.
+               Action_A : constant Parse_Action_Rec :=
+                 (if Action.Verb in Shift | Accept_It then Action else 
Matching_Action.Action.Item);
+
+               Action_B : constant Parse_Action_Rec :=
+                 (if Action.Verb in Shift | Accept_It then 
Matching_Action.Action.Item else Action);
+
+               New_Conflict : constant Conflict :=
+                 (Action_A    => Action_A.Verb,
+                  Action_B    => Action_B.Verb,
+                  LHS_A       => Find
+                    (Closure, Action_A, Symbol, Grammar, Has_Empty_Production, 
First_Nonterm_Set, Descriptor),
+                  LHS_B       => Find
+                    (Closure, Action_B, Symbol, Grammar, Has_Empty_Production, 
First_Nonterm_Set, Descriptor),
+                  State_Index => Closure.State,
+                  On          => Symbol);
+            begin
+               if not Is_Present (New_Conflict, Conflicts) then
+                  --  The same conflict may occur in a different
+                  --  item set. Only add it to conflicts once.
+                  Conflicts.Append (New_Conflict);
+
+                  if Trace_Generate > Outline then
+                     Ada.Text_IO.Put_Line (" - conflict added: " & Image 
(New_Conflict, Descriptor));
+                  end if;
+               else
+                  if Trace_Generate > Outline then
+                     Ada.Text_IO.Put_Line (" - conflict duplicate: " & Image 
(New_Conflict, Descriptor));
+                  end if;
+               end if;
+
+               --  More than two actions can occur; see triple_conflict.wy. We 
make
+               --  that an error, since the grammar will be better off without 
them.
+               --  But keep going; the full parse table output will be needed 
to fix
+               --  the excess conflict.
+               if Matching_Action.Action.Next /= null then
+                  if Matching_Action.Action.Item = Action or 
Matching_Action.Action.Next.Item = Action then
+                     if Trace_Generate > Outline then
+                        Ada.Text_IO.Put_Line (" - conflict duplicate");
+                     end if;
+                  else
+                     WisiToken.Generate.Put_Error
+                       ("More than two actions on " & Image (Symbol, 
Descriptor) &
+                          " in state" & State_Index'Image (Closure.State));
+                  end if;
+               end if;
+
+               if Action.Verb = Shift then
+                  Matching_Action.Action := new Parse_Action_Node'(Action, 
Matching_Action.Action);
+               else
+                  Matching_Action.Action.Next := new 
Parse_Action_Node'(Action, Matching_Action.Action.Next);
+               end if;
+            end;
+         end if;
+      else
+         WisiToken.Parse.LR.Add (Action_List, Symbol, Action);
+      end if;
+   end Add_Action;
+
+   procedure Add_Actions
+     (Closure              : in     LR1_Items.Item_Set;
+      Table                : in out Parse_Table;
+      Grammar              : in     WisiToken.Productions.Prod_Arrays.Vector;
+      Has_Empty_Production : in     Token_ID_Set;
+      First_Nonterm_Set    : in     Token_Array_Token_Set;
+      Conflicts            : in out Conflict_Lists.List;
+      Descriptor           : in     WisiToken.Descriptor)
+   is
+      use WisiToken.Token_ID_Arrays;
+
+      State : constant State_Index := Closure.State;
+   begin
+      if Trace_Generate > Outline then
+         Ada.Text_IO.Put_Line ("adding actions for state" & State_Index'Image 
(State));
+      end if;
+
+      for Item of Closure.Set loop
+         if Item.Dot = No_Element then
+            --  Pointer is at the end of the production; add a reduce action.
+
+            Add_Lookahead_Actions
+              (Item, Table.States (State).Action_List, Grammar, 
Has_Empty_Production, First_Nonterm_Set,
+               Conflicts, Closure, Descriptor);
+
+         elsif Element (Item.Dot) in Descriptor.First_Terminal .. 
Descriptor.Last_Terminal then
+            --  Dot is before a terminal token.
+            declare
+               use all type Ada.Containers.Count_Type;
+
+               Dot_ID : constant Token_ID := Element (Item.Dot);
+               --  ID of token after Item.Dot
+
+               Goto_State : constant Unknown_State_Index := 
LR1_Items.Goto_State (Closure, Dot_ID);
+            begin
+               if Dot_ID = Descriptor.EOF_ID then
+                  --  This is the start symbol production with dot before EOF.
+                  declare
+                     P_ID : constant Production_ID := Item.Prod;
+                     RHS  : Productions.Right_Hand_Side renames Grammar 
(P_ID.LHS).RHSs (P_ID.RHS);
+                  begin
+                     Add_Action
+                       (Dot_ID,
+                        (Accept_It, P_ID, RHS.Action, RHS.Check, 
RHS.Tokens.Length - 1),
+                        --  EOF is not pushed on stack in parser, because the 
action for EOF
+                        --  is Accept, not Shift.
+                        Table.States (State).Action_List, Closure,
+                        Grammar, Has_Empty_Production, First_Nonterm_Set, 
Conflicts, Descriptor);
+                  end;
+               else
+                  if Goto_State /= Unknown_State then
+                     Add_Action
+                       (Dot_ID,
+                        (Shift, Goto_State),
+                        Table.States (State).Action_List,
+                        Closure, Grammar, Has_Empty_Production, 
First_Nonterm_Set, Conflicts, Descriptor);
+                  end if;
+               end if;
+            end;
+         else
+            --  Dot is before a non-terminal token; no action.
+            if Trace_Generate > Outline then
+               Ada.Text_IO.Put_Line (Image (Element (Item.Dot), Descriptor) & 
" => no action");
+            end if;
+         end if;
+      end loop;
+
+      --  Place a default error action at the end of every state.
+      --  (it should always have at least one action already).
+      declare
+         --  The default action, when nothing else matches an input
+         Default_Action : constant Action_Node :=
+           --  The symbol here is actually irrelevant; it is the
+           --  position as the last on a state's action list that makes
+           --  it the default.
+           (Symbol => Invalid_Token_ID,
+            Action => new Parse_Action_Node'(Parse_Action_Rec'(Verb => 
WisiToken.Parse.LR.Error), null),
+            Next   => null);
+
+         Last_Action : Action_Node_Ptr := Table.States (State).Action_List;
+      begin
+         if Last_Action = null then
+            --  This happens if the first production in the grammar is
+            --  not the start symbol production.
+            --
+            --  It also happens when the start symbol production does
+            --  not have an explicit EOF, or when there is more than
+            --  one production that has the start symbol on the left
+            --  hand side.
+            --
+            --  It also happens when the grammar is bad, for example:
+            --
+            --  declarations <= declarations & declaration
+            --
+            --  without 'declarations <= declaration'.
+            --
+            --  We continue generating the grammar, in order to help the user
+            --  debug this issue.
+            WisiToken.Generate.Error := True;
+
+            Ada.Text_IO.Put_Line
+              (Ada.Text_IO.Current_Error, "Error: state" & State_Index'Image 
(State) &
+                 " has no actions; bad grammar, or " &
+                 "first production in grammar must be the only start symbol 
production, " &
+                 "and it must must have an explicit EOF.");
+         else
+            while Last_Action.Next /= null loop
+               Last_Action := Last_Action.Next;
+            end loop;
+            Last_Action.Next := new Action_Node'(Default_Action);
+         end if;
+      end;
+
+      for Item of Closure.Goto_List loop
+         if Item.Symbol in Descriptor.First_Nonterminal .. 
Descriptor.Last_Nonterminal then
+            Add_Goto (Table.States (State), Item.Symbol, Item.State); -- note 
list is already sorted.
+         end if;
+      end loop;
+   end Add_Actions;
+
+   procedure Add_Lookahead_Actions
+     (Item                 : in     LR1_Items.Item;
+      Action_List          : in out Action_Node_Ptr;
+      Grammar              : in     WisiToken.Productions.Prod_Arrays.Vector;
+      Has_Empty_Production : in     Token_ID_Set;
+      First_Nonterm_Set    : in     Token_Array_Token_Set;
+      Conflicts            : in out Conflict_Lists.List;
+      Closure              : in     LR1_Items.Item_Set;
+      Descriptor           : in     WisiToken.Descriptor)
+   is
+      Prod   : Productions.Instance renames Grammar (Item.Prod.LHS);
+      RHS    : Productions.Right_Hand_Side renames Prod.RHSs (Item.Prod.RHS);
+      Action : constant Parse_Action_Rec := (Reduce, Item.Prod, RHS.Action, 
RHS.Check, RHS.Tokens.Length);
+   begin
+      if Trace_Generate > Outline then
+         Ada.Text_IO.Put_Line ("processing lookaheads");
+      end if;
+
+      --  We ignore propagate lookaheads here.
+      for Lookahead in Item.Lookaheads'Range loop
+         if Item.Lookaheads (Lookahead) then
+            if Lookahead = Descriptor.First_Nonterminal then
+               null;
+            else
+               Add_Action
+                 (Lookahead, Action, Action_List, Closure, Grammar,
+                  Has_Empty_Production, First_Nonterm_Set, Conflicts, 
Descriptor);
+            end if;
+         end if;
+      end loop;
+   end Add_Lookahead_Actions;
+
+   procedure Delete_Known
+     (Conflicts       : in out Conflict_Lists.List;
+      Known_Conflicts : in out Conflict_Lists.List)
+   is
+      --  Delete all elements in Conflicts that match an element in
+      --  Known_Conflicts. There can be more than one Conflict that
+      --  match one Known_Conflict.
+      use Conflict_Lists;
+      Known      : Cursor  := Known_Conflicts.First;
+      Next_Known : Cursor;
+   begin
+      loop
+         exit when Known = No_Element;
+         Next_Known := Next (Known);
+         declare
+            I      : Cursor  := Conflicts.First;
+            Next_I : Cursor;
+            Used   : Boolean := False;
+         begin
+            loop
+               exit when I = No_Element;
+               Next_I := Next (I);
+               if Match (Element (Known), Conflicts.Constant_Reference (I)) 
then
+                  Delete (Conflicts, I);
+                  Used := True;
+               end if;
+               I := Next_I;
+            end loop;
+
+            if Used then
+               Delete (Known_Conflicts, Known);
+            end if;
+         end;
+         Known := Next_Known;
+      end loop;
+   end Delete_Known;
+
+   function Find
+     (Closure              : in LR1_Items.Item_Set;
+      Action               : in Parse_Action_Rec;
+      Lookahead            : in Token_ID;
+      Grammar              : in WisiToken.Productions.Prod_Arrays.Vector;
+      Has_Empty_Production : in Token_ID_Set;
+      First                : in Token_Array_Token_Set;
+      Descriptor           : in WisiToken.Descriptor)
+     return Token_ID
+   is
+      use WisiToken.Token_ID_Arrays;
+
+      ID_I : Cursor;
+   begin
+      case Action.Verb is
+      when Reduce | Accept_It =>
+         --  If the nonterm produced by the reduce is the LHS of the state
+         --  production, use it.
+         for Item of Closure.Set loop
+            if LR1_Items.In_Kernel (Grammar, Descriptor, Item) and
+              Action.Production.LHS = Item.Prod.LHS
+            then
+               return Item.Prod.LHS;
+            end if;
+         end loop;
+
+         --  The reduce nonterm is after Dot in a state production; find which
+         --  one, use that.
+         for Item of Closure.Set loop
+            if LR1_Items.In_Kernel (Grammar, Descriptor, Item) then
+               ID_I := Item.Dot;
+               loop
+                  if ID_I = No_Element then
+                     if Item.Lookaheads (Lookahead) then
+                        return Item.Prod.LHS;
+                     end if;
+                  else
+                     declare
+                        Dot_ID : Token_ID renames Element (ID_I);
+                     begin
+                        if Dot_ID = Lookahead or
+                          (Dot_ID in Descriptor.First_Nonterminal .. 
Descriptor.Last_Nonterminal and then
+                             First (Dot_ID, Lookahead))
+                        then
+                           return Item.Prod.LHS;
+                        end if;
+                        exit when Dot_ID in Descriptor.First_Nonterminal .. 
Descriptor.Last_Nonterminal and then
+                          not Has_Empty_Production (Dot_ID);
+                     end;
+                  end if;
+
+                  exit when ID_I = No_Element;
+                  Next (ID_I);
+               end loop;
+            end if;
+         end loop;
+
+      when Shift =>
+
+         for Item of Closure.Set loop
+            --  Lookahead (the token shifted) is starting a nonterm in a state
+            --  production; it is in First of that nonterm.
+            if LR1_Items.In_Kernel (Grammar, Descriptor, Item) then
+               ID_I := Item.Dot;
+               loop
+                  exit when ID_I = No_Element;
+                  declare
+                     Dot_ID : Token_ID renames Element (ID_I);
+                  begin
+                     if Dot_ID = Lookahead or
+                       (Dot_ID in Descriptor.First_Nonterminal .. 
Descriptor.Last_Nonterminal and then
+                          First (Dot_ID, Lookahead))
+                     then
+                        return Item.Prod.LHS;
+                     end if;
+
+                     exit when Dot_ID in Descriptor.First_Nonterminal .. 
Descriptor.Last_Nonterminal and then
+                       not Has_Empty_Production (Dot_ID);
+                  end;
+
+                  Next (ID_I);
+               end loop;
+            end if;
+         end loop;
+
+      when WisiToken.Parse.LR.Error =>
+         raise SAL.Programmer_Error;
+      end case;
+
+      Ada.Text_IO.Put_Line
+        ("item for " & Image (Action, Descriptor) & " on " & Image (Lookahead, 
Descriptor) & " not found in");
+      LR1_Items.Put (Grammar, Descriptor, Closure, Kernel_Only => True);
+      raise SAL.Programmer_Error;
+   end Find;
+
+   function Image (Item : in Conflict; Descriptor : in WisiToken.Descriptor) 
return String
+   is begin
+      return
+        ("%conflict " &
+           Conflict_Parse_Actions'Image (Item.Action_A) & "/" &
+           Conflict_Parse_Actions'Image (Item.Action_B) & " in state " &
+           Image (Item.LHS_A, Descriptor) & ", " &
+           Image (Item.LHS_B, Descriptor) &
+           " on token " & Image (Item.On, Descriptor) &
+           " (" & State_Index'Image (Item.State_Index) & ")"); -- state number 
last for easier delete
+   end Image;
+
+   function Is_Present (Item : in Conflict; Conflicts : in 
Conflict_Lists.List) return Boolean
+   is
+      use Conflict_Lists;
+      I : Cursor := Conflicts.First;
+   begin
+      loop
+         exit when I = No_Element;
+         if Match (Item, Conflicts.Constant_Reference (I)) then
+            return True;
+         end if;
+         I := Next (I);
+      end loop;
+      return False;
+   end Is_Present;
+
+   function Match (Known : in Conflict; Item : in 
Conflict_Lists.Constant_Reference_Type) return Boolean
+   is begin
+      --  Ignore State_Index. Actions are in canonical order; enforced
+      --  in Add_Action above. For reduce/reduce, LHS_A, LHS_B are not
+      --  in canonical order.
+      return
+        Known.Action_A = Item.Action_A and
+        Known.Action_B = Item.Action_B and
+        ((Known.LHS_A = Item.LHS_A and Known.LHS_B = Item.LHS_B) or
+           (Known.LHS_B = Item.LHS_A and Known.LHS_A = Item.LHS_B)) and
+        Known.On = Item.On;
+   end Match;
+
+   procedure Compute_Minimal_Terminal_Sequences
+     (Grammar    : in     WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor : in     WisiToken.Descriptor;
+      Result     : in out Token_Sequence_Arrays.Vector)
+   is
+      --  Result (ID).Length = 0 is a valid sequence (ie the nonterminal can
+      --  be empty), so we use an auxilliary array to track whether Result
+      --  (ID) has been computed.
+      --
+      --  We also need to detect mutual recursion, and incomplete grammars.
+
+      All_Set   : Token_ID_Set := (Descriptor.First_Nonterminal .. 
Descriptor.Last_Nonterminal => False);
+      Recursing : Token_ID_Set := (Descriptor.First_Nonterminal .. 
Descriptor.Last_Nonterminal => False);
+
+      Last_Count : Integer := 0;
+      This_Count : Integer;
+   begin
+      Result.Set_First (Descriptor.First_Nonterminal);
+      Result.Set_Last (Descriptor.Last_Nonterminal);
+
+      loop
+         exit when (for all B of All_Set => B);
+         for P of Grammar loop
+            if not All_Set (P.LHS) then
+               Terminal_Sequence (Grammar, Descriptor, Result, All_Set, 
Recursing, P.LHS);
+            end if;
+         end loop;
+         This_Count := Count (All_Set);
+         if This_Count = Last_Count then
+            raise Grammar_Error with "nonterminals have no minimum terminal 
sequence: " &
+              Image (All_Set, Descriptor, Inverted => True);
+         end if;
+         Last_Count := This_Count;
+      end loop;
+   end Compute_Minimal_Terminal_Sequences;
+
+   function Minimal_Terminal_First
+     (Grammar    : in     WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor : in     WisiToken.Descriptor)
+     return Token_Array_Token_ID
+   is
+      use all type Ada.Containers.Count_Type;
+      Minimal_Terminal_Sequences : Token_Sequence_Arrays.Vector;
+   begin
+      Compute_Minimal_Terminal_Sequences (Grammar, Descriptor, 
Minimal_Terminal_Sequences);
+
+      return Result : Token_Array_Token_ID (Descriptor.First_Nonterminal .. 
Descriptor.Last_Nonterminal) do
+         for ID in Result'Range loop
+            if Minimal_Terminal_Sequences (ID).Length = 0 then
+               Result (ID) := Invalid_Token_ID;
+            else
+               Result (ID) := Minimal_Terminal_Sequences 
(ID)(Minimal_Terminal_Sequences (ID).First);
+            end if;
+         end loop;
+      end return;
+   end Minimal_Terminal_First;
+
+   procedure Set_Minimal_Complete_Actions
+     (State                  : in out Parse_State;
+      Kernel                 : in     LR1_Items.Item_Set;
+      Minimal_Terminal_First : in     Token_Array_Token_ID;
+      Ancestors              : in     Token_Array_Token_Set;
+      Descriptor             : in     WisiToken.Descriptor;
+      Grammar                : in     WisiToken.Productions.Prod_Arrays.Vector)
+   is
+      use all type Ada.Containers.Count_Type;
+      use LR1_Items.Item_Lists;
+      use Token_ID_Arrays;
+
+      subtype Terminals is Token_ID range Descriptor.First_Terminal .. 
Descriptor.Last_Terminal;
+
+      Del  : LR1_Items.Item_Lists.Cursor;
+
+      procedure Delete_Same_Ancestor (List : in out LR1_Items.Item_Lists.List; 
Cur : in LR1_Items.Item_Lists.Cursor)
+      is
+         Cur_LHS : constant Token_ID := Element (Cur).Prod.LHS;
+
+         J : LR1_Items.Item_Lists.Cursor := List.First;
+      begin
+         loop
+            exit when not Has_Element (J);
+            if J = Cur then
+               Next (J);
+            else
+               declare
+                  Item : LR1_Items.Item renames Constant_Ref (J);
+               begin
+                  if Cur_LHS = Item.Prod.LHS or else Ancestors (Cur_LHS, 
Item.Prod.LHS) then
+                     Del := J;
+                     Next (J);
+                     List.Delete (Del);
+                  else
+                     Next (J);
+                  end if;
+               end;
+            end if;
+         end loop;
+      end Delete_Same_Ancestor;
+
+      procedure Append_No_Dup (Item : in Minimal_Action)
+      is begin
+         if not State.Minimal_Complete_Actions.Contains (Item) then
+            State.Minimal_Complete_Actions.Insert (Item);
+         end if;
+      end Append_No_Dup;
+
+      function Find_Action (List : in Action_Node_Ptr; ID : in Token_ID) 
return Minimal_Action
+      is
+         Node : Action_Node_Ptr := List;
+      begin
+         loop
+            if Node.Symbol = ID then
+               case Node.Action.Item.Verb is
+               when Shift =>
+                  return (Shift, ID, Node.Action.Item.State);
+               when Reduce =>
+                  --  Item.Dot is a nonterm that starts with a nullable 
nonterm; reduce
+                  --  to that first.
+                  return (Reduce, Node.Action.Item.Production.LHS, 0);
+               when Accept_It | WisiToken.Parse.LR.Error =>
+                  raise SAL.Programmer_Error;
+               end case;
+            end if;
+            Node := Node.Next;
+            exit when Node = null;
+         end loop;
+         raise SAL.Programmer_Error;
+      end Find_Action;
+
+      Working_Set : LR1_Items.Item_Lists.List := Kernel.Set;
+      I           : LR1_Items.Item_Lists.Cursor;
+
+   begin
+      --  First find items to delete.
+      --
+      --  This algorithm will return an empty Minimal_Complete_Actions in
+      --  the top level accept state.
+
+      I := Working_Set.First;
+      loop
+         exit when not Has_Element (I);
+         declare
+            Item : LR1_Items.Item renames Constant_Ref (I);
+            Prod : WisiToken.Productions.Instance renames Grammar 
(Item.Prod.LHS);
+         begin
+            if not Has_Element (Item.Dot) then
+               --  Completing this item also completes items that share an 
ancestor.
+               Delete_Same_Ancestor (Working_Set, I);
+               Next (I);
+
+            elsif To_Index (Item.Dot) = 2 and then
+              Prod.RHSs (Item.Prod.RHS).Tokens (1) = Item.Prod.LHS
+            then
+               --  Item is left-recursive; it can't be minimal.
+               Del := I;
+               Next (I);
+               Working_Set.Delete (Del);
+            else
+               Next (I);
+            end if;
+         end;
+      end loop;
+
+      for Item of Working_Set loop
+         if not Has_Element (Item.Dot) then
+            --  Item has no next terminal. Include a reduce action; the
+            --  Minimal_Terminal_First for the resulting state will be used.
+            Append_No_Dup
+              ((Reduce, Item.Prod.LHS,
+                Token_Count => Grammar (Item.Prod.LHS).RHSs 
(Item.Prod.RHS).Tokens.Length));
+         else
+            declare
+               ID : constant Token_ID := Element (Item.Dot);
+            begin
+               if ID /= Descriptor.EOF_ID then
+
+                  if ID in Terminals then
+                     Append_No_Dup (Find_Action (State.Action_List, ID));
+
+                  else
+                     if Minimal_Terminal_First (ID) = Invalid_Token_ID then
+                        --  Item.Dot is a nullable nonterm, include a reduce 
of the null
+                        --  nonterm, rather than a shift of the following 
terminal; recover
+                        --  must do the reduce first.
+                        Append_No_Dup ((Reduce, ID, Token_Count => 0));
+
+                     else
+                        Append_No_Dup (Find_Action (State.Action_List, 
Minimal_Terminal_First (ID)));
+                     end if;
+                  end if;
+               end if;
+            end;
+         end if;
+      end loop;
+   end Set_Minimal_Complete_Actions;
+
+   ----------
+   --  Parse table output
+
+   procedure Put_Text_Rep
+     (Table        : in Parse_Table;
+      File_Name    : in String;
+      Action_Names : in Names_Array_Array;
+      Check_Names  : in Names_Array_Array)
+   is
+      use Ada.Text_IO;
+      File : File_Type;
+   begin
+      --  Only space, semicolon, newline delimit object values. Bounds of
+      --  arrays output before each array, unless known from discriminants.
+      --  End of lists indicated by semicolon. Action, Check subprograms are
+      --  represented by True if present, False if not; look up the actual
+      --  address Table.Productions.
+
+      Create (File, Out_File, File_Name);
+
+      --  First the discriminants
+      Put (File,
+           Trimmed_Image (Table.State_First) & State_Index'Image 
(Table.State_Last) &
+             Token_ID'Image (Table.First_Terminal) & Token_ID'Image 
(Table.Last_Terminal) &
+             Token_ID'Image (Table.First_Nonterminal) & Token_ID'Image 
(Table.Last_Nonterminal));
+      New_Line (File);
+
+      for State of Table.States loop
+         Put (File, Integer'Image (State.Productions.First_Index));
+         Put (File, Integer'Image (State.Productions.Last_Index));
+         for Prod of State.Productions loop
+            Put (File, Token_ID'Image (Prod.LHS) & Integer'Image (Prod.RHS));
+         end loop;
+         New_Line (File);
+
+         declare
+            Node_I : Action_Node_Ptr := State.Action_List;
+         begin
+            loop
+               exit when Node_I = null;
+               --  Action first, so we know if Symbol is present (not when 
Error)
+               declare
+                  Node_J     : Parse_Action_Node_Ptr := Node_I.Action;
+                  Put_Symbol : Boolean               := True;
+               begin
+                  loop
+                     Put (File, Parse_Action_Verbs'Image (Node_J.Item.Verb));
+
+                     case Node_J.Item.Verb is
+                     when Shift =>
+                        Put (File, State_Index'Image (Node_J.Item.State));
+
+                     when Reduce | Accept_It =>
+                        Put (File, Token_ID'Image (Node_J.Item.Production.LHS) 
&
+                               Integer'Image (Node_J.Item.Production.RHS));
+
+                        if Action_Names (Node_J.Item.Production.LHS) /= null 
and then
+                          Action_Names 
(Node_J.Item.Production.LHS)(Node_J.Item.Production.RHS) /= null
+                        then
+                           Put (File, " true");
+                        else
+                           Put (File, " false");
+                        end if;
+                        if Check_Names (Node_J.Item.Production.LHS) /= null 
and then
+                          Check_Names 
(Node_J.Item.Production.LHS)(Node_J.Item.Production.RHS) /= null
+                        then
+                           Put (File, " true");
+                        else
+                           Put (File, " false");
+                        end if;
+
+                        Put (File, Ada.Containers.Count_Type'Image 
(Node_J.Item.Token_Count));
+
+                     when Parse.LR.Error =>
+                        --  Error action terminates the action list
+                        Put_Symbol := False;
+                     end case;
+
+                     Node_J := Node_J.Next;
+                     exit when Node_J = null;
+                     Put (File, ' ');
+                  end loop;
+                  Put (File, ';');
+                  if Put_Symbol then
+                     Put (File, Token_ID'Image (Node_I.Symbol));
+                  end if;
+               end;
+               New_Line (File);
+
+               Node_I := Node_I.Next;
+            end loop;
+         end;
+
+         declare
+            Node_I : Goto_Node_Ptr := State.Goto_List;
+         begin
+            loop
+               exit when Node_I = null;
+               Put (File, Token_ID'Image (Symbol (Node_I)) & State_Index'Image 
(Parse.LR.State (Node_I)));
+               Node_I := Next (Node_I);
+            end loop;
+            Put (File, ';');
+            New_Line (File);
+         end;
+
+         for Action of State.Minimal_Complete_Actions loop
+            Put (File, ' ' & Minimal_Verbs'Image (Action.Verb));
+            case Action.Verb is
+            when Shift =>
+               Put (File, Token_ID'Image (Action.ID) & State_Index'Image 
(Action.State));
+            when Reduce =>
+               Put (File, Token_ID'Image (Action.Nonterm) & 
Ada.Containers.Count_Type'Image (Action.Token_Count));
+            end case;
+         end loop;
+         Put (File, ';');
+         New_Line (File);
+      end loop;
+      Close (File);
+   end Put_Text_Rep;
+
+   procedure Put (Item : in Parse_Action_Rec; Descriptor : in 
WisiToken.Descriptor)
+   is
+      use Ada.Containers;
+      use Ada.Text_IO;
+   begin
+      case Item.Verb is
+      when Shift =>
+         Put ("shift and goto state" & State_Index'Image (Item.State));
+
+      when Reduce =>
+         Put
+           ("reduce" & Count_Type'Image (Item.Token_Count) & " tokens to " &
+              Image (Item.Production.LHS, Descriptor));
+      when Accept_It =>
+         Put ("accept it");
+      when Parse.LR.Error =>
+         Put ("ERROR");
+      end case;
+   end Put;
+
+   procedure Put (Item : in McKenzie_Param_Type; Descriptor : in 
WisiToken.Descriptor)
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line ("(Insert =>");
+      for I in Item.Insert'Range loop
+         Put (" " & Padded_Image (I, Descriptor) & " =>" & Natural'Image 
(Item.Insert (I)));
+         if I = Item.Insert'Last then
+            Put_Line (")");
+         else
+            Put_Line (",");
+         end if;
+      end loop;
+      Put_Line ("(Delete =>");
+      for I in Item.Delete'Range loop
+         Put (" " & Padded_Image (I, Descriptor) & " =>" & Natural'Image 
(Item.Delete (I)));
+         if I = Item.Delete'Last then
+            Put_Line (")");
+         else
+            Put_Line (",");
+         end if;
+      end loop;
+      Put_Line ("(Push_Back =>");
+      for I in Item.Delete'Range loop
+         Put (" " & Padded_Image (I, Descriptor) & " =>" & Natural'Image 
(Item.Delete (I)));
+         if I = Item.Delete'Last then
+            Put_Line (")");
+         else
+            Put_Line (",");
+         end if;
+      end loop;
+      Put_Line ("Ignore_Check_Fail =>" & Integer'Image 
(Item.Ignore_Check_Fail));
+      Put_Line ("Task_Count        =>" & 
System.Multiprocessors.CPU_Range'Image (Item.Task_Count));
+      Put_Line ("Cost_Limit        =>" & Integer'Image (Item.Cost_Limit));
+      Put_Line ("Check_Limit       =>" & Token_Index'Image (Item.Check_Limit));
+      Put_Line ("Check_Delta_Limit =>" & Integer'Image 
(Item.Check_Delta_Limit));
+      Put_Line ("Enqueue_Limit     =>" & Integer'Image (Item.Enqueue_Limit));
+   end Put;
+
+   procedure Put (Descriptor : in WisiToken.Descriptor; Item : in 
Parse_Action_Rec)
+   is
+      use Ada.Containers;
+      use Ada.Text_IO;
+   begin
+      case Item.Verb is
+      when Shift =>
+         Put ("shift and goto state" & State_Index'Image (Item.State));
+      when Reduce =>
+         Put
+           ("reduce" & Count_Type'Image (Item.Token_Count) & " tokens to " &
+              Image (Item.Production.LHS, Descriptor));
+         Put (" " & Trimmed_Image (Item.Production));
+      when Accept_It =>
+         Put ("accept it");
+         Put (" " & Trimmed_Image (Item.Production));
+      when Parse.LR.Error =>
+         Put ("ERROR");
+      end case;
+   end Put;
+
+   procedure Put (Descriptor : in WisiToken.Descriptor; Action : in 
Parse_Action_Node_Ptr)
+   is
+      use Ada.Text_IO;
+      Ptr    : Parse_Action_Node_Ptr   := Action;
+      Column : constant Positive_Count := Col;
+   begin
+      loop
+         Put (Descriptor, Ptr.Item);
+         Ptr := Ptr.Next;
+         exit when Ptr = null;
+         Put_Line (",");
+         Set_Col (Column);
+      end loop;
+   end Put;
+
+   procedure Put (Descriptor : in WisiToken.Descriptor; State : in Parse_State)
+   is
+      use all type Ada.Containers.Count_Type;
+      use Ada.Text_IO;
+      use Ada.Strings.Fixed;
+      Action_Ptr : Action_Node_Ptr := State.Action_List;
+      Goto_Ptr   : Goto_Node_Ptr   := State.Goto_List;
+      Need_Comma : Boolean := False;
+   begin
+      while Action_Ptr /= null loop
+         Put ("   ");
+         if Action_Ptr.Next = null then
+            Put ("default" & (Descriptor.Image_Width - 7) * ' ' & " => ");
+
+         elsif Action_Ptr.Action.Item.Verb /= Parse.LR.Error then
+            Put (Image (Action_Ptr.Symbol, Descriptor) &
+                   (Descriptor.Image_Width - Image (Action_Ptr.Symbol, 
Descriptor)'Length) * ' '
+                   & " => ");
+         end if;
+         Put (Descriptor, Action_Ptr.Action);
+         New_Line;
+         Action_Ptr := Action_Ptr.Next;
+      end loop;
+
+      if Goto_Ptr /= null then
+         New_Line;
+      end if;
+
+      while Goto_Ptr /= null loop
+         Put_Line
+           ("   " & Image (Symbol (Goto_Ptr), Descriptor) &
+              (Descriptor.Image_Width - Image (Symbol (Goto_Ptr), 
Descriptor)'Length) * ' ' &
+              " goto state" & State_Index'Image (Parse.LR.State (Goto_Ptr)));
+         Goto_Ptr := Next (Goto_Ptr);
+      end loop;
+
+      if State.Minimal_Complete_Actions.Length > 0 then
+         New_Line;
+         Put ("   Minimal_Complete_Actions => (");
+         for Action of State.Minimal_Complete_Actions loop
+            if Need_Comma then
+               Put (", ");
+            else
+               Need_Comma := True;
+            end if;
+            case Action.Verb is
+            when Shift =>
+               Put (Image (Action.ID, Descriptor));
+            when Reduce =>
+               Put (Image (Action.Nonterm, Descriptor));
+            end case;
+         end loop;
+         Put_Line (")");
+      end if;
+   end Put;
+
+   procedure Put_Parse_Table
+     (Table      : in Parse_Table_Ptr;
+      Title      : in String;
+      Grammar    : in WisiToken.Productions.Prod_Arrays.Vector;
+      Kernels    : in LR1_Items.Item_Set_List;
+      Ancestors  : in Token_Array_Token_Set;
+      Conflicts  : in Conflict_Lists.List;
+      Descriptor : in WisiToken.Descriptor)
+   is
+      use all type Ada.Containers.Count_Type;
+      use Ada.Text_IO;
+      Minimal_Complete_Multiple_Reduce : State_Index_Arrays.Vector;
+   begin
+      Put_Line ("Tokens:");
+      WisiToken.Put_Tokens (Descriptor);
+
+      New_Line;
+      Put_Line ("Productions:");
+      WisiToken.Productions.Put (Grammar, Descriptor);
+
+      if Table.McKenzie_Param.Cost_Limit /= Default_McKenzie_Param.Cost_Limit 
or
+          Table.McKenzie_Param.Check_Limit /= 
Default_McKenzie_Param.Check_Limit or
+          Table.McKenzie_Param.Check_Delta_Limit /= 
Default_McKenzie_Param.Check_Delta_Limit or
+          Table.McKenzie_Param.Enqueue_Limit /= 
Default_McKenzie_Param.Enqueue_Limit
+      then
+         New_Line;
+         Put_Line ("McKenzie:");
+         Put (Table.McKenzie_Param, Descriptor);
+      end if;
+
+      New_Line;
+      Put_Line ("Ancestors:");
+      for ID in Ancestors'Range (1) loop
+         if Any (Ancestors, ID) then
+            Put_Line (Image (ID, Descriptor) & " => " & Image (Slice 
(Ancestors, ID), Descriptor));
+         end if;
+      end loop;
+
+      New_Line;
+      Put_Line (Title & " Parse Table:");
+
+      for State_Index in Table.States'Range loop
+         LR1_Items.Put (Grammar, Descriptor, Kernels (State_Index), 
Kernel_Only => True, Show_Lookaheads => True);
+         New_Line;
+         Put (Descriptor, Table.States (State_Index));
+
+         if Count_Reduce (Table.States (State_Index).Minimal_Complete_Actions) 
> 1 then
+            Minimal_Complete_Multiple_Reduce.Append (State_Index);
+         end if;
+
+         if State_Index /= Table.States'Last then
+            New_Line;
+         end if;
+      end loop;
+
+      if Minimal_Complete_Multiple_Reduce.Length + Conflicts.Length > 0 then
+         New_Line;
+      end if;
+
+      if Minimal_Complete_Multiple_Reduce.Length > 0 then
+         Indent_Wrap
+           ("States with multiple reduce in Minimal_Complete_Action: " & Image 
(Minimal_Complete_Multiple_Reduce));
+      end if;
+
+      if Conflicts.Length > 0 then
+         declare
+            use Ada.Strings.Unbounded;
+            Last_State : Unknown_State_Index := Unknown_State;
+            Line : Unbounded_String := +"States with conflicts:";
+         begin
+            for Conflict of Conflicts loop
+               if Conflict.State_Index /= Last_State then
+                  Append (Line, State_Index'Image (Conflict.State_Index));
+                  Last_State := Conflict.State_Index;
+               end if;
+            end loop;
+            Indent_Wrap (-Line);
+         end;
+      end if;
+   end Put_Parse_Table;
+
+end WisiToken.Generate.LR;
diff --git a/wisitoken-generate-lr.ads b/wisitoken-generate-lr.ads
new file mode 100644
index 0000000..6000dab
--- /dev/null
+++ b/wisitoken-generate-lr.ads
@@ -0,0 +1,176 @@
+--  Abstract :
+--
+--  Common utilities for LR parser table generators.
+--
+--  Copyright (C) 2017, 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+with Ada.Containers.Doubly_Linked_Lists;
+with WisiToken.Generate.LR1_Items;
+with WisiToken.Parse.LR;
+with WisiToken.Productions;
+package WisiToken.Generate.LR is
+   use WisiToken.Parse.LR;
+
+   subtype Conflict_Parse_Actions is Parse_Action_Verbs range Shift .. 
Accept_It;
+   type Conflict is record
+      --  A typical conflict is:
+      --
+      --  SHIFT/REDUCE in state: 11 on token IS
+      --
+      --  State numbers change with minor changes in the grammar, so we
+      --  attempt to identify the state by the LHS of the two productions
+      --  involved; this is _not_ guarranteed to be unique, but is good
+      --  enough for our purposes. We also store the state number for
+      --  generated conflicts (not for known conflicts from the grammar
+      --  definition file), for debugging.
+      Action_A    : Conflict_Parse_Actions;
+      LHS_A       : Token_ID;
+      Action_B    : Conflict_Parse_Actions;
+      LHS_B       : Token_ID;
+      State_Index : Unknown_State_Index;
+      On          : Token_ID;
+   end record;
+
+   package Conflict_Lists is new Ada.Containers.Doubly_Linked_Lists (Conflict);
+
+   procedure Put
+     (Item       : in Conflict_Lists.List;
+      File       : in Ada.Text_IO.File_Type;
+      Descriptor : in WisiToken.Descriptor);
+
+   procedure Add_Action
+     (Symbol               : in     Token_ID;
+      Action               : in     Parse_Action_Rec;
+      Action_List          : in out Action_Node_Ptr;
+      Closure              : in     LR1_Items.Item_Set;
+      Grammar              : in     WisiToken.Productions.Prod_Arrays.Vector;
+      Has_Empty_Production : in     Token_ID_Set;
+      First_Nonterm_Set    : in     Token_Array_Token_Set;
+      Conflicts            : in out Conflict_Lists.List;
+      Descriptor           : in     WisiToken.Descriptor);
+   --  Add (Symbol, Action) to Action_List; check for conflicts
+   --
+   --  Closure .. Conflicts are for conflict reporting
+
+   procedure Add_Actions
+     (Closure              : in     LR1_Items.Item_Set;
+      Table                : in out Parse_Table;
+      Grammar              : in     WisiToken.Productions.Prod_Arrays.Vector;
+      Has_Empty_Production : in     Token_ID_Set;
+      First_Nonterm_Set    : in     Token_Array_Token_Set;
+      Conflicts            : in out Conflict_Lists.List;
+      Descriptor           : in     WisiToken.Descriptor);
+   --  Add actions for Closure to Table. Has_Empty_Production, First,
+   --  Conflicts used for conflict reporting.
+
+   procedure Add_Lookahead_Actions
+     (Item                 : in     LR1_Items.Item;
+      Action_List          : in out Action_Node_Ptr;
+      Grammar              : in     WisiToken.Productions.Prod_Arrays.Vector;
+      Has_Empty_Production : in     Token_ID_Set;
+      First_Nonterm_Set    : in     Token_Array_Token_Set;
+      Conflicts            : in out Conflict_Lists.List;
+      Closure              : in     LR1_Items.Item_Set;
+      Descriptor           : in     WisiToken.Descriptor);
+   --  Add actions for Item.Lookaheads to Action_List
+   --  Closure must be from the item set containing Item.
+   --  Has_Empty_Production .. Closure used for conflict reporting.
+
+   procedure Delete_Known
+     (Conflicts       : in out Conflict_Lists.List;
+      Known_Conflicts : in out Conflict_Lists.List);
+   --  Delete Known_Conflicts from Conflicts.
+
+   function Find
+     (Symbol      : in Token_ID;
+      Action_List : in Action_Node_Ptr)
+     return Action_Node_Ptr;
+
+   function Find
+     (Closure              : in LR1_Items.Item_Set;
+      Action               : in Parse_Action_Rec;
+      Lookahead            : in Token_ID;
+      Grammar              : in WisiToken.Productions.Prod_Arrays.Vector;
+      Has_Empty_Production : in Token_ID_Set;
+      First                : in Token_Array_Token_Set;
+      Descriptor           : in WisiToken.Descriptor)
+     return Token_ID;
+   --  Return the LHS of a production in kernel of Closure, for an Action
+   --  conflict on Lookahead; for naming a Conflict object.
+
+   function Image (Item : in Conflict; Descriptor : in WisiToken.Descriptor) 
return String;
+
+   function Is_Present (Item : in Conflict; Conflicts : in 
Conflict_Lists.List) return Boolean;
+
+   function Match (Known : in Conflict; Item : in 
Conflict_Lists.Constant_Reference_Type) return Boolean;
+
+   procedure Compute_Minimal_Terminal_Sequences
+     (Grammar    : in     WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor : in     WisiToken.Descriptor;
+      Result     : in out Token_Sequence_Arrays.Vector);
+   --  For each production in Grammar, compute the minimal sequence of
+   --  terminals that will complete it. Result is an empty sequence if
+   --  the production may be empty.
+
+   function Minimal_Terminal_First
+     (Grammar    : in     WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor : in     WisiToken.Descriptor)
+      return Token_Array_Token_ID;
+   --  For each nonterminal in Grammar, return the first of the minimal
+   --  sequence of terminals that will complete it; Invalid_Token_ID if
+   --  the minimal sequence is empty.
+
+   procedure Set_Minimal_Complete_Actions
+     (State                  : in out Parse_State;
+      Kernel                 : in     LR1_Items.Item_Set;
+      Minimal_Terminal_First : in     Token_Array_Token_ID;
+      Ancestors              : in     Token_Array_Token_Set;
+      Descriptor             : in     WisiToken.Descriptor;
+      Grammar                : in     
WisiToken.Productions.Prod_Arrays.Vector);
+   --  Set State.Minimal_Terminal_First to the set of terminals that will
+   --  most quickly complete the productions in Kernel (which must be for
+   --  State). Useful in error correction when we know the next actual
+   --  terminal is a block ending or statement start.
+
+   ----------
+   --  Parse table output
+
+   procedure Put_Text_Rep
+     (Table        : in Parse_Table;
+      File_Name    : in String;
+      Action_Names : in Names_Array_Array;
+      Check_Names  : in Names_Array_Array);
+   --  Write machine-readable text format of Table.States to a file
+   --  File_Name, to be read by the parser executable at startup, using
+   --  WisiToken.Parse.LR.Get_Text_Rep.
+
+   procedure Put (Item : in Parse_Action_Rec; Descriptor : in 
WisiToken.Descriptor);
+   procedure Put (Item : in McKenzie_Param_Type; Descriptor : in 
WisiToken.Descriptor);
+   procedure Put (Descriptor : in WisiToken.Descriptor; Item : in 
Parse_Action_Rec);
+   procedure Put (Descriptor : in WisiToken.Descriptor; Action : in 
Parse_Action_Node_Ptr);
+   procedure Put (Descriptor : in WisiToken.Descriptor; State : in 
Parse_State);
+   --  Put Item to Ada.Text_IO.Current_Output in parse table format.
+
+   procedure Put_Parse_Table
+     (Table      : in Parse_Table_Ptr;
+      Title      : in String;
+      Grammar    : in WisiToken.Productions.Prod_Arrays.Vector;
+      Kernels    : in LR1_Items.Item_Set_List;
+      Ancestors  : in Token_Array_Token_Set;
+      Conflicts  : in Conflict_Lists.List;
+      Descriptor : in WisiToken.Descriptor);
+
+end WisiToken.Generate.LR;
diff --git a/wisitoken-generate-lr1_items.adb b/wisitoken-generate-lr1_items.adb
new file mode 100644
index 0000000..a62a4af
--- /dev/null
+++ b/wisitoken-generate-lr1_items.adb
@@ -0,0 +1,580 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2002, 2003, 2008, 2009, 2012 - 2015, 2017, 2018 Stephe Leake
+--  Copyright (C) 1999 Ted Dennison
+--
+--  This file is part of the WisiToken package.
+--
+--  The WisiToken package 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, or
+--  (at your option) any later version. The WisiToken package 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 distributed with the WisiToken package;
+--  see file GPL.txt. If not, write to the Free Software Foundation,
+--  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+--
+--  As a special exception, if other files instantiate generics from
+--  this unit, or you link this unit with other files to produce an
+--  executable, this unit does not by itself cause the resulting
+--  executable to be covered by the GNU General Public License. This
+--  exception does not however invalidate any other reasons why the
+--  executable file might be covered by the GNU Public License.
+
+pragma License (Modified_GPL);
+
+with Ada.Text_IO;
+with Ada.Strings.Unbounded;
+package body WisiToken.Generate.LR1_Items is
+   use type Ada.Strings.Unbounded.Unbounded_String;
+
+   ----------
+   --  body subprograms
+
+   function Get_Dot_IDs (Set : in Item_Lists.List; Descriptor : in 
WisiToken.Descriptor) return Token_ID_Arrays.Vector
+   is
+      use all type Token_ID_Arrays.Cursor;
+      use Item_Lists;
+      IDs : Token_ID_Set (Descriptor.First_Terminal .. 
Descriptor.Last_Nonterminal) := (others => False);
+   begin
+      for Item of Set loop
+         if Item.Dot /= Token_ID_Arrays.No_Element then
+            if Element (Item.Dot) /= Descriptor.EOF_ID then
+               IDs (Element (Item.Dot)) := True;
+            end if;
+         end if;
+      end loop;
+      return To_Array (IDs);
+   end Get_Dot_IDs;
+
+   function Merge
+     (Prod         : in     Production_ID;
+      Dot          : in     Token_ID_Arrays.Cursor;
+      Lookaheads   : in     Lookahead;
+      Existing_Set : in out Item_Set)
+     return Boolean
+   is
+      --  Merge item into Existing_Set. Return True if Existing_Set
+      --  is modified.
+
+      use Item_Lists;
+
+      Found    : constant Item_Lists.Cursor := Find (Prod, Dot, Existing_Set);
+      Modified : Boolean                    := False;
+   begin
+      if Found = No_Element then
+         Existing_Set.Set.Insert ((Prod, Dot, new Token_ID_Set'(Lookaheads)));
+
+         Modified := True;
+      else
+         Include (Ref (Found), Lookaheads, Modified);
+      end if;
+
+      return Modified;
+   end Merge;
+
+   ----------
+   --  Public subprograms, declaration order
+
+   function To_Lookahead (Item : in Token_ID; Descriptor : in 
WisiToken.Descriptor) return Lookahead
+   is begin
+      return Result : Token_ID_Set := (Descriptor.First_Terminal .. 
Descriptor.Last_Lookahead => False) do
+         Result (Item) := True;
+      end return;
+   end To_Lookahead;
+
+   function Lookahead_Image (Item : in Lookahead; Descriptor : in 
WisiToken.Descriptor) return String
+   is
+      use Ada.Strings.Unbounded;
+      Result : Unbounded_String := Null_Unbounded_String;
+   begin
+      for I in Item'Range loop
+         if Item (I) then
+            if Length (Result) > 0 then
+               Result := Result & "/";
+            end if;
+            Result := Result & Image (I, Descriptor);
+         end if;
+      end loop;
+      return To_String (Result);
+   end Lookahead_Image;
+
+   function Item_Compare (Left, Right : in Item) return SAL.Compare_Result
+   is begin
+      if Left.Prod.LHS > Right.Prod.LHS then
+         return SAL.Greater;
+      elsif Left.Prod.LHS < Right.Prod.LHS then
+         return SAL.Less;
+
+      elsif Left.Prod.RHS > Right.Prod.RHS then
+         return SAL.Greater;
+      elsif Left.Prod.RHS < Right.Prod.RHS then
+         return SAL.Less;
+
+      else
+         declare
+            Left_Index : Integer renames Token_ID_Arrays.To_Index (Left.Dot);
+            Right_Index : Integer renames Token_ID_Arrays.To_Index (Right.Dot);
+         begin
+            if Left_Index > Right_Index then
+               return SAL.Greater;
+            elsif Left_Index < Right_Index then
+               return SAL.Less;
+            else
+               return SAL.Equal;
+            end if;
+         end;
+      end if;
+   end Item_Compare;
+
+   procedure Include
+     (Item  : in out LR1_Items.Item;
+      Value : in     Lookahead;
+      Added :    out Boolean)
+   is begin
+      Added := False;
+
+      for I in Item.Lookaheads'Range loop
+         if Value (I) then
+            Added := Added or not Item.Lookaheads (I);
+            Item.Lookaheads (I) := True;
+         end if;
+      end loop;
+   end Include;
+
+   procedure Include
+     (Item       : in out LR1_Items.Item;
+      Value      : in     Lookahead;
+      Descriptor : in     WisiToken.Descriptor)
+   is
+      Added : Boolean;
+      pragma Unreferenced (Added);
+   begin
+      Include (Item, Value, Added, Descriptor);
+   end Include;
+
+   procedure Include
+     (Item       : in out LR1_Items.Item;
+      Value      : in     Lookahead;
+      Added      :    out Boolean;
+      Descriptor : in     WisiToken.Descriptor)
+   is begin
+      Added := False;
+
+      for I in Item.Lookaheads'Range loop
+         if I = Descriptor.Last_Lookahead then
+            null;
+         else
+            if Value (I) then
+               Added := Added or not Item.Lookaheads (I);
+               Item.Lookaheads (I) := True;
+            end if;
+         end if;
+      end loop;
+   end Include;
+
+   function Filter
+     (Set        : in     Item_Set;
+      Grammar    : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor : in     WisiToken.Descriptor;
+      Include    : access function
+        (Grammar    : in WisiToken.Productions.Prod_Arrays.Vector;
+         Descriptor : in WisiToken.Descriptor;
+         Item       : in LR1_Items.Item)
+        return Boolean)
+     return Item_Set
+   is begin
+      return Result : Item_Set := (Set => <>, Goto_List => Set.Goto_List, 
Dot_IDs => Set.Dot_IDs, State => Set.State)
+      do
+         for Item of Set.Set loop
+            if Include (Grammar, Descriptor, Item) then
+               Result.Set.Insert (Item);
+            end if;
+         end loop;
+      end return;
+   end Filter;
+
+   function In_Kernel
+     (Grammar    : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor : in WisiToken.Descriptor;
+      Item       : in LR1_Items.Item)
+     return Boolean
+   is
+      use Token_ID_Arrays;
+      Prod : WisiToken.Productions.Instance renames Grammar (Item.Prod.LHS);
+      RHS  : WisiToken.Productions.Right_Hand_Side renames Prod.RHSs 
(Item.Prod.RHS);
+   begin
+      return
+        No_Element /= RHS.Tokens.First and
+        (Item.Dot = No_Element or else
+           ((Prod.LHS = Descriptor.Accept_ID and
+               Item.Dot = RHS.Tokens.First)
+              -- Start symbol production with dot before first token.
+              or
+              Item.Dot /= RHS.Tokens.First));
+   end In_Kernel;
+
+   function Find
+     (Item : in LR1_Items.Item;
+      Set  : in Item_Set)
+     return Item_Lists.Cursor
+   is begin
+      return Find (Item.Prod, Item.Dot, Set);
+   end Find;
+
+   function Find
+     (Prod  : in Production_ID;
+      Dot   : in Token_ID_Arrays.Cursor;
+      Right : in Item_Set)
+     return Item_Lists.Cursor
+   is begin
+      return Right.Set.Find ((Prod, Dot, null));
+   end Find;
+
+   function Find
+     (Prod       : in Production_ID;
+      Dot        : in Token_ID_Arrays.Cursor;
+      Right      : in Item_Set;
+      Lookaheads : in Lookahead)
+     return Item_Lists.Cursor
+   is
+      use Item_Lists;
+      Result : constant Cursor := Right.Set.Find ((Prod, Dot, null));
+   begin
+      --  Item_Equal does not consider lookaheads
+      if Result = No_Element then
+         return Result;
+      elsif Constant_Ref (Result).Lookaheads.all = Lookaheads then
+         return Result;
+      else
+         return No_Element;
+      end if;
+   end Find;
+
+   function To_Item_Set_Tree_Key
+     (Item_Set           : in LR1_Items.Item_Set;
+      Include_Lookaheads : in Boolean)
+     return Item_Set_Tree_Key
+   is
+      use Interfaces;
+      use Item_Lists;
+      Cur : Item_Lists.Cursor := Item_Set.Set.First;
+   begin
+      return Result : Item_Set_Tree_Key do
+         Result.Append (Integer_16 (Item_Set.Set.Length));
+         --  Int_Arrays."<" compares length, but only after everything else; we
+         --  want it to compare first, since it is most likely to be different.
+
+         loop
+            exit when Cur = No_Element;
+            declare
+               Item_1 : Item renames Item_Set.Set (Cur);
+            begin
+               Result.Append (Integer_16 (Item_1.Prod.LHS));
+               Result.Append (Integer_16 (Item_1.Prod.RHS));
+               Result.Append (Integer_16 (Token_ID_Arrays.To_Index 
(Item_1.Dot)));
+               if Include_Lookaheads then
+                  for ID in Item_1.Lookaheads'Range loop
+                     if Item_1.Lookaheads (ID) then
+                        Result.Append (Integer_16 (ID));
+                     end if;
+                  end loop;
+               end if;
+            end;
+            Next (Cur);
+         end loop;
+      end return;
+   end To_Item_Set_Tree_Key;
+
+   function Find
+     (New_Item_Set     : in Item_Set;
+      Item_Set_Tree    : in Item_Set_Trees.Tree;
+      Match_Lookaheads : in Boolean)
+     return Unknown_State_Index
+   is
+      use all type Item_Set_Trees.Cursor;
+
+      Tree_It    : constant Item_Set_Trees.Iterator := Item_Set_Trees.Iterate 
(Item_Set_Tree);
+      Key        : constant Item_Set_Tree_Key       := To_Item_Set_Tree_Key
+        (New_Item_Set, Include_Lookaheads => Match_Lookaheads);
+      Found_Tree : constant Item_Set_Trees.Cursor   := Tree_It.Find (Key);
+   begin
+      if Found_Tree = Item_Set_Trees.No_Element then
+         return Unknown_State;
+      else
+         return Item_Set_Tree.Constant_Ref (Found_Tree).State;
+      end if;
+   end Find;
+
+   procedure Add
+     (New_Item_Set       : in out Item_Set;
+      Item_Set_Vector    : in out Item_Set_List;
+      Item_Set_Tree      : in out Item_Set_Trees.Tree;
+      Descriptor         : in     WisiToken.Descriptor;
+      Include_Lookaheads : in     Boolean)
+   is
+      use Item_Set_Trees;
+      Key : constant Item_Set_Tree_Key := To_Item_Set_Tree_Key (New_Item_Set, 
Include_Lookaheads);
+   begin
+      New_Item_Set.Dot_IDs := Get_Dot_IDs (New_Item_Set.Set, Descriptor);
+      Item_Set_Vector.Append (New_Item_Set);
+      Item_Set_Tree.Insert ((Key, New_Item_Set.State));
+   end Add;
+
+   function Is_In
+     (Item      : in Goto_Item;
+      Goto_List : in Goto_Item_Lists.List)
+     return Boolean
+   is begin
+      for List_Item of Goto_List loop
+         if List_Item = Item then
+            return True;
+         end if;
+      end loop;
+
+      return False;
+   end Is_In;
+
+   function Goto_State
+     (From   : in Item_Set;
+      Symbol : in Token_ID)
+     return Unknown_State_Index
+   is begin
+      for Item of From.Goto_List loop
+         if Item.Symbol = Symbol then
+            return Item.State;
+         end if;
+      end loop;
+
+      return Unknown_State;
+   end Goto_State;
+
+   function Closure
+     (Set                     : in Item_Set;
+      Has_Empty_Production    : in Token_ID_Set;
+      First_Terminal_Sequence : in Token_Sequence_Arrays.Vector;
+      Grammar                 : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor              : in WisiToken.Descriptor)
+     return Item_Set
+   is
+      use all type Item_Lists.Cursor;
+      use Token_ID_Arrays;
+
+      --  [dragon] algorithm 4.9 pg 231; figure 4.38 pg 232; procedure 
"closure"
+      --
+      --  Taken literally, the algorithm modifies its input; we make a
+      --  copy instead.
+
+      I : Item_Set; --  The result.
+
+      Item_I     : Item_Lists.Cursor; -- iterator 'for each item in I'
+      Added_Item : Boolean := False;  -- 'until no more items can be added'
+
+      Beta : Token_ID_Arrays.Cursor; -- into RHS.Tokens
+   begin
+      I := Set;
+
+      Item_I := I.Set.First;
+      loop
+         declare
+            Item : LR1_Items.Item renames I.Set (Item_I);
+         begin
+            --  An item has the structure [A -> alpha Dot B Beta, a].
+            --
+            --  If B is a nonterminal, find its productions and place
+            --  them in the set with lookaheads from FIRST(Beta a).
+            if Item.Dot /= No_Element and then
+              Element (Item.Dot) in Descriptor.First_Nonterminal .. 
Descriptor.Last_Nonterminal
+            then
+               declare
+                  Prod : WisiToken.Productions.Instance renames Grammar 
(Element (Item.Dot));
+               begin
+
+                  For_Each_RHS :
+                  for B in Prod.RHSs.First_Index .. Prod.RHSs.Last_Index loop
+                     declare
+                        RHS : WisiToken.Productions.Right_Hand_Side renames 
Prod.RHSs (B);
+                        P_ID : constant Production_ID := (Prod.LHS, B);
+                     begin
+                        --  Compute FIRST (<tail of right hand side> a); loop
+                        --  until find a terminal, a nonterminal that
+                        --  cannot be empty, or end of production, adding
+                        --  items on the way.
+
+                        Beta := Next (Item.Dot); -- tokens after nonterminal, 
possibly null
+
+                        First_Tail :
+                        loop
+                           if Beta = No_Element then
+                              --  Use FIRST (a); a = Item.Lookaheads.
+                              --  Lookaheads are all terminals, so
+                              --  FIRST (a) = a.
+                              Added_Item := Added_Item or
+                                Merge (P_ID, RHS.Tokens.First, 
Item.Lookaheads.all, I);
+                              exit First_Tail;
+
+                           elsif Element (Beta) in Descriptor.First_Terminal 
.. Descriptor.Last_Terminal then
+                              --  FIRST (Beta) = Beta
+                              Added_Item := Added_Item or Merge
+                                (P_ID, RHS.Tokens.First, To_Lookahead (Element 
(Beta), Descriptor), I);
+                              exit First_Tail;
+
+                           else
+                              --  Beta is a nonterminal; use FIRST (Beta)
+                              for Terminal of First_Terminal_Sequence (Element 
(Beta)) loop
+                                 Added_Item := Added_Item or
+                                   Merge (P_ID, RHS.Tokens.First, To_Lookahead 
(Terminal, Descriptor), I);
+                              end loop;
+
+                              if Has_Empty_Production (Element (Beta)) then
+                                 --  Process the next token in the tail, or "a"
+                                 Beta := Next (Beta);
+                              else
+                                 exit First_Tail;
+                              end if;
+                           end if;
+                        end loop First_Tail;
+                     end;
+                  end loop For_Each_RHS;
+               end;
+            end if; -- Dot is at non-terminal
+         end;
+
+         if Item_Lists.Next (Item_I) = Item_Lists.No_Element then
+            exit when not Added_Item;
+
+            Item_I := I.Set.First;
+            Added_Item := False;
+
+            if Trace_Generate > Extra then
+               Ada.Text_IO.Put_Line ("I:");
+               Put (Grammar, Descriptor, I);
+               Ada.Text_IO.New_Line;
+            end if;
+         else
+            Item_I := Item_Lists.Next (Item_I);
+         end if;
+      end loop;
+
+      return I;
+   end Closure;
+
+   function Productions (Set : in Item_Set) return Production_ID_Arrays.Vector
+   is begin
+      return Result : Production_ID_Arrays.Vector do
+         for Item of Set.Set loop
+            Result.Append (Item.Prod);
+         end loop;
+      end return;
+   end Productions;
+
+   function Image
+     (Grammar         : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor      : in WisiToken.Descriptor;
+      Item            : in LR1_Items.Item;
+      Show_Lookaheads : in Boolean)
+     return String
+   is
+      use Token_ID_Arrays;
+
+      I : Cursor;
+
+      Prod   : WisiToken.Productions.Instance renames Grammar (Item.Prod.LHS);
+      RHS    : WisiToken.Productions.Right_Hand_Side renames Prod.RHSs 
(Item.Prod.RHS);
+      Result : Ada.Strings.Unbounded.Unbounded_String :=
+        +Padded_Image (Item.Prod, Width => Prod_ID_Image_Width) & ":" & Image 
(Prod.LHS, Descriptor) & " <=";
+   begin
+      I := RHS.Tokens.First;
+
+      while I /= No_Element loop
+         if I = Item.Dot then
+            Result := Result & " ^ ";
+         else
+            Result := Result & " ";
+         end if;
+         Result := Result & Image (Element (I), Descriptor);
+         Next (I);
+      end loop;
+
+      if Item.Dot = No_Element then
+         Result := Result & " ^";
+      end if;
+
+      if Show_Lookaheads then
+         Result := Result & ", " & Lookahead_Image (Item.Lookaheads.all, 
Descriptor);
+      end if;
+
+      return Ada.Strings.Unbounded.To_String (Result);
+   end Image;
+
+   procedure Put
+     (Grammar         : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor      : in WisiToken.Descriptor;
+      Item            : in LR1_Items.Item;
+      Show_Lookaheads : in Boolean := True)
+   is begin
+      Ada.Text_IO.Put (Image (Grammar, Descriptor, Item, Show_Lookaheads => 
Show_Lookaheads));
+   end Put;
+
+   procedure Put
+     (Descriptor : in WisiToken.Descriptor;
+      List       : in Goto_Item_Lists.List)
+   is
+      use Ada.Text_IO;
+   begin
+      for Item of List loop
+         Put_Line
+           ("      on " & Image (Item.Symbol, Descriptor) &
+              " => State" & Unknown_State_Index'Image (Item.State));
+      end loop;
+   end Put;
+
+   procedure Put
+     (Grammar         : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor      : in WisiToken.Descriptor;
+      Item            : in Item_Set;
+      Show_Lookaheads : in Boolean := True;
+      Kernel_Only     : in Boolean := False;
+      Show_Goto_List  : in Boolean := False)
+   is
+      use Ada.Text_IO;
+   begin
+      if Item.State /= Unknown_State then
+         Put_Line ("State" & Unknown_State_Index'Image (Item.State) & ":");
+      end if;
+
+      for It of Item.Set loop
+         if not Kernel_Only or else
+           In_Kernel (Grammar, Descriptor, It)
+         then
+            Put_Line
+              ("  " & Image (Grammar, Descriptor, It, Show_Lookaheads => 
Show_Lookaheads));
+         end if;
+      end loop;
+
+      if Show_Goto_List then
+         Put (Descriptor, Item.Goto_List);
+      end if;
+   end Put;
+
+   procedure Put
+     (Grammar         : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor      : in WisiToken.Descriptor;
+      Item            : in Item_Set_List;
+      Show_Lookaheads : in Boolean := True)
+   is
+      use Ada.Text_IO;
+   begin
+      for Set of Item loop
+         Put (Grammar, Descriptor, Set, Show_Lookaheads);
+         Put_Line ("   Goto:");
+         Put (Descriptor, Set.Goto_List);
+      end loop;
+   end Put;
+
+end WisiToken.Generate.LR1_Items;
diff --git a/wisitoken-generate-lr1_items.ads b/wisitoken-generate-lr1_items.ads
new file mode 100644
index 0000000..ff90e4a
--- /dev/null
+++ b/wisitoken-generate-lr1_items.ads
@@ -0,0 +1,332 @@
+--  Abstract :
+--
+--  Types and operatorion for LR(1) items.
+--
+--  Copyright (C) 2003, 2008, 2013-2015, 2017, 2018 Stephe Leake
+--  Copyright (C) 1999 Ted Dennison
+--
+--  This file is part of the WisiToken package.
+--
+--  The WisiToken package 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, or
+--  (at your option) any later version. The WisiToken package 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 distributed with the WisiToken package;
+--  see file GPL.txt. If not, write to the Free Software Foundation,
+--  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+--
+--  As a special exception, if other files instantiate generics from
+--  this unit, or you link this unit with other files to produce an
+--  executable, this unit does not by itself cause the resulting
+--  executable to be covered by the GNU General Public License. This
+--  exception does not however invalidate any other reasons why the
+--  executable file might be covered by the GNU Public License.
+
+pragma License (Modified_GPL);
+
+with Interfaces;
+with SAL.Gen_Definite_Doubly_Linked_Lists_Sorted;
+with SAL.Gen_Unbounded_Definite_Red_Black_Trees;
+with SAL.Gen_Unbounded_Definite_Vectors.Gen_Comparable;
+with WisiToken.Productions;
+package WisiToken.Generate.LR1_Items is
+
+   use all type Interfaces.Integer_16;
+
+   subtype Lookahead is Token_ID_Set;
+   --  Picking a type for Lookahead is not straight-forward. The
+   --  operations required are (called numbers are for LR1 generate
+   --  ada_lite):
+   --
+   --  to_lookahead (token_id)
+   --     Requires allocating memory dynamically:
+   --        an unconstrained array range (first_terminal .. last_terminal) 
for (1),
+   --        a smaller unconstrained array for (2), that grows as items are 
added
+   --        individual list elements for (3).
+   --
+   --     lr1_items.to_lookahead        called 4_821_256 times in (2)
+   --     sorted_token_id_lists.to_list called 4_821_256 times in (3)
+   --
+   --  for tok_id of lookaheads loop
+   --     sorted_token_id_lists__iterate called 5_687 times in (3)
+   --
+   --  if lookaheads.contains (tok_id) then
+   --     token_id_arrays__contains called 22_177_109 in (2)
+   --
+   --  new_item := (... , lookaheads => old_item.lookaheads)
+   --  new_item := (... , lookaheads => null_lookaheads)
+   --  new_item := (... , lookaheads => propagate_lookahead)
+   --     token_id_arrays.adjust called 8_437_967 times in (2)
+   --     sorted_token_id_lists.adjust  8_435_797 times in (3)
+   --
+   --  include: add tok_id to lookaheads
+   --
+   --      keep sorted in token_id order, so rest of algorithm is
+   --      stable/faster
+   --
+   --      lr1_items.include called 6_818_725 times in (2)
+   --
+   --  lookaheads /= lookaheads
+   --     if using a container, container must override "="
+   --
+   --  We've tried:
+   --
+   --  (1) Token_ID_Set (unconstrained array of boolean, allocated directly) - 
fastest
+   --
+   --     Allocates more memory than (2), but everything else is fast,
+   --     and it's not enough memory to matter.
+   --
+   --     Loop over lookaheads is awkward:
+   --     for tok_id in lookaheads'range loop
+   --        if lookaheads (tok_id) then
+   --           ...
+   --     But apparently it's fast enough.
+   --
+   --  (2) Instantiation of SAL.Gen_Unbounded_Definite_Vectors 
(token_id_arrays) - slower than (1).
+   --
+   --      Productions RHS is also token_id_arrays, so gprof numbers are
+   --      hard to sort out. Could be improved with a custom container, that
+   --      does sort and insert internally. Insert is inherently slow.
+   --
+   --  (3) Instantiation of SAL.Gen_Definite_Doubly_Linked_Lists_Sorted - 
slower than (2)
+
+   type Item is record
+      Prod       : Production_ID;
+      Dot        : Token_ID_Arrays.Cursor; -- token after item Dot
+      Lookaheads : access Lookahead := null;
+      --  Programmer must remember to copy Item.Lookaheads.all, not
+      --  Item.Lookaheads. Wrapping this in Ada.Finalization.Controlled
+      --  would just slow it down.
+      --
+      --  We don't free Lookaheads; we assume the user is running
+      --  wisi-generate, and not keeping LR1_Items around.
+   end record;
+
+   function To_Lookahead (Item : in Token_ID; Descriptor : in 
WisiToken.Descriptor) return Lookahead;
+
+   function Contains (Item : in Lookahead; ID : in Token_ID) return Boolean
+     is (Item (ID));
+
+   function Lookahead_Image (Item : in Lookahead; Descriptor : in 
WisiToken.Descriptor) return String;
+   --  Returns the format used in parse table output.
+
+   function Item_Compare (Left, Right : in Item) return SAL.Compare_Result;
+   --  Sort Item_Lists in ascending order of Prod.Nonterm, Prod.RHS, Dot;
+   --  ignores Lookaheads.
+
+   package Item_Lists is new SAL.Gen_Definite_Doubly_Linked_Lists_Sorted 
(Item, Item_Compare);
+
+   procedure Include
+     (Item  : in out LR1_Items.Item;
+      Value : in     Lookahead;
+      Added :    out Boolean);
+   --  Add Value to Item.Lookahead, if not already present.
+   --
+   --  Added is True if Value was not already present.
+   --
+   --  Does not exclude Propagate_ID.
+
+   procedure Include
+     (Item       : in out LR1_Items.Item;
+      Value      : in     Lookahead;
+      Descriptor : in     WisiToken.Descriptor);
+   --  Add Value to Item.Lookahead. Does not check if already present.
+   --  Excludes Propagate_ID.
+
+   procedure Include
+     (Item       : in out LR1_Items.Item;
+      Value      : in     Lookahead;
+      Added      :    out Boolean;
+      Descriptor : in     WisiToken.Descriptor);
+   --  Add Value to Item.Lookahead.
+
+   type Goto_Item is record
+      Symbol : Token_ID;
+      --  If Symbol is a terminal, this is a shift and goto state action.
+      --  If Symbol is a non-terminal, this is a post-reduce goto state action.
+      State  : State_Index;
+   end record;
+
+   function Goto_Item_Compare (Left, Right : in Goto_Item) return 
SAL.Compare_Result is
+     (if Left.Symbol > Right.Symbol then SAL.Greater
+      elsif Left.Symbol < Right.Symbol then SAL.Less
+      else SAL.Equal);
+   --  Sort Goto_Item_Lists in ascending order of Symbol.
+
+   package Goto_Item_Lists is new SAL.Gen_Definite_Doubly_Linked_Lists_Sorted
+     (Goto_Item, Goto_Item_Compare);
+
+   type Item_Set is record
+      Set       : Item_Lists.List;
+      Goto_List : Goto_Item_Lists.List;
+      Dot_IDs   : Token_ID_Arrays.Vector;
+      State     : Unknown_State_Index := Unknown_State;
+   end record;
+
+   function Filter
+     (Set        : in     Item_Set;
+      Grammar    : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor : in     WisiToken.Descriptor;
+      Include    : access function
+        (Grammar    : in WisiToken.Productions.Prod_Arrays.Vector;
+         Descriptor : in WisiToken.Descriptor;
+         Item       : in LR1_Items.Item)
+        return Boolean)
+     return Item_Set;
+   --  Return a deep copy of Set, including only items for which Include 
returns True.
+
+   function In_Kernel
+     (Grammar    : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor : in WisiToken.Descriptor;
+      Item       : in LR1_Items.Item)
+     return Boolean;
+   --  For use with Filter; [dragon] sec 4.7 pg 240
+
+   function Find
+     (Item : in LR1_Items.Item;
+      Set  : in Item_Set)
+     return Item_Lists.Cursor;
+   --  Return an item from Set that matches Item.Prod, Item.Dot.
+   --
+   --  Return No_Element if not found.
+
+   function Find
+     (Prod  : in Production_ID;
+      Dot   : in Token_ID_Arrays.Cursor;
+      Right : in Item_Set)
+     return Item_Lists.Cursor;
+   --  Return an item from Right that matches Prod, Dot.
+   --
+   --  Return No_Element if not found.
+
+   function Find
+     (Prod       : in Production_ID;
+      Dot        : in Token_ID_Arrays.Cursor;
+      Right      : in Item_Set;
+      Lookaheads : in Lookahead)
+     return Item_Lists.Cursor;
+   --  Return an item from Right that matches Prod, Dot, and
+   --  Lookaheads.
+   --
+   --  Return No_Element if not found.
+   --
+   --  Not combined with non-Lookaheads version for speed; this is called
+   --  a lot.
+
+   package Item_Set_Arrays is new SAL.Gen_Unbounded_Definite_Vectors 
(State_Index, Item_Set);
+   subtype Item_Set_List is Item_Set_Arrays.Vector;
+
+   package State_Index_Arrays is new SAL.Gen_Unbounded_Definite_Vectors 
(Positive, State_Index);
+
+   package Int_Arrays is new SAL.Gen_Unbounded_Definite_Vectors (Positive, 
Interfaces.Integer_16);
+   function Compare_Integer_16 (Left, Right : in Interfaces.Integer_16) return 
SAL.Compare_Result is
+     (if Left > Right then SAL.Greater
+      elsif Left < Right then SAL.Less
+      else SAL.Equal);
+
+   package Int_Arrays_Comparable is new Int_Arrays.Gen_Comparable 
(Compare_Integer_16);
+
+   subtype Item_Set_Tree_Key is Int_Arrays_Comparable.Vector;
+   --  We want a key that is fast to compare, and has enough info to
+   --  significantly speed the search for an item set. So we convert all
+   --  relevant data in an item into a string of integers. We need 16 bit
+   --  because Ada token_ids max is 332. LR1 keys include lookaheads,
+   --  LALR keys do not.
+
+   type Item_Set_Tree_Node is record
+      Key   : Item_Set_Tree_Key;
+      State : Unknown_State_Index;
+   end record;
+
+   function To_Item_Set_Tree_Key
+     (Item_Set           : in LR1_Items.Item_Set;
+      Include_Lookaheads : in Boolean)
+     return Item_Set_Tree_Key;
+
+   function To_Item_Set_Tree_Key (Node : in Item_Set_Tree_Node) return 
Item_Set_Tree_Key is
+     (Node.Key);
+
+   package Item_Set_Trees is new SAL.Gen_Unbounded_Definite_Red_Black_Trees
+     (Element_Type => Item_Set_Tree_Node,
+      Key_Type     => Item_Set_Tree_Key,
+      Key          => To_Item_Set_Tree_Key,
+      Key_Compare  => Int_Arrays_Comparable.Compare);
+   --  Item_Set_Arrays.Vector holds state item sets indexed by state, for
+   --  iterating in state order. Item_Set_Trees.Tree holds lists of state
+   --  indices sorted by LR1 item info, for fast Find in LR1_Item_Sets
+   --  and LALR_Kernels.
+
+   function Find
+     (New_Item_Set     : in Item_Set;
+      Item_Set_Tree    : in Item_Set_Trees.Tree;
+      Match_Lookaheads : in Boolean)
+     return Unknown_State_Index;
+   --  Return the State of an element in Item_Set_Tree matching
+   --  New_Item_Set, Unknown_State if not found.
+   --
+   --  Match_Lookaheads is True in LR1_Generate.
+
+   procedure Add
+     (New_Item_Set       : in out Item_Set;
+      Item_Set_Vector    : in out Item_Set_List;
+      Item_Set_Tree      : in out Item_Set_Trees.Tree;
+      Descriptor         : in     WisiToken.Descriptor;
+      Include_Lookaheads : in     Boolean);
+   --  Set New_Item_Set.Dot_IDs, add New_Item_Set to Item_Set_Vector, 
Item_Set_Tree
+
+   function Is_In
+     (Item      : in Goto_Item;
+      Goto_List : in Goto_Item_Lists.List)
+     return Boolean;
+   --  Return True if a goto on Symbol to State is found in Goto_List
+
+   function Goto_State
+     (From   : in Item_Set;
+      Symbol : in Token_ID)
+     return Unknown_State_Index;
+   --  Return state from From.Goto_List where the goto symbol is
+   --  Symbol; Unknown_State if not found.
+
+   function Closure
+     (Set                     : in Item_Set;
+      Has_Empty_Production    : in Token_ID_Set;
+      First_Terminal_Sequence : in Token_Sequence_Arrays.Vector;
+      Grammar                 : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor              : in WisiToken.Descriptor)
+     return Item_Set;
+   --  Return the closure of Set over Grammar. First must be the
+   --  result of First above. Makes a deep copy of Goto_List.
+   --  Implements 'closure' from [dragon] algorithm 4.9 pg 232, but
+   --  allows merging lookaheads into one item..
+
+   function Productions (Set : in Item_Set) return Production_ID_Arrays.Vector;
+
+   procedure Put
+     (Grammar         : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor      : in WisiToken.Descriptor;
+      Item            : in LR1_Items.Item;
+      Show_Lookaheads : in Boolean := True);
+
+   procedure Put
+     (Grammar         : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor      : in WisiToken.Descriptor;
+      Item            : in Item_Set;
+      Show_Lookaheads : in Boolean := True;
+      Kernel_Only     : in Boolean := False;
+      Show_Goto_List  : in Boolean := False);
+
+   procedure Put
+     (Descriptor : in WisiToken.Descriptor;
+      List       : in Goto_Item_Lists.List);
+   procedure Put
+     (Grammar         : in WisiToken.Productions.Prod_Arrays.Vector;
+      Descriptor      : in WisiToken.Descriptor;
+      Item            : in Item_Set_List;
+      Show_Lookaheads : in Boolean := True);
+   --  Put Item to Ada.Text_IO.Standard_Output. Does not end with New_Line.
+
+end WisiToken.Generate.LR1_Items;
diff --git a/wisitoken-generate-packrat.adb b/wisitoken-generate-packrat.adb
new file mode 100644
index 0000000..068b6d0
--- /dev/null
+++ b/wisitoken-generate-packrat.adb
@@ -0,0 +1,247 @@
+--  Abstract :
+--
+--  See spec.
+--
+--  Copyright (C) 2018 Stephen Leake All Rights Reserved.
+--
+--  This library is free software;  you can redistribute it and/or modify it
+--  under terms of the  GNU General Public License  as published by the Free
+--  Software  Foundation;  either version 3,  or (at your  option) any later
+--  version. This library is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN-
+--  TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+--  As a special exception under Section 7 of GPL version 3, you are granted
+--  additional permissions described in the GCC Runtime Library Exception,
+--  version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+package body WisiToken.Generate.Packrat is
+
+   function Potential_Direct_Right_Recursive
+     (Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
+      Empty   : in Token_ID_Set)
+     return Token_ID_Set
+   is
+      subtype Nonterminal is Token_ID range Grammar.First_Index .. 
Grammar.Last_Index;
+   begin
+      return Result : Token_ID_Set (Nonterminal) := (others => False) do
+         for Prod of Grammar loop
+            RHS_Loop :
+            for RHS of Prod.RHSs loop
+               ID_Loop :
+               for I in reverse RHS.Tokens.First_Index + 1 .. 
RHS.Tokens.Last_Index loop
+                  declare
+                     ID : constant Token_ID := RHS.Tokens (I);
+                  begin
+                     if ID = Prod.LHS then
+                        Result (ID) := True;
+                        exit RHS_Loop;
+                     elsif not (ID in Nonterminal) then
+                        exit ID_Loop;
+                     elsif not Empty (ID) then
+                        exit ID_Loop;
+                     end if;
+                  end;
+               end loop ID_Loop;
+            end loop RHS_Loop;
+         end loop;
+      end return;
+   end Potential_Direct_Right_Recursive;
+
+   procedure Indirect_Left_Recursive (Data : in out Packrat.Data)
+   is
+   begin
+      for Prod_I of Data.Grammar loop
+         for Prod_J of Data.Grammar loop
+            Data.Involved (Prod_I.LHS, Prod_J.LHS) :=
+              Data.First (Prod_I.LHS, Prod_J.LHS) and
+              Data.First (Prod_J.LHS, Prod_I.LHS);
+         end loop;
+      end loop;
+   end Indirect_Left_Recursive;
+
+   ----------
+   --  Public subprograms
+
+   function Initialize
+     (Source_File_Name : in String;
+      Grammar          : in WisiToken.Productions.Prod_Arrays.Vector;
+      Source_Line_Map  : in Productions.Source_Line_Maps.Vector;
+      First_Terminal   : in Token_ID)
+     return Packrat.Data
+   is
+      Empty : constant Token_ID_Set := WisiToken.Generate.Has_Empty_Production 
(Grammar);
+   begin
+      return Result : Packrat.Data :=
+        (First_Terminal        => First_Terminal,
+         First_Nonterminal     => Grammar.First_Index,
+         Last_Nonterminal      => Grammar.Last_Index,
+         Source_File_Name      => +Source_File_Name,
+         Grammar               => Grammar,
+         Source_Line_Map       => Source_Line_Map,
+         Empty                 => Empty,
+         Direct_Left_Recursive => Potential_Direct_Left_Recursive (Grammar, 
Empty),
+         First                 => WisiToken.Generate.First (Grammar, Empty, 
First_Terminal => First_Terminal),
+         Involved              => (others => (others => False)))
+      do
+         Indirect_Left_Recursive (Result);
+      end return;
+   end Initialize;
+
+   procedure Check_Recursion (Data : in Packrat.Data; Descriptor : in 
WisiToken.Descriptor)
+   is
+      Right_Recursive : constant Token_ID_Set := 
Potential_Direct_Right_Recursive (Data.Grammar, Data.Empty);
+   begin
+      for Prod of Data.Grammar loop
+         if Data.Direct_Left_Recursive (Prod.LHS) and Right_Recursive 
(Prod.LHS) then
+            --  We only implement the simplest left recursion solution ([warth
+            --  2008] figure 3); [tratt 2010] section 6.3 gives this condition 
for
+            --  that to be valid.
+            --  FIXME: not quite? definite direct right recursive ok?
+            --  FIXME: for indirect left recursion, need potential indirect 
right recursive check?
+            Put_Error
+              (Error_Message
+                 (-Data.Source_File_Name, Data.Source_Line_Map 
(Prod.LHS).Line, "'" & Image (Prod.LHS, Descriptor) &
+                    "' is both left and right recursive; not supported."));
+         end if;
+
+         for I in Data.Involved'Range (2) loop
+            if Prod.LHS /= I and then Data.Involved (Prod.LHS, I) then
+               Put_Error
+                 (Error_Message
+                    (-Data.Source_File_Name, Data.Source_Line_Map 
(Prod.LHS).Line, "'" & Image (Prod.LHS, Descriptor) &
+                       "' is indirect recursive with " & Image (I, Descriptor) 
& ", not supported"));
+            end if;
+         end loop;
+      end loop;
+   end Check_Recursion;
+
+   procedure Check_RHS_Order (Data : in Packrat.Data; Descriptor : in 
WisiToken.Descriptor)
+   is
+      use all type Ada.Containers.Count_Type;
+   begin
+      for Prod of Data.Grammar loop
+         --  Empty must be last
+         for I in Prod.RHSs.First_Index .. Prod.RHSs.Last_Index - 1 loop
+            if Prod.RHSs (I).Tokens.Length = 0 then
+               Put_Error
+                 (Error_Message
+                    (-Data.Source_File_Name, Data.Source_Line_Map 
(Prod.LHS).RHS_Map (I),
+                     "right hand side" & Integer'Image (I) & " in " & Image 
(Prod.LHS, Descriptor) &
+                       " is empty, but not last; no later right hand side will 
match."));
+               WisiToken.Generate.Error := True;
+            end if;
+         end loop;
+
+         for I in Prod.RHSs.First_Index + 1 .. Prod.RHSs.Last_Index loop
+            declare
+               Cur : Token_ID_Arrays.Vector renames Prod.RHSs (I).Tokens;
+            begin
+               --  Shared prefix; longer must be first
+               for J in Prod.RHSs.First_Index .. I - 1 loop
+                  declare
+                     Prev : Token_ID_Arrays.Vector renames Prod.RHSs 
(J).Tokens;
+                     K    : constant Natural := Shared_Prefix (Prev, Cur);
+                  begin
+                     if K > 0 and Prev.Length < Cur.Length then
+                        Put_Error
+                          (Error_Message
+                             (-Data.Source_File_Name, Data.Source_Line_Map 
(Prod.LHS).RHS_Map (I),
+                              "right hand side" & Integer'Image (I) & " in " & 
Image (Prod.LHS, Descriptor) &
+                                " may never match; it shares a prefix with a 
shorter previous rhs" &
+                                Integer'Image (J) & "."));
+                     end if;
+                  end;
+               end loop;
+
+               --  recursion; typical LALR list is written:
+               --
+               --  statement_list
+               --    : statement
+               --    | statement_list statement
+               --    ;
+               --  association_list
+               --    : association
+               --    | association_list COMMA association
+               --    ;
+               --
+               --  a different recursive definition:
+               --
+               --  name
+               --    : IDENTIFIER
+               --    | name LEFT_PAREN range_list RIGHT_PAREN
+               --    | name actual_parameter_part
+               --    ...
+               --    ;
+               --
+               --  For packrat, the recursive RHSs must come before others:
+               --
+               --  statement_list
+               --    : statement_list statement
+               --    | statement
+               --    ;
+               --  association_list
+               --    : association_list COMMA association
+               --    | association
+               --    ;
+               --  name
+               --    : name LEFT_PAREN range_list RIGHT_PAREN
+               --    | name actual_parameter_part
+               --    | IDENTIFIER
+               --    ...
+               --    ;
+               declare
+                  Prev : Token_ID_Arrays.Vector renames Prod.RHSs (I - 
1).Tokens;
+               begin
+                  if Cur.Length > 0 and then Prev.Length > 0 and then
+                    Cur (1) = Prod.LHS and then Prev (1) /= Prod.LHS
+                  then
+                     Put_Error
+                       (Error_Message
+                          (-Data.Source_File_Name, Data.Source_Line_Map 
(Prod.LHS).Line,
+                           "recursive right hand sides must be before 
others."));
+                  end if;
+               end;
+            end;
+         end loop;
+      end loop;
+   end Check_RHS_Order;
+
+   procedure Check_All (Data : in Packrat.Data; Descriptor : in 
WisiToken.Descriptor)
+   is begin
+      Check_Recursion (Data, Descriptor);
+      Check_RHS_Order (Data, Descriptor);
+   end Check_All;
+
+   function Potential_Direct_Left_Recursive
+     (Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
+      Empty   : in Token_ID_Set)
+     return Token_ID_Set
+   is
+      subtype Nonterminal is Token_ID range Grammar.First_Index .. 
Grammar.Last_Index;
+   begin
+      --  FIXME: this duplicates the computation of First; if keep First,
+      --  change this to use it.
+      return Result : Token_ID_Set (Nonterminal) := (others => False) do
+         for Prod of Grammar loop
+            RHS_Loop :
+            for RHS of Prod.RHSs loop
+               ID_Loop :
+               for ID of RHS.Tokens loop
+                  if ID = Prod.LHS then
+                     Result (ID) := True;