wisitoken_4.2.1_dc778486/wisitoken-bnf-output_ada_emacs.adb

--  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 - 2023 Free Software Foundation, Inc.
--
--  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.Assertions;
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;
   Grammar_File_Name            :         in String;
   Output_File_Name_Root        :         in String;
   Generate_Data                : aliased in WisiToken.BNF.Generate_Utils.Generate_Data;
   Packrat_Data                 :         in WisiToken.Generate.Packrat.Data_Access;
   Tuple                        :         in Generate_Tuple;
   Test_Main                    :         in Boolean;
   Multiple_Tuples              :         in Boolean;
   Need_Gen_Alg_In_Actions_Name :         in Boolean;
   Language_Name                :         in String)
is
   use all type Ada.Containers.Count_Type;

   Default_Language_Runtime_Package : constant String := "Wisi." & Language_Name;

   Blank_Set : constant Ada.Strings.Maps.Character_Set := Ada.Strings.Maps.To_Set (" ");
   Numeric   : constant Ada.Strings.Maps.Character_Set := Ada.Strings.Maps.To_Set ("0123456789");

   Common_Data : constant Output_Ada_Common.Common_Data := WisiToken.BNF.Output_Ada_Common.Initialize
     (Input_Data, Tuple, Grammar_File_Name, 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, replacing comments and
      --  newlines with a single space each.

      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;
               Buffer (Buffer_J) := ' ';
               Buffer_J := Buffer_J + 1;
            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
               Buffer (Buffer_J) := ' ';
               Buffer_J := Buffer_J + 1;

            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;
      Prod_ID         : in     WisiToken.Production_ID;
      Unsplit_Lines   : in     Ada.Strings.Unbounded.Unbounded_String;
      Rule            : in     BNF.Rule_Type;
      Empty           :    out Boolean;
      In_Parse_Action : in     Boolean)
   is
      use all type SAL.Base_Peek_Type;

      --  Create Post_Parse_Action (if In_Parse_Action = False; Lines must
      --  be RHS.Action) or In_Parse_Action (if In_Parse_Action = True;
      --  Lines must be RHS.In_Parse_Action) subprogram named Name for RHS.
      --
      --  Labels is collection of all labels used in any RHS in the nonterm;
      --  _not_ in RHS token order. RHS.Tokens(I).Label contains explicit
      --  and automatic token labels.

      use Ada.Strings;
      use Ada.Strings.Fixed;
      use Ada.Strings.Unbounded;
      use WisiToken.Generate;

      Sexps : constant String_Lists.List := Split_Sexp
        (-Unsplit_Lines, Grammar_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;
      In_Parse_Action_Line : Unbounded_String;

      Label_Needed   : array (Rule.Labels.First_Index .. Rule.Labels.Last_Index) of Boolean := (others => False);
      Nonterm_Needed : Boolean := False;

      function Find_RHS (RHS_Index : in Natural) return RHS_Lists.Cursor
      is
         use RHS_Lists;
         Result : Cursor := Rule.Right_Hand_Sides.First;
      begin
         for I in 1 .. RHS_Index loop
            Next (Result);
         end loop;
         return Result;
      end Find_RHS;

      EBNF_RHS : RHS_Type renames RHS_Lists.Element (Find_RHS (RHS.EBNF_RHS_Index));

      function Get_Label (Token_Param : in String; Integer : in Boolean := False) return String
      is
         function Finish (Label : in String; Force_Integer : in Boolean) return String
         is (if Force_Integer
             then "Integer (" & Label & ")"
             else Label);

      begin
         if RHS.Auto_Token_Labels then
            if 0 = Index (Token_Param, Numeric, Outside) then
               --  Token_param is an integer token index, not a label
               begin
                  declare
                     Index : constant Positive_Index_Type := Positive_Index_Type'Value (Token_Param);
                     Label : constant String := -EBNF_RHS.Tokens (Index).Label;
                  begin
                     if Label'Length = 0 then
                        return Finish (Token_Param, Force_Integer => False);
                     else
                        return Finish (Label, Force_Integer => Integer);
                     end if;
                  end;
               exception
               when Ada.Assertions.Assertion_Error | Constraint_Error =>
                  Put_Error
                    (Error_Message
                       (Grammar_File_Name, RHS.Source_Line,
                        "token index '" & Token_Param & "' not in range" & EBNF_RHS.Tokens.First_Index'Image &
                          " .." & EBNF_RHS.Tokens.Last_Index'Image));
                  return "";
               end;
            else
               --  Token_Param is a label
               return Finish (Token_Param, Force_Integer => Integer);
            end if;
         else
            return Finish
              (Token_Param, Force_Integer => Integer and then (0 /= Index (Token_Param, Numeric, Outside)));
         end if;
      end Get_Label;

      procedure Mark_Label_Used (Label : in String)
      is begin
         for I in Rule.Labels.First_Index .. Rule.Labels.Last_Index loop
            if Label = Rule.Labels (I) then
               Label_Needed (I) := True;
            end if;
         end loop;
      end Mark_Label_Used;

      function Label_Used (Label : in String) return Boolean
      is
         Found : Boolean := False;
      begin
         if 0 = Index (Label, Numeric, Outside) then
            --  Label is an integer, not a label
            return True;
         end if;

         for Tok of RHS.Tokens loop
            if -Tok.Label = Label then
               Found := True;
               exit;
            end if;
         end loop;

         if not Found then
            return False;
         end if;

         for I in Rule.Labels.First_Index .. Rule.Labels.Last_Index loop
            if Label = Rule.Labels (I) then
               Label_Needed (I) := True;
               return True;
            end if;
         end loop;
         raise SAL.Programmer_Error;
      end Label_Used;

      function Find_Token_Index (I : in Base_Identifier_Index) return SAL.Base_Peek_Type
      is
         Rule_Label : constant String := -Rule.Labels (I);
      begin
         for I in RHS.Tokens.First_Index .. RHS.Tokens.Last_Index loop
            if Length (RHS.Tokens (I).Label) > 0 and then
              -RHS.Tokens (I).Label = Rule_Label
            then
               return I;
            end if;
         end loop;
         return SAL.Base_Peek_Type'First;
      end Find_Token_Index;

      function Statement_Params (Params : in String) return String
      is
         --  Input looks like: [1 function 2 other ...]
         --  Numbers can be token labels.

         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;

            Last := Index (Params, Space_Paren_Set, Second + 1);

            declare
               Label : constant String := Get_Label (Params (First .. Second - 1));
            begin
               if Label_Used (Label) then
                  Count := Count + 1;
                  Result := Result & (if Need_Comma then ", " else "") &
                    "(" & Label & ", " &
                    Elisp_Name_To_Ada (Params (Second + 1 .. Last - 1), Append_ID => False, Trim => 0) & ")";

                  Need_Comma := True;
               --  else skip
               end if;
            end;
         end loop;
         Nonterm_Needed := True;
         return " (Parse_Data, Tree, Nonterm, " &
           (case Count is
            when 0 => "(1 .. 0 => (1, Motion)))",
            when 1 => "(1 => " & (-Result) & "))",
            when others =>  "(" & (-Result) & "))");
      end Statement_Params;

      function Motion_Params (Params : in String) return String
      is
         --  Input looks like: [1 [2 EXCEPTION] 3 ...]
         --  Result: (..., Motion_Param_Array'((1, Invalid_Token_ID) & (2, 3) & (3, Invalid_Token_ID))
         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;

         Index_First  : Integer;
         Index_Last   : Integer;
         ID           : Unbounded_String;
         Need_Comma : Boolean := False;
         Count      : Integer          := 0;
      begin
         loop
            if not (Last in Params'First .. Params'Last) then
               Put_Error
                 (Error_Message
                    (Grammar_File_Name, RHS.Source_Line,
                     "Missing ']' or ')'"));
               exit;
            end if;
            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;
               First       := Last + 1;
               Last        := Index (Params, Delim, First);
               begin
                  ID := +Trimmed_Image (Find_Token_ID (Generate_Data, Params (First .. Last - 1)));
               exception
               when E : Not_Found =>
                  Put_Error
                    (Error_Message
                       (Grammar_File_Name, RHS.Source_Line,
                        Ada.Exceptions.Exception_Message (E)));
               end;

               declare
                  Label : constant String := Get_Label (Params (Index_First .. Index_Last));
               begin
                  if Label_Used (Label) then
                     --  Ada 2020 added vector aggregates, making this ambiguous without
                     --  Index_ID qualification
                     Result := Result & (if Need_Comma then " & " else "") & "Index_ID'(" &
                       Label & ", " & ID & ")";
                     Need_Comma := True;
                     Count  := Count + 1;
                  end if;
               end;
               if Params (Last) /= ']' then
                  Put_Error
                    (Error_Message
                       (Grammar_File_Name, RHS.Source_Line,
                        "too many token IDs in motion action"));
                  return -Result & "))";
               end if;

            else
               First  := Index_Non_Blank (Params, Last);
               Last   := Index (Params, Delim, First);
               declare
                  Label : constant String := Get_Label (Params (First .. Last - 1));
               begin
                  if Label_Used (Label) then
                     Result := Result & (if Need_Comma then " & " else "") &
                       "Index_ID'(" & Label & ", Invalid_Token_ID)";
                     Need_Comma := True;
                     Count  := Count + 1;
                  end if;
               end;
            end if;
         end loop;
         if Count <= 1 then
            --  No point in calling Motion_Action with only one param.
            return "";
         else
            Nonterm_Needed := True;
            return " (Parse_Data, Tree, Nonterm, (" & (-Result) & "))";
         end if;
      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 ...]
         --  Each triple is <token_number> <prefix-face> <suffix-face>.
         --  The token_number can be a label; faces are "nil" or an elisp name.
         --  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;

         procedure Elisp_Param (Skip : in Boolean)
         is begin
            if Params (Last) = ']' then
               Put_Error
                 (Error_Message
                    (Grammar_File_Name, RHS.Source_Line, "invalid wisi-face-apply argument"));
               return;
            end if;

            First  := Index_Non_Blank (Params, Last + 1);
            Last   := Index (Params, Delim, First);
            if not Skip then
               Result := Result & ',' & Integer'Image
                 (Find_Elisp_ID (Input_Data.Tokens.Faces, Params (First .. Last - 1)));
            end if;
         end Elisp_Param;

      begin
         loop
            Last := Index_Non_Blank (Params, Last + 1);

            exit when Params (Last) = ']' or Params (Last) = ')';

            First := Last;
            Last  := Index (Params, Delim, First);
            declare
               Label : constant String := Get_Label (Params (First .. Last - 1));
            begin
               if Label_Used (Label) then
                  Count  := Count + 1;
                  Result := Result & (if Need_Comma then ", (" else "(") & Label;
                  Need_Comma := True;
                  Elisp_Param (Skip => False);
                  Elisp_Param (Skip => False);
                  Result := Result  & ")";
               else
                  Elisp_Param (Skip => True);
                  Elisp_Param (Skip => True);
               end if;
            end;
         end loop;
         if Count = 0 then
            return "";
         elsif Count = 1 then
               Nonterm_Needed := True;
            return " (Parse_Data, Tree, Nonterm, (1 => " & (-Result) & "))";
         else
               Nonterm_Needed := True;
            return " (Parse_Data, Tree, Nonterm, (" & (-Result) & "))";
         end if;
      exception
      when E : others =>
         Put_Error
           (Error_Message
              (Grammar_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 ...]
         --  The token_number can be a label; faces are "nil" or an elisp name.
         --  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;
         Skip       : Boolean;
      begin
         loop
            Last := Index_Non_Blank (Params, Last + 1);

            exit when Params (Last) = ']' or Params (Last) = ')';

            First := Last;
            Last  := Index (Params, Delim, First);
            declare
               Label : constant String := Get_Label (Params (First .. Last - 1));
            begin
               if Label_Used (Label) then
                  Count  := Count + 1;
                  Skip   := False;
                  Result := Result & (if Need_Comma then ", (" else "(") & Label;
               else
                  Skip := True;
               end if;
            end;

            if Params (Last) = ']' then
               Put_Error
                 (Error_Message
                    (Grammar_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);
            if not Skip then
               Result := Result & ", " & Elisp_Name_To_Ada (Params (First .. Last - 1), False, 0) & ")";
               Need_Comma := True;
            end if;
         end loop;
         Nonterm_Needed := True;
         return " (Parse_Data, Tree, Nonterm, " &
           (case Count is
            when 0 => "(1 .. 0 => (1, Prefix))",
            when 1 => "(1 => " & (-Result) & "))",
            when others => "(" & (-Result) & "))");
      exception
      when E : others =>
         Put_Error
           (Error_Message
            (Grammar_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 ...]
         --  Token numbers can be labels.
         --  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) = ')';

            First  := Last;
            Last   := Index (Params, Delim, First);
            declare
               Label : constant String := Get_Label (Params (First .. Last - 1));
            begin
               if Label_Used (Label) then
                  Count      := Count + 1;
                  Result     := Result & (if Need_Comma then ", " else "") & Label;
                  Need_Comma := True;
               end if;
            end;
         end loop;
         Nonterm_Needed := True;
         return " (Parse_Data, Tree, Nonterm, " &
           (case Count is
            when 0 => "(1 .. 0 => 1)",
            when 1 => "(1 => " & (-Result) & "))",
            when others => "(" & (-Result) & "))");
      exception
      when E : others =>
         Put_Error
           (Error_Message
            (Grammar_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 EBNF tokens. Each item is one of:
         --
         --  - an integer; copy to output
         --
         --  - a symbol; convert to Ada name syntax, except 'nil' => None
         --
         --  - 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.
         --
         --  - a cons of a token label with any of the above.
         --
         --  When EBNF is converted to BNF, one ENBF RHS is typically expanded
         --  to several RHS, each missing some tokens. However, the action
         --  still has indent parameters for all of the original tokens. They
         --  are matched by the token labels.

         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, " & N & "(";
         Result     : Unbounded_String;
         Need_Comma : Boolean         := False;

         --  In translated EBNF, token counts vary in each RHS, but the indent
         --  parameter list is copied from the original. So the tokens don't
         --  match the indent params. First we build a list of (label, value)
         --  for parameters present in Params, then we match them against
         --  RHS.Tokens.
         Param_List : String_Pair_Lists.List;

         function Indent_Function (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-block"     then return "Block";
            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
                  (Grammar_File_Name, RHS.Source_Line, "unrecognized wisi indent function: '" &
                    Elisp_Name & "'"));
               return "";
            end if;
         end Indent_Function;

         function Check_Cons return Integer
         is
            --  Params (Last) = '('; check for "(label .", return label'last
            Blank : constant Integer := Index (Params, " ", Last);
         begin
            if Blank = 0 then return 0; end if;
            if Params'Last > Blank + 1 and then Params (Blank + 1) = '.' then
               return Blank - 1;
            else
               return 0;
            end if;
         end Check_Cons;

         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;

            elsif Item = "nil" then
               return "(Label => None)";

            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:
            --
            --  nil => nil
            --
            --  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 Input_Data.Tokens.Indents.Contains (Function_Name) then
                  --  Language-specific indent function call
                  declare
                     Pair : String_Pair_Type renames Input_Data.Tokens.Indents.Constant_Reference (Function_Name);

                     Declared_Args       : constant String := -Pair.Value;
                     Declared_Args_First : Integer         := Declared_Args'First;
                     Declared_Args_Last  : Integer         := Index (Declared_Args, Blank_Set);

                     Declared_Arg_Count : Count_Type := 0;
                     Next_Token_Arg     : Count_Type := 0;

                     procedure Get_Next_Token_Arg
                     is begin
                        Declared_Args_First := Index_Non_Blank (Declared_Args, Declared_Args_Last + 1);
                        if Declared_Args_First /= 0 then
                           Declared_Args_Last := Index (Declared_Args, Blank_Set, Declared_Args_First);
                           if Declared_Args_Last = 0 then
                              Declared_Args_Last := Declared_Args'Last;
                           end if;

                           Next_Token_Arg := Count_Type'Value
                             (Declared_Args (Declared_Args_First .. Declared_Args_Last));
                        end if;
                     end Get_Next_Token_Arg;

                  begin
                     if Declared_Args'Length = 0 then
                        --  grammar file not updated to current wisitoken version
                        Put_Error
                          (Error_Message
                             (Grammar_File_Name, RHS.Source_Line,
                              "%elisp_indent function requires arg count, token index args."));
                     else
                        if Declared_Args_Last = 0 then
                           Declared_Args_Last := Declared_Args'Last;
                        end if;

                        Declared_Arg_Count := Count_Type'Value
                          (Declared_Args (Declared_Args_First .. Declared_Args_Last));

                        Get_Next_Token_Arg;
                     end if;

                     Function_Name := Pair.Name; -- Ada name
                     Arg_Count     := 0;
                     loop
                        exit when Params (Last) = ')';

                        First     := Last + 1;
                        Arg_Count := Arg_Count + 1;

                        Args := @ & (if Arg_Count = 1 then "" else " & ");

                        if Next_Token_Arg = Arg_Count then
                           Args := @ & Get_Label (Expression (First), Integer => True);
                           Get_Next_Token_Arg;

                        else
                           Args := @ & Expression (First);
                        end if;
                     end loop;

                     if Declared_Arg_Count /= Arg_Count then
                        Put_Error
                          (Error_Message
                             (Grammar_File_Name,
                              RHS.Source_Line,
                              "declared " & (-Function_Name) & " parameter count" & Declared_Arg_Count'Image &
                                " /= actual parameter count" & Arg_Count'Image));
                     end if;

                     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)
                       & ')';
                  end;

               else
                  --  wisi lisp function call
                  Function_Name := +Indent_Function (-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)) & ")";

                  elsif Function_Name = "Block" then
                     --  Argument is 1 simple integer expression; delta
                     Args := +Expression (Last + 1);
                     Last := Last + 1; -- get past ')'
                     return "(" & (-(Function_Name & ", " & Args)) & ")";

                  elsif Slice (Function_Name, 1, 4) = "Anch" then
                     --  Arguments are 2 simple integer expressions; token delta
                     Args := +Get_Label (Expression (Last + 1));
                     Args := Args & ", " & Expression (Last + 1);
                     Last := Last + 1; -- get past ')'
                     return "(" & (-(Function_Name & ", " & Args)) & ")";

                  else
                     Put_Error
                       (Error_Message
                          (Grammar_File_Name, RHS.Source_Line,
                           "unimplimented wisi indent function: '" & (-Function_Name) & "'"));
                     return -Function_Name;
                  end if;
               end if;

            else
               --  Assume it is 'nil' or a language-specific integer indent option,
               --  like "ada-indent", declared in Language_Runtime_Package, which is
               --  use-visible.
               Last  := Index (Params, Delim, First);
               if Params (First .. Last - 1) = "nil" then
                  return "nil";
               else
                  return Elisp_Name_To_Ada (Params (First .. Last - 1), False, 0);
               end if;
            end if;
         exception
         when E : others =>
            Put_Error
              (Error_Message
                 (Grammar_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-specific function
               return "(Simple, " & Item & ")";

            elsif Item = "nil" then
               return "(Simple, (Label => None))";

            else
               --  simple integer
               return "(Simple, (Int, " & Item & "))";
            end if;
         end Ensure_Indent_Param;

         RHS_Token_Index : SAL.Base_Peek_Type := RHS.Tokens.First_Index; -- Index of current token in current RHS.

         Param_Index : SAL.Base_Peek_Type := 1; -- Index of current indent parameter.

         procedure One_Param (Skip : in Boolean; Label : in String := "")
         --  If not Skip, current indent param is for a token actually in RHS; add it to
         --  Param_List.
         --
         --  If Skip, current indent param is not in RHS; parse the param but
         --  don't add it.
         --
         --  Label is non-"" only for recursive calls.
         is
            Pair : String_Pair_Type;
         begin
            if Skip then
               Pair.Name := +"";
            elsif Label = "" then
               Pair.Name := RHS.Tokens (RHS_Token_Index).Label;
            else
               Pair.Name := +Label;
            end if;

            case Params (Last) is
            when '(' =>
               --  cons or function
               declare
                  Label_Last : constant Integer := Check_Cons;
               begin
                  if Label_Last > 0 then
                     --  cons; manual label
                     declare
                        Label : constant String := Params (Last + 1 .. Label_Last);
                     begin
                        Last := Index_Non_Blank (Params, Label_Last + 3);
                        One_Param (Skip, Label);
                     end;

                     if Params (Last) /= ')' then
                        Put_Error
                          (Error_Message
                             (Grammar_File_Name,
                              RHS.Source_Line, "invalid indent syntax; missing ')'"));
                     end if;
                     Last := Last + 1;
                  else
                     --  function
                     Pair.Value := +"(False, " & Ensure_Indent_Param (Expression (Last)) & ')';
                     if not Skip then
                        Param_List.Append (Pair);
                     end if;
                  end if;
               end;

            when '[' =>
               --  vector
               Pair.Value := +"(True, " & Ensure_Indent_Param (Expression (Last + 1));
               Pair.Value := @ & ", " & Ensure_Indent_Param (Expression (Last + 1)) & ')';

               if not Skip then
                  Param_List.Append (Pair);
               end if;
               if Params (Last) /= ']' then
                  Put_Error
                    (Error_Message
                       (Grammar_File_Name, RHS.Source_Line, "indent missing ']'"));
               end if;
               Last := Last + 1;

            when others =>
               --  integer or symbol
               Pair.Value := +"(False, " & Ensure_Indent_Param (Expression (Last)) & ')';
               if not Skip then
                  Param_List.Append (Pair);
               end if;
            end case;
         end One_Param;

      begin
         loop
            if Params (Last) /= ']' then
               Last := Index_Non_Blank (Params, Last + 1);
               if Last = 0 then
                  Put_Error (Error_Message (Grammar_File_Name, RHS.Source_Line, "indent missing ']'"));
                  return -Result;
               end if;
            end if;

            exit when Params (Last) = ']';

            if RHS_Token_Index > EBNF_RHS.Tokens.Last_Index then
               Put_Error
                 (Error_Message
                    (Grammar_File_Name, RHS.Source_Line, Image (Prod_ID, Generate_Data.Descriptor.all)) &
                    " extra indent parameters");
               exit;
            end if;
            if RHS.Orig_EBNF_RHS or else
              (RHS_Token_Index <= RHS.Tokens.Last_Index and then
                 RHS.Tokens (RHS_Token_Index).Orig_Token_Index = Param_Index)
            then
               One_Param (Skip => False);
               RHS_Token_Index := @ + 1;
            else
               One_Param (Skip => True);
            end if;
            Param_Index := @ + 1;

         end loop;

         if RHS.Orig_EBNF_RHS and Param_Index < EBNF_RHS.Tokens.Last_Index then
            Put_Error
              (Error_Message
                 (Grammar_File_Name, RHS.Source_Line, Image (Prod_ID, Generate_Data.Descriptor.all)) &
                 " missing indent parameters");
         end if;

         if RHS.Auto_Token_Labels then
            --  If the original RHS had any EBNF, all tokens are either manually
            --  or automatically labeled and RHS.Auto_Token_Labels is true.
            --  Otherwise RHS.Auto_Token_Labels is False.
            declare
               use String_Pair_Lists;

               Token_I   : Positive_Index_Type      := RHS.Tokens.First_Index;
               Param_Cur : String_Pair_Lists.Cursor := Param_List.First;
            begin
               if not Has_Element (Param_Cur) then
                  Put_Error
                    (Error_Message
                       (Grammar_File_Name,
                        RHS.Source_Line, "empty param_list"));
                  raise SAL.Programmer_Error;
               end if;

               loop
                  exit when Token_I > RHS.Tokens.Last_Index or not Has_Element (Param_Cur);

                  declare
                     Token_Label : constant String := -RHS.Tokens (Token_I).Label;
                     Param_Label : constant String := -Element (Param_Cur).Name;
                  begin
                     if Token_Label'Length = 0 and then Param_Label'Length = 0 then
                        Put_Error
                          (Error_Message
                             (Grammar_File_Name, RHS.Source_Line, Image (Prod_ID, Generate_Data.Descriptor.all)) &
                             " missing or misplaced indent label");
                     end if;

                     --  IMPROVEME: if there is a manual param label, verify that there is
                     --  a matching token label.
                     Result := Result &
                       (if Need_Comma then ", " else "") &
                       (if Token_Label'Length > 0 then Token_Label else Param_Label) & " => " &
                       Element (Param_Cur).Value;

                     Mark_Label_Used (Token_Label);

                     Need_Comma := True;

                     Token_I := @ + 1;
                     Next (Param_Cur);
                  end;
               end loop;
            end;

         else
            --  No auto labels; ignore manual labels and assume Param_List is
            --  correct. IMPROVEME: We could check that manual labels match
            --  between the RHS and the action. IMPROVEME: if all specified params
            --  have manual labels, allow indent for remaining tokens to default
            --  to nil.
            for Pair of Param_List loop
               Result := Result & (if Need_Comma then ", " else "") & Pair.Value;
               Need_Comma := True;
            end loop;
         end if;

         Nonterm_Needed := True;
         if Param_List.Length = 1 then
            Result := Prefix & (if RHS.Auto_Token_Labels then "" else "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);
         Label_First       : constant String  := Get_Label (Params (First .. Second - 1));
         Label_Used_First  : constant Boolean := Label_Used (Label_First);
         Label_Second      : constant String  := Get_Label (Params (Second + 1 .. Params'Last - 1));
         Label_Used_Second : constant Boolean := Label_Used (Label_Second);
      begin
         Nonterm_Needed := True;

         if Label_Used_First and Label_Used_Second then
            return " (Tree, Nonterm, Tokens, " & Label_First & ", " & Label_Second & ")";

         elsif (not Label_Used_First) and Label_Used_Second then
            --  A copied EBNF RHS; see subprograms.wy Name
            return " (Tree, Nonterm, Tokens, " & Label_Second & ")";
         else
            Put_Error
              (Error_Message
                 (Grammar_File_Name, RHS.Source_Line, "merge_names token label error"));
            return " (Tree, Nonterm, Tokens)";
         end if;
      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);
         Label_First       : constant String  := Get_Label (Params (First .. Second - 1));
         Label_Second      : constant String  := Get_Label (Params (Second + 1 .. Params'Last - 1));
         Label_Used_First  : constant Boolean := Label_Used (Label_First);
         Label_Used_Second : constant Boolean := Label_Used (Label_Second);

         Result : Unbounded_String := +" (Tree, Tokens, ";
      begin
         --  Match_Names accepts 0 for absent token

         if Label_Used_First then
            Append (Result, Label_First);
         else
            Append (Result, "0");
         end if;
         Append (Result, ", ");

         if Label_Used_Second then
            Append (Result, Label_Second);
         else
            Append (Result, "0");
         end if;
         Append (Result, ", ");

         if Length (Input_Data.Language_Params.End_Names_Optional_Option) > 0 then
            Append (Result, -Input_Data.Language_Params.End_Names_Optional_Option);
         else
            Append (Result, "False");
         end if;
         Append (Result, ")");

         return -Result;
      end Match_Names_Params;

      function Language_Action_Params (Params : in String; Action_Name : in String) return String
      is
         --  Input looks like: [1 2 ...])
         Result      : Unbounded_String;
         Need_Comma  : Boolean := False;
         Param_Count : Integer := 0;
         First       : Integer;
         Last        : Integer := Params'First; --  '['
      begin
         loop
            First := Index_Non_Blank (Params, Last + 1);
            Last  := Index (Params, Space_Paren_Set, First);
            declare
               Label : constant String := Get_Label (Params (First .. Last - 1));
            begin
               if Label_Used (Label) then
                  Param_Count := Param_Count + 1;
                  if Need_Comma then
                     Result := Result & ", ";
                  else
                     Need_Comma := True;
                  end if;
                  Result := Result & Label;
               end if;
               exit when Params (Last) = ']';
               if Last = Params'Last then
                  Put_Error
                    (Error_Message
                       (Grammar_File_Name, RHS.Source_Line, Action_Name & " missing ']'"));
                  exit;
               end if;
            end;
         end loop;
         if Param_Count = 0 then
            return "";
         elsif Param_Count = 1 then
            return "(1 => " & (-Result) & ")";
         else
            return "(" & (-Result) & ")";
         end if;
      end Language_Action_Params;

      procedure Translate_Sexp (Line : in String)
      is
         Last       : constant Integer := Index (Line, Blank_Set);
         Elisp_Name : constant String  := Line (Line'First + 1 .. (if Last = 0 then Line'Last else Last) - 1);

         procedure Assert_Face_Empty
         is begin
            if Length (Face_Line) > 0 then
               Put_Error
                 (Error_Message
                    (Grammar_File_Name, RHS.Source_Line, "multiple face actions"));
            end if;
         end Assert_Face_Empty;

         procedure Assert_Indent_Empty
         is begin
            if Length (Indent_Action_Line) > 0 then
               Put_Error
                 (Error_Message
                    (Grammar_File_Name, RHS.Source_Line, "multiple indent actions"));
            end if;
         end Assert_Indent_Empty;

         procedure Assert_In_Parse_Action_Empty
         is begin
            if Length (In_Parse_Action_Line) > 0 then
               Put_Error
                 (Error_Message
                    (Grammar_File_Name, RHS.Source_Line, "multiple in_parse actions"));
            end if;
         end Assert_In_Parse_Action_Empty;

      begin
         --  wisi action/check functions, in same order as typically used in
         --  .wy files; Navigate, Face, Indent, actions.
         if Elisp_Name = "wisi-statement-action" then
            declare
               Params : constant String := Statement_Params (Line (Last + 1 .. Line'Last));
            begin
               if Params'Length > 0 then
                  Navigate_Lines.Append (Elisp_Name_To_Ada (Elisp_Name, False, 5) & Params & ";");
               end if;
            end;

         elsif Elisp_Name = "wisi-name-action" then
            declare
               First : constant Integer := Index_Non_Blank (Line, Last + 1);
               Last  : constant Integer := Index (Line, Space_Paren_Set, First);
               Label : constant String  := Get_Label (Line (First .. Last - 1));
            begin
               if Label_Used (Label) then
                  Nonterm_Needed := True;
                  Navigate_Lines.Append
                    ("Name_Action (Parse_Data, Tree, Nonterm, " & Label & ");");
               end if;
            end;

         elsif Elisp_Name = "wisi-motion-action" then
            declare
               Params : constant String := Motion_Params (Line (Last + 1 .. Line'Last));
            begin
               if Params'Length > 0 then
                  Navigate_Lines.Append (Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) & Params & ";");
               end if;
            end;

         elsif Elisp_Name = "wisi-face-apply-action" then
            Assert_Face_Empty;
            declare
               Params : constant String := Face_Apply_Params (Line (Last + 1 .. Line'Last));
            begin
               if Params'Length > 0 then
                  Face_Line := +Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) & Params & ";";
               end if;
            end;

         elsif Elisp_Name = "wisi-face-apply-list-action" then
            Assert_Face_Empty;
            declare
               Params : constant String := Face_Apply_Params (Line (Last + 1 .. Line'Last));
            begin
               if Params'Length > 0 then
                  Face_Line := +Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) & Params & ";";
               end if;
            end;

         elsif Elisp_Name = "wisi-face-mark-action" then
            Assert_Face_Empty;
            declare
               Params : constant String := Face_Mark_Params (Line (Last + 1 .. Line'Last));
            begin
               if Params'Length > 0 then
                  Face_Line := +Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) & Params & ";";
               end if;
            end;

         elsif Elisp_Name = "wisi-face-remove-action" then
            Assert_Face_Empty;
            declare
               Params : constant String := Face_Remove_Params (Line (Last + 1 .. Line'Last));
            begin
               if Params'Length > 0 then
                  Face_Line := +Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) & Params & ";";
               end if;
            end;

         elsif Elisp_Name = "wisi-indent-action" then
            Assert_Indent_Empty;
            Indent_Action_Line := +"Indent_Action_0" & Indent_Params (Line (Last + 1 .. Line'Last)) & ";";

         elsif Elisp_Name = "wisi-indent-action*" then
            Assert_Indent_Empty;
            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;

         elsif Elisp_Name = "wisi-propagate-name" then
            declare
               Label : constant String := Get_Label (Line (Last + 1 .. Line'Last - 1));
            begin
               if Label_Used (Label) then
                  Assert_In_Parse_Action_Empty;
                  Nonterm_Needed := True;
                  In_Parse_Action_Line := +"return " & Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) &
                    " (Tree, Nonterm, Tokens, " & Label & ");";
               end if;
            end;

         elsif Elisp_Name = "wisi-merge-names" then
            Assert_In_Parse_Action_Empty;
            In_Parse_Action_Line := +"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
            declare
               Params : constant String := Match_Names_Params (Line (Last + 1 .. Line'Last));
            begin
               if Params'Length > 0 then
                  Assert_In_Parse_Action_Empty;
                  In_Parse_Action_Line := +"return " & Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) &
                    Params & ";";
               end if;
            end;

         elsif Elisp_Name = "wisi-terminate-partial-parse" then
            Assert_In_Parse_Action_Empty;
            Nonterm_Needed := True;
            In_Parse_Action_Line :=
              +"return Terminate_Partial_Parse (Tree, Partial_Parse_Active, Partial_Parse_Byte_Goal, " &
              "Recover_Active, Nonterm);";

         elsif Input_Data.Tokens.Actions.Contains (+Elisp_Name) then
            --  Language-specific post-parse action (used in wisitoken grammar
            --  mode for wisi-check-parens).
            --
            --  IMPROVEME: handle labels for token args. wisitoken-grammar declares
            --  wisi-check-parens, but uses BNF syntax, so no token labels are
            --  needed.
            declare
               Item   : String_Pair_Type renames Input_Data.Tokens.Actions.Constant_Reference (+Elisp_Name);
               Params : constant String := Language_Action_Params (Line (Last + 1 .. Line'Last), Elisp_Name);
               Code   : constant String := -Item.Value &
                 " (Wisi.Parse_Data_Type'Class (User_Data), Tree, Nonterm, " & Params & ");";
            begin
               Nonterm_Needed := True;

               if Params'Length > 0 then
                  if "navigate" = -Item.Name then
                     Navigate_Lines.Append (Code);

                  elsif "face" = -Item.Name then
                     Assert_Face_Empty;
                     Face_Line := +Code;

                  elsif "indent" = -Item.Name then
                     Assert_Indent_Empty;
                     Indent_Action_Line := +Code;

                  else
                     Put_Error
                       (Error_Message
                          (Grammar_File_Name, RHS.Source_Line, "unrecognized post-parse action: '" &
                             (-Item.Name) & "'"));
                  end if;

                  --  else skip
               end if;
            end;
         else
            Put_Error
              (Error_Message
                 (Grammar_File_Name, RHS.Source_Line, "unrecognized elisp action: '" &
                    Elisp_Name & "'"));
         end if;
      end Translate_Sexp;

      Subprogram_Started : Boolean := False;
   begin
      for Sexp of Sexps loop
         begin
            Translate_Sexp (Sexp);
         exception
         when E : Not_Found =>
            Put_Error
              (Error_Message
                 (Grammar_File_Name, RHS.Source_Line, Ada.Exceptions.Exception_Message (E)));

         when E : others =>
            Put_Error
              (Error_Message
                 (Grammar_File_Name, RHS.Source_Line, "RHS: '" & Image (RHS.Tokens)));
            Put_Error
              (Error_Message
                 (Grammar_File_Name, RHS.Source_Line, "... Sexp: '" & Sexp));
            Put_Error
              (Error_Message
                 (Grammar_File_Name, RHS.Source_Line, "... " & Ada.Exceptions.Exception_Message (E)));
            raise;
         end;
      end loop;

      if In_Parse_Action then
         if Length (In_Parse_Action_Line) = 0 then
            Empty := True; -- don't output a spec for this.

         else
            Empty              := False;
            Subprogram_Started := True;
            Indent_Line ("function " & Name);
            Indent_Line (" (Tree           : in     WisiToken.Syntax_Trees.Tree;");
            Indent_Line ("  Nonterm        : in out WisiToken.Syntax_Trees.Recover_Token;");
            Indent_Line ("  Tokens         : in     WisiToken.Syntax_Trees.Recover_Token_Array;");
            Indent_Line ("  Recover_Active : in     Boolean)");
            Indent_Line (" return WisiToken.Syntax_Trees.In_Parse_Actions.Status");
            declare
               Unref_Tree    : constant Boolean := 0 = Index (In_Parse_Action_Line, "Tree");
               Unref_Nonterm : constant Boolean := 0 = Index (In_Parse_Action_Line, "Nonterm");
               Unref_Tokens  : constant Boolean := 0 = Index (In_Parse_Action_Line, "Tokens");
               Unref_Recover : constant Boolean := 0 = Index (In_Parse_Action_Line, "Recover_Active");
               Need_Comma    : Boolean          := False;
            begin
               if Unref_Tree or Unref_Nonterm or Unref_Tokens or Unref_Recover or
                 (for some I of Label_Needed => I)
               then
                  Indent_Line ("is");

                  Indent := Indent + 3;
                  if Unref_Tree or Unref_Nonterm or Unref_Tokens or Unref_Recover then
                     Indent_Start ("pragma Unreferenced (");

                     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;
                     if Unref_Recover then
                        Put ((if Need_Comma then ", " else "") & "Recover_Active");
                        Need_Comma := True;
                     end if;
                     Put_Line (");");
                  end if;

                  for I in Label_Needed'Range loop
                     if Label_Needed (I) then
                        Indent_Line
                          (-Rule.Labels (I) & " : constant SAL.Peek_Type :=" &
                             SAL.Peek_Type'Image (Find_Token_Index (I)) & ";");
                     end if;
                  end loop;
                  Indent := Indent - 3;

                  Indent_Line ("begin");
               else
                  Indent_Line ("is begin");
               end if;
            end;
            Indent := Indent + 3;
            Indent_Line (-In_Parse_Action_Line);
         end if;
      else
         --  In an action
         Empty              := False;
         Subprogram_Started := True;
         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_Access)");
         Indent_Line ("is");

         Indent := Indent + 3;
         Indent_Line ("Parse_Data : Wisi.Parse_Data_Type renames Wisi.Parse_Data_Type (User_Data);");

         if not Nonterm_Needed then
            --  Language_Action may not use this
            Indent_Line ("pragma Unreferenced (Nonterm);");
         end if;

         for I in Label_Needed'Range loop
            if Label_Needed (I) then
               Indent_Line
                 (-Rule.Labels (I) & " : constant SAL.Peek_Type :=" &
                    SAL.Peek_Type'Image (Find_Token_Index (I)) & ";");
            end if;
         end loop;

         Indent := Indent - 3;
         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;

      if Subprogram_Started then
         Indent := Indent - 3;
         Indent_Line ("end " & Name & ";");
         New_Line;
      end if;

   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.Post_Parse_Action, Grammar_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
     (Post_Parse_Action_Names : not null access WisiToken.Names_Array_Array;
      In_Parse_Action_Names   : not null access WisiToken.Names_Array_Array;
      Label_Count             : in              Ada.Containers.Count_Type;
      Package_Name            : in              String)
   is
      use Ada.Strings.Unbounded;
      use Generate_Utils;
      use WisiToken.Generate;

      File_Name : constant String := To_Lower (Package_Name) & ".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;

      if Label_Count > 0 then
         Put_Line ("with SAL;");
      end if;

      Put_Line ("with Wisi; use Wisi;");
      if Input_Data.Language_Params.Use_Language_Runtime then
         declare
            Pkg : constant String :=
              (if -Input_Data.Language_Params.Language_Runtime_Name = ""
               then Default_Language_Runtime_Package
               else -Input_Data.Language_Params.Language_Runtime_Name);
         begin
            --  For language-specific names in actions, checks.
            Put_Line ("with " & Pkg & "; use " & Pkg & ";");
         end;
      end if;

      if Input_Data.In_Parse_Action_Count > 0 then
         Indent_Line ("with WisiToken.In_Parse_Actions; use WisiToken.In_Parse_Actions;"); -- Match_Names etc.
      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.In_Parse_Action_Count > 0 then
         Indent_Line ("use WisiToken.Syntax_Trees.In_Parse_Actions;");
      end if;
      if Motion_Actions then
         Indent_Line ("use all type Motion_Param_Array;");
      end if;
      New_Line;

      --  generate Post_Parse_Action and In_Parse_Action 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);
            RHS_Index : Integer                     := 0;
            Empty     : Boolean;
         begin
            for RHS of Rule.Right_Hand_Sides loop
               if Length (RHS.Post_Parse_Action) > 0 then
                  declare
                     Name : constant String := Post_Parse_Action_Names (LHS_ID)(RHS_Index).all;
                  begin
                     Create_Ada_Action
                       (Name, RHS, (LHS_ID, RHS_Index), RHS.Post_Parse_Action, Rule, Empty,
                        In_Parse_Action => False);
                     if Empty then
                        Post_Parse_Action_Names (LHS_ID)(RHS_Index) := null;
                     end if;
                  exception
                  when others =>
                     Put_Error (Error_Message (Grammar_File_Name, RHS.Source_Line, "fatal internal error"));
                     raise;
                  end;
               end if;

               if Length (RHS.In_Parse_Action) > 0 then
                  declare
                     Name  : constant String := In_Parse_Action_Names (LHS_ID)(RHS_Index).all;
                  begin
                     Create_Ada_Action
                       (Name, RHS, (LHS_ID, RHS_Index), RHS.In_Parse_Action, Rule, Empty,
                        In_Parse_Action => True);
                     if Empty then
                        In_Parse_Action_Names (LHS_ID)(RHS_Index) := null;
                     end if;
                  end;
               end if;
               RHS_Index := RHS_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;
      use Generate_Utils;

      Body_File : File_Type;
   begin
      Create (Body_File, Out_File, To_Lower (Main_Package_Name) & ".adb");
      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;

      case Common_Data.Lexer is
      when None | Tree_Sitter_Lexer =>
         null;

      when re2c_Lexer =>
         Put_Line ("with SAL;");
         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 not Input_Data.Language_Params.Error_Recover then
            Put_Line ("with WisiToken.Parse.LR;");
         end if;

      when Packrat_Proc =>
         Put_Line ("with WisiToken.Productions;");

      when Packrat_Gen =>
         Put_Line ("with WisiToken.Parse.Packrat.Parser;");

      when External | Tree_Sitter =>
         null;
      end case;

      Put_Line ("with " & Actions_Package_Name & "; use " & Actions_Package_Name & ";");

      Put_Line ("package body " & Main_Package_Name & " is");
      Indent := Indent + 3;
      New_Line;

      case Common_Data.Lexer is
      when None | Tree_Sitter_Lexer =>
         null;

      when re2c_Lexer =>
         Create_re2c_Lexer (Generate_Data, Output_File_Name_Root);
      end case;

      case Common_Data.Generate_Algorithm is
      when LR_Generate_Algorithm =>
         LR_Create_Create_Parse_Table (Input_Data, Common_Data, Generate_Data);
         Create_Create_Productions (Generate_Data);
         LR_Create_Create_Parser (Actions_Package_Name, Common_Data, Generate_Data);

      when Packrat_Gen =>
         WisiToken.BNF.Generate_Packrat (Packrat_Data.all, Generate_Data);
         Create_Create_Productions (Generate_Data);
         Packrat_Create_Create_Parser (Actions_Package_Name, Common_Data, Generate_Data, Packrat_Data.all);

      when Packrat_Proc =>
         Create_Create_Productions (Generate_Data);
         Packrat_Create_Create_Parser (Actions_Package_Name, Common_Data, Generate_Data, Packrat_Data.all);

      when External =>
         External_Create_Create_Grammar (Generate_Data);

      when Tree_Sitter =>
         null;
      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.Tokens (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;

      File_Name_Root : constant String := Output_File_Name_Root &
        "-process" &
        (if Need_Gen_Alg_In_Actions_Name
         then "-" & To_Lower (Tuple.Gen_Alg'Image)
         else "");

      File_Name : constant String := File_Name_Root & ".el";

      Paren_1_Done : Boolean := False;
   begin
      Create (File, Out_File, File_Name);

      Set_Output (File);
      Indent := 1;

      --  We can't use Put_File_Header here because it does not output the
      --  file name.
      Put_Line
        (";;; " & File_Name & " --- Generated parser support file  -*- buffer-read-only:t 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 " & File_Name_Root & "-token-table");
      Indent_Start ("  [");
      Indent := Indent + 3;
      for Cursor in All_Tokens (Generate_Data).Iterate loop
         if Paren_1_Done then
            Indent_Line (Name (Generate_Data, Cursor));
         else
            Paren_1_Done := True;
            Put_Line (Name (Generate_Data, Cursor));
         end if;

      end loop;
      Indent_Line ("])");
      Indent := Indent - 3;
      New_Line;

      Output_Elisp_Common.Indent_Name_Table (File_Name_Root, "face-table", Input_Data.Tokens.Faces);

      --  We need -repair-image for wisi-repair-error
      New_Line;
      Output_Elisp_Common.Indent_Repair_Image (File_Name_Root, "", Input_Data.Tokens);

      New_Line;
      Put_Line ("(provide '" & File_Name_Root & ")");
      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;

      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 " & Grammar_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 (" & Output_File_Name_Root &
           "-wisi-module-parser (:include wisi-parser)))");
      New_Line;
      Indent_Line ("(defun " & Output_File_Name_Root & "-wisi-module-parser-make (dll-name)");
      Indent_Line ("  (module-load dll-name)");
      Indent_Line ("  (make-" & Output_File_Name_Root & "-wisi-module-parser))");
      New_Line;

      Indent_Line ("(defvar " & Output_File_Name_Root & "-module-lexer nil)");
      Indent_Line
        ("(declare-function " &
           Output_File_Name_Root &
           "-wisi-module-parse """ &
           Output_File_Name_Root &
           "-wisi-module-parse.c"")");
      New_Line;

      Indent_Line
        ("(cl-defmethod wisi-parse-current ((parser " &
           Output_File_Name_Root &
           "-wisi-module-parser))");
      Indent := Indent + 2;
      Indent_Line ("(let* ((wisi-lexer " & Output_File_Name_Root & "-module-lexer)");
      Indent_Line ("       (result (" & Output_File_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);

      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 " & Grammar_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 ("""" & Output_File_Name_Root & "_module.adb"",");
      Indent_Line ("""" & Output_File_Name_Root & "_module.ads""");
      Indent := Indent - 3;
      Indent_Line ("  );");
      New_Line;
      Indent_Line ("for Object_Dir use ""libobjsjlj"";");
      Indent_Line ("for Library_Name use """ & Output_File_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 (""" & Output_File_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 (""" & Output_File_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 " & Grammar_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 (""" & Output_File_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 " & Grammar_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 " & Output_File_Name_Root & "_wisi_module_parse_init (emacs_env *env);");
      Indent_Line ("/* Parse current buffer, using parser in current module. */");
      Indent_Line ("extern emacs_value " & Output_File_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 " & Output_File_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, """ & Output_File_Name_Root &
           "-wisi-module-parse"", env->make_function (env, 1, 1, Fparse));");
      Indent_Line ("  adainit();");
      Indent_Line ("  return " & Output_File_Name_Root & "_wisi_module_parse_init (env);");
      Indent_Line ("}");
      Set_Output (Standard_Output);
      Close (File);
   end Create_Module_Aux;

begin
   declare
      Actions_Package_Name : constant String := File_Name_To_Ada (Output_File_Name_Root) &
        (case Common_Data.Interface_Kind is
         when Process => "_Process",
         when Module  => "_Module") &
        (if Need_Gen_Alg_In_Actions_Name
         then "_" & Generate_Algorithm_Image (Tuple.Gen_Alg).all
         else "") &
        "_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
      if Input_Data.Post_Parse_Action_Count > 0 or Input_Data.In_Parse_Action_Count > 0 then
         --  We typically have no actions when just getting started with a new language.
         Create_Ada_Actions_Body
           (Generate_Data.Post_Parse_Action_Names, Generate_Data.In_Parse_Action_Names, Input_Data.Label_Count,
            Actions_Package_Name);
      end if;

      Create_Ada_Actions_Spec
        (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
           (Main_Package_Name => Main_Package_Name,
            Common_Data       => Common_Data,
            Input_Data        => Input_Data);
      end if;

      --  We can't create a test_main here, because we don't have the wisi
      --  package for the actions.
   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;