-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset 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. The SPARK toolset 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 SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================

with Statistics;
with SystemErrors;

package body STree is

   type NodeValue is record
      NodeType            : SP_Symbols.SP_Symbol;
      Position            : LexTokenManager.Token_Position;
      Parent, Next, Child : SyntaxNode;
      Token_Str           : LexTokenManager.Lex_String;
      -- case ??? is
      --   when ??? =>
      Ref_Str : LexTokenManager.Lex_String;
      --   when ??? =>
      Ref_Sym : Dictionary.Symbol;
      -- end case;
   end record;

   type SyntaxTreeContents is array (SyntaxNode) of NodeValue;

   type TableStructure is record
      FreeList       : SyntaxNode;
      TopUsed        : SyntaxNode;
      CurrSyntaxNode : SyntaxNode;
      Contents       : SyntaxTreeContents;
   end record;

   Table : TableStructure;

   ------------------------------------------------------------------------

   procedure RetrieveCurrentRoot (Root : out SyntaxNode) is
   begin
      Root                 := Table.CurrSyntaxNode;
      Table.CurrSyntaxNode := NullNode;
   end RetrieveCurrentRoot;

   ------------------------------------------------------------------------

   function NodeToRef (Node : SyntaxNode) return ExaminerConstants.RefType is
   begin
      return ExaminerConstants.RefType (Node);
   end NodeToRef;

   ------------------------------------------------------------------------

   function RefToNode (Ref : ExaminerConstants.RefType) return SyntaxNode is
   begin
      return SyntaxNode (Ref);
   end RefToNode;

   ------------------------------------------------------------------------

   procedure AllocateNode (Node : out SyntaxNode)
   --# global in out Table;
   --# derives Node,
   --#         Table from Table;
   is
      NewNode : SyntaxNode;
   begin
      if Table.FreeList /= NullNode then
         NewNode := Table.FreeList;
         -- Child field used as free list pointer.
         Table.FreeList := Table.Contents (Table.FreeList).Child;
      elsif Table.TopUsed /= SyntaxTreeContents'Last then
         Table.TopUsed := Table.TopUsed + 1;
         NewNode       := Table.TopUsed;
      else
         NewNode := NullNode;
      end if;

      if NewNode = NullNode then
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Syntax_Tree_Overflow,
                                   Msg     => "in STree.AllocateNode");
      else
         Table.Contents (NewNode) :=
           NodeValue'
           (NodeType  => SP_Symbols.SPEND,
            Position  => LexTokenManager.Null_Token_Position,
            Parent    => NullNode,
            Next      => NullNode,
            Child     => NullNode,
            Token_Str => LexTokenManager.Null_String,
            Ref_Str   => LexTokenManager.Null_String,
            Ref_Sym   => Dictionary.NullSymbol);
      end if;

      Node := NewNode;
   end AllocateNode;

   ------------------------------------------------------------------------

   procedure NewProduction (Production : in     SP_Symbols.SP_Non_Terminal;
                            Node       :    out SyntaxNode) is
      CurrNode : SyntaxNode;
   begin
      AllocateNode (CurrNode);
      Table.Contents (CurrNode).NodeType := Production;
      Table.CurrSyntaxNode               := CurrNode;
      Node                               := CurrNode;
   end NewProduction;

   ------------------------------------------------------------------------

   procedure NewTerminal
     (Terminal    : in     SP_Symbols.SP_Terminal;
      TerminalVal : in     LexTokenManager.Lex_Value;
      Node        :    out SyntaxNode)
   is
      CurrNode : SyntaxNode;
   begin
      AllocateNode (CurrNode);
      Table.Contents (CurrNode).NodeType  := Terminal;
      Table.Contents (CurrNode).Position  := TerminalVal.Position;
      Table.Contents (CurrNode).Token_Str := TerminalVal.Token_Str;
      Table.Contents (CurrNode).Ref_Str   := TerminalVal.Token_Str;
      Node                                := CurrNode;
   end NewTerminal;

   ------------------------------------------------------------------------

   procedure AddDerivative (Child_Node : in SyntaxNode) is
      CurrNode    : SyntaxNode;
      LastChild   : SyntaxNode;
      ThePosition : LexTokenManager.Token_Position;
   begin
      CurrNode  := Table.CurrSyntaxNode;
      LastChild := Table.Contents (CurrNode).Child;
      if LastChild = NullNode then
         Table.Contents (CurrNode).Child    := Child_Node;
         ThePosition                        := Table.Contents (Child_Node).Position;
         Table.Contents (CurrNode).Position := ThePosition;
      else
         loop
            exit when Table.Contents (LastChild).Next = NullNode;
            LastChild := Table.Contents (LastChild).Next;
         end loop;
         if Table.Contents (CurrNode).Position = LexTokenManager.Null_Token_Position then
            ThePosition                        := Table.Contents (Child_Node).Position;
            Table.Contents (CurrNode).Position := ThePosition;
         end if;
         Table.Contents (LastChild).Next := Child_Node;
      end if;
      Table.Contents (Child_Node).Parent := CurrNode;
   end AddDerivative;

   ------------------------------------------------------------------------

   procedure AddChildNode (Node         : in SyntaxNode;
                           ChildNode    : in SyntaxNode;
                           LinkToParent : in Boolean) is
      LastChild : SyntaxNode;
   begin
      LastChild := Table.Contents (Node).Child;
      if LastChild = NullNode then
         Table.Contents (Node).Child := ChildNode;
      else
         loop
            exit when Table.Contents (LastChild).Next = NullNode;
            LastChild := Table.Contents (LastChild).Next;
         end loop;
         Table.Contents (LastChild).Next := ChildNode;
      end if;
      if LinkToParent then
         Table.Contents (ChildNode).Parent := Node;
      end if;
   end AddChildNode;

   ------------------------------------------------------------------------

   function Child_Node (Current_Node : SyntaxNode) return SyntaxNode is
   begin
      return Table.Contents (Current_Node).Child;
   end Child_Node;

   ------------------------------------------------------------------------

   function Next_Sibling (Current_Node : SyntaxNode) return SyntaxNode is
   begin
      SystemErrors.RT_Assert
        (C       => Current_Node /= NullNode,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "STree.Next_Sibling : Program Error");
      return Table.Contents (Current_Node).Next;
   end Next_Sibling;

   ------------------------------------------------------------------------

   function Parent_Node (Current_Node : SyntaxNode) return SyntaxNode is
   begin
      SystemErrors.RT_Assert
        (C       => Current_Node /= NullNode,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "STree.Parent_Node : Program Error");
      return Table.Contents (Current_Node).Parent;
   end Parent_Node;

   ------------------------------------------------------------------------

   function Syntax_Node_Type (Node : SyntaxNode) return SP_Symbols.SP_Symbol is
   begin
      return Table.Contents (Node).NodeType;
   end Syntax_Node_Type;

   ------------------------------------------------------------------------

   function Node_Position (Node : SyntaxNode) return LexTokenManager.Token_Position is
      Position : LexTokenManager.Token_Position;
   begin
      if Node = NullNode then
         Position := LexTokenManager.Null_Token_Position;
      else
         Position := Table.Contents (Node).Position;
      end if;
      return Position;
   end Node_Position;

   ------------------------------------------------------------------------

   procedure Set_Node_Lex_String (Sym  : in Dictionary.Symbol;
                                  Node : in SyntaxNode) is
      Str : LexTokenManager.Lex_String;
   begin
      Str := Dictionary.GetSimpleName (Item => Sym);
      SystemErrors.RT_Assert
        (C       => Node /= NullNode
           and then Syntax_Node_Type (Node => Node) in SP_Symbols.SP_Terminal
           and then LexTokenManager.Lex_String_Case_Insensitive_Compare
           (Lex_Str1 => Str,
            Lex_Str2 => Table.Contents (Node).Ref_Str) =
           LexTokenManager.Str_Eq,
         Sys_Err => SystemErrors.Other_Internal_Error,
         Msg     => "STree.Set_Node_Lex_String : Program Error");
      Table.Contents (Node).Ref_Str := Str;
   end Set_Node_Lex_String;

   ------------------------------------------------------------------------

   function Node_Lex_String (Node : SyntaxNode) return LexTokenManager.Lex_String is
   begin
      SystemErrors.RT_Assert
        (C       => Node /= NullNode and then Syntax_Node_Type (Node => Node) in SP_Symbols.SP_Terminal,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Node = SP_Symbols.SP_Terminal in STree.Node_Lex_String");
      return Table.Contents (Node).Ref_Str;
   end Node_Lex_String;

   ------------------------------------------------------------------------

   function Node_Token_String (Node : SyntaxNode) return LexTokenManager.Lex_String is
   begin
      return Table.Contents (Node).Token_Str;
   end Node_Token_String;

   ------------------------------------------------------------------------

   procedure CollectNode (Node : in SyntaxNode)
   --# global in out Table;
   --# derives Table from *,
   --#                    Node;
   is
      TheNodeValue : NodeValue;
   begin
      TheNodeValue                := Table.Contents (NullNode);
      Table.Contents (Node)       := TheNodeValue;
      Table.Contents (Node).Child := Table.FreeList;
      Table.FreeList              := Node;
   end CollectNode;

   ----------------------------------------------------------------------

   procedure DeleteSyntaxTree (Root          : in SyntaxNode;
                               KeepConstants : in Boolean) is
      CurrNode, The_Next_Node, TempNode : SyntaxNode;
   begin
      CurrNode := Root;
      loop
         The_Next_Node := Child_Node (CurrNode);

         --  Subprogram constraints are needed by the VCG later, so we
         --  don't return such nodes to the free list. Similarly,
         --  constant declarations are needed by the Declarations
         --  package for proof rule generation. Furthermore, we also
         --  need to protect generic_actual_part to preserve
         --  expressions used to initialize generic formal objects. We
         --  need also to keep inherit_clause to calculate the
         --  dependency closure.
         while The_Next_Node /= NullNode
           and then ((Syntax_Node_Type (Node => The_Next_Node) = SP_Symbols.procedure_constraint) or
                       (Syntax_Node_Type (Node => The_Next_Node) = SP_Symbols.function_constraint) or
                       (KeepConstants and Syntax_Node_Type (Node => The_Next_Node) = SP_Symbols.constant_declaration) or
                       (Syntax_Node_Type (Node => The_Next_Node) = SP_Symbols.generic_actual_part) or
                       (Syntax_Node_Type (Node => The_Next_Node) = SP_Symbols.inherit_clause)) loop
            Table.Contents (The_Next_Node).Parent := NullNode;
            TempNode                              := Next_Sibling (The_Next_Node);
            Table.Contents (The_Next_Node).Next   := NullNode;
            The_Next_Node                         := TempNode;
         end loop;

         if The_Next_Node = NullNode then
            loop
               The_Next_Node := Next_Sibling (CurrNode);
               while The_Next_Node /= NullNode
                 and then ((Syntax_Node_Type (Node => The_Next_Node) = SP_Symbols.procedure_constraint) or
                             (Syntax_Node_Type (Node => The_Next_Node) = SP_Symbols.function_constraint) or
                             (KeepConstants and Syntax_Node_Type (Node => The_Next_Node) = SP_Symbols.constant_declaration) or
                             (Syntax_Node_Type (Node => The_Next_Node) = SP_Symbols.generic_actual_part) or
                             (Syntax_Node_Type (Node => The_Next_Node) = SP_Symbols.inherit_clause)) loop
                  Table.Contents (The_Next_Node).Parent := NullNode;
                  TempNode                              := Next_Sibling (The_Next_Node);
                  Table.Contents (The_Next_Node).Next   := NullNode;
                  The_Next_Node                         := TempNode;
               end loop;
               if The_Next_Node /= NullNode then
                  CollectNode (CurrNode);
                  exit;
               end if;
               The_Next_Node := Parent_Node (Current_Node => CurrNode);
               CollectNode (CurrNode);
               exit when The_Next_Node = NullNode;
               CurrNode := The_Next_Node;
            end loop;
         end if;
         exit when The_Next_Node = NullNode;
         CurrNode := The_Next_Node;
      end loop;
   end DeleteSyntaxTree;

   -----------------------------------------------------------------------

   function TraverseAcross (RootNode : SyntaxNode;
                            CurrNode : SyntaxNode) return SyntaxNode
   --# global in Table;
   -- Traverses across the tree in a pre-order fashion.
   is
      The_Next_Node : SyntaxNode;
   begin
      The_Next_Node := CurrNode;
      while The_Next_Node /= NullNode loop
         if The_Next_Node = RootNode then
            The_Next_Node := NullNode;
            exit;
         end if;
         if Next_Sibling (The_Next_Node) /= NullNode then
            The_Next_Node := Next_Sibling (The_Next_Node);
            exit;
         end if;
         The_Next_Node := Parent_Node (Current_Node => The_Next_Node);
      end loop;
      return The_Next_Node;
   end TraverseAcross;

   -----------------------------------------------------------------------

   function Traverse (RootNode : SyntaxNode;
                      CurrNode : SyntaxNode) return SyntaxNode
   --# global in Table;
   -- Traverses the tree in a pre-order fashion.
   is
      The_Next_Node : SyntaxNode;
   begin
      if Child_Node (CurrNode) /= NullNode then
         -- Depth first
         The_Next_Node := Child_Node (CurrNode);
      else
         -- breadth next
         The_Next_Node := TraverseAcross (RootNode, CurrNode);
      end if;
      return The_Next_Node;
   end Traverse;

   -----------------------------------------------------------------------

   function Last_Child_Of (Start_Node : SyntaxNode) return SyntaxNode is
      Last_Valid_Node_Found, Current_Node : SyntaxNode;
   begin
      SystemErrors.RT_Assert
        (C       => Start_Node /= NullNode,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "STree.Last_Child_Of : Program Error");
      Last_Valid_Node_Found := Start_Node;
      Current_Node          := Start_Node;
      while Current_Node /= NullNode loop
         Last_Valid_Node_Found := Current_Node;
         Current_Node          := Child_Node (Current_Node => Current_Node);
      end loop;
      return Last_Valid_Node_Found;
   end Last_Child_Of;

   --------------------------------------------------------------

   function Last_Sibling_Of (Start_Node : SyntaxNode) return SyntaxNode is
      Last_Valid_Node_Found, Current_Node : SyntaxNode;
   begin
      SystemErrors.RT_Assert
        (C       => Start_Node /= NullNode,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "STree.Last_Sibling_Of : Program Error");
      Last_Valid_Node_Found := Start_Node;
      Current_Node          := Start_Node;
      while Current_Node /= NullNode loop
         Last_Valid_Node_Found := Current_Node;
         Current_Node          := Next_Sibling (Current_Node => Current_Node);
      end loop;
      return Last_Valid_Node_Found;
   end Last_Sibling_Of;

   --------------------------------------------------------------------

   procedure Add_Node_Symbol (Node : in SyntaxNode;
                              Sym  : in Dictionary.Symbol) is
   begin
      if Dictionary.Is_Null_Symbol (Table.Contents (Node).Ref_Sym) then
         Table.Contents (Node).Ref_Sym := Sym;
      elsif Table.Contents (Node).Ref_Sym /= Sym then
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Syntax_Tree_Walk_Error,
                                   Msg     => "in STree.Add_Node_Symbol");
      end if;
      --# accept Flow, 30, Dictionary.Dict, "Variable not referenced nor exported OK";
   end Add_Node_Symbol;

   --------------------------------------------------------------------

   function NodeSymbol (Node : SyntaxNode) return Dictionary.Symbol is
      Sym : Dictionary.Symbol;
   begin
      Sym := Table.Contents (Node).Ref_Sym;
      return Sym;
   end NodeSymbol;

   -------------------------------------------------------

   procedure ReportUsage is
   begin
      -- TopUsed is peak usage, because freelist is used up before allocating
      -- a new cell at the top of the table
      Statistics.SetTableUsage (Statistics.SyntaxTree, Integer (Table.TopUsed));
   end ReportUsage;

   -------------------------------------------------------

   function NextNodeType (It : Iterator) return Iterator
   --# global in Table;
   is
      Node   : SyntaxNode;
      NextIt : Iterator;
   begin
      Node := It.Current;
      while Node /= NullNode loop
         --# accept Flow, 41, "Expected stable expression";
         if It.SearchDirection = Down then -- expect stable expression
            if Syntax_Node_Type (Node => Node) = It.SearchNodeType then
               -- This node was returned in the search so ignore all nodes
               -- below it.
               Node := TraverseAcross (It.Root, Node);
            else
               -- Get the next pre-order node
               Node := Traverse (RootNode => It.Root,
                                 CurrNode => Node);
            end if;
         else
            Node := Parent_Node (Current_Node => Node);
         end if;
         --# end accept;
         exit when Syntax_Node_Type (Node => Node) = It.SearchNodeType;
      end loop;

      if Node = NullNode then
         NextIt := NullIterator;
      else
         NextIt :=
           Iterator'
           (TheSearchKind   => It.TheSearchKind,
            SearchNodeType  => It.SearchNodeType,
            SearchDirection => It.SearchDirection,
            Current         => Node,
            Root            => It.Root);
      end if;
      return NextIt;
   end NextNodeType;

   -------------------------------------------------------

   function IsBranchNode (Node : SyntaxNode) return Boolean
   --# global in Table;
   is
   begin
      return Node /= NullNode
        and then
        -- has more than one child
        Child_Node (Node) /= NullNode
        and then Next_Sibling (Child_Node (Node)) /= NullNode;
   end IsBranchNode;

   -------------------------------------------------------

   function NextBranch (It : Iterator) return Iterator
   --# global in Table;
   is
      Node   : SyntaxNode;
      NextIt : Iterator;
   begin
      Node := It.Current;
      while Node /= NullNode loop
         --# accept Flow, 41, "Expected stable expression";
         if It.SearchDirection = Down then -- expect stable expression
            Node := Traverse (RootNode => It.Root,
                              CurrNode => Node);
         else
            Node := Parent_Node (Current_Node => Node);
         end if;
         --# end accept;
         exit when IsBranchNode (Node);
      end loop;

      if Node = NullNode then
         NextIt := NullIterator;
      else
         NextIt :=
           Iterator'
           (TheSearchKind   => It.TheSearchKind,
            SearchNodeType  => It.SearchNodeType,
            SearchDirection => It.SearchDirection,
            Current         => Node,
            Root            => It.Root);
      end if;
      return NextIt;
   end NextBranch;

   -------------------------------------------------------

   function IsFormalParameterNode (Node     : SyntaxNode;
                                   RootNode : SyntaxNode) return Boolean
   --# global in Table;
   is
      MyNode : SyntaxNode;
      Result : Boolean;
   begin
      if Syntax_Node_Type (Node => Node) /= SP_Symbols.identifier
        or else Syntax_Node_Type (Node => Parent_Node (Current_Node => Node)) /= SP_Symbols.simple_name then
         Result := False;
      else
         Result := True;
         MyNode := Node;
         while MyNode /= RootNode loop
            if Syntax_Node_Type (Node => MyNode) = SP_Symbols.expression then
               Result := False;
               exit;
            end if;
            MyNode := Parent_Node (Current_Node => MyNode);
         end loop;
      end if;
      return Result;
   end IsFormalParameterNode;

   -------------------------------------------------------

   function NextFormalParameter (It : Iterator) return Iterator
   --# global in Table;
   is
      Node   : SyntaxNode;
      NextIt : Iterator;
   begin
      Node := It.Current;
      while Node /= NullNode loop
         Node := Traverse (RootNode => It.Root,
                           CurrNode => Node);
         exit when IsFormalParameterNode (Node, It.Root);
      end loop;

      if Node = NullNode then
         NextIt := NullIterator;
      else
         NextIt :=
           Iterator'
           (TheSearchKind   => It.TheSearchKind,
            SearchNodeType  => It.SearchNodeType,
            SearchDirection => It.SearchDirection,
            Current         => Node,
            Root            => It.Root);
      end if;
      return NextIt;
   end NextFormalParameter;

   -------------------------------------------------------

   function NextNode (It : Iterator) return Iterator is
      NextIt : Iterator;
   begin
      case It.TheSearchKind is
         when Undefined =>
            NextIt := NullIterator;
            SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Syntax_Tree_Walk_Error,
                                      Msg     => "in STree.NextNode");
         when NodeTypeSearch =>
            NextIt := NextNodeType (It);
         when BranchSearch =>
            NextIt := NextBranch (It);
         when FormalParameterSearch =>
            NextIt := NextFormalParameter (It);
      end case;
      return NextIt;
   end NextNode;

   -------------------------------------------------------

   function Get_Node (It : Iterator) return SyntaxNode is
   begin
      return It.Current;
   end Get_Node;

   -------------------------------------------------------

   function IsNull (It : Iterator) return Boolean is
   begin
      return It = NullIterator;
   end IsNull;

   -------------------------------------------------------

   function Find_First_Node
     (Node_Kind    : SP_Symbols.SP_Symbol;
      From_Root    : SyntaxNode;
      In_Direction : TraverseDirection)
     return         Iterator
   is
      It : Iterator;
   begin
      It :=
        Iterator'
        (TheSearchKind   => NodeTypeSearch,
         SearchNodeType  => Node_Kind,
         SearchDirection => In_Direction,
         Current         => From_Root,
         Root            => From_Root);

      if Syntax_Node_Type (Node => From_Root) /= It.SearchNodeType then
         It := NextNode (It);
      end if;
      return It;
   end Find_First_Node;

   -------------------------------------------------------

   function Find_First_Branch_Node (From_Root    : SyntaxNode;
                                    In_Direction : TraverseDirection) return Iterator is
      It : Iterator;
   begin
      It :=
        Iterator'
        (TheSearchKind   => BranchSearch,
         SearchNodeType  => SP_Symbols.SPEND,
         SearchDirection => In_Direction,
         Current         => From_Root,
         Root            => From_Root);

      if not IsBranchNode (From_Root) then
         It := NextNode (It);
      end if;
      return It;
   end Find_First_Branch_Node;

   -------------------------------------------------------

   function Find_First_Formal_Parameter_Node (From_Root : SyntaxNode) return Iterator is
      It : Iterator;
   begin
      It := Find_First_Node (Node_Kind    => SP_Symbols.identifier,
                             From_Root    => From_Root,
                             In_Direction => Down);
      return Iterator'
        (TheSearchKind   => FormalParameterSearch,
         SearchNodeType  => SP_Symbols.SPEND,
         SearchDirection => Down,
         Current         => It.Current,
         Root            => From_Root);
   end Find_First_Formal_Parameter_Node;

   -------------------------------------------------------

   function FindLastItemInDependencyRelation (Node : SyntaxNode) return LexTokenManager.Token_Position is separate;

   -------------------------------------------------------

   function FindLastActualParameterNode (FromRoot : SyntaxNode) return SyntaxNode is
      LastFormal : SyntaxNode;
      LastActual : SyntaxNode;
      It         : Iterator;
   begin
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => FromRoot) = SP_Symbols.named_argument_association,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect FromRoot = named_argument_association in STree.FindLastActualParameterNode");

      LastFormal := NullNode;
      -- Get the first formal
      It := Find_First_Formal_Parameter_Node (From_Root => FromRoot);
      -- find the last formal
      while not IsNull (It) loop
         LastFormal := Get_Node (It => It);
         It         := NextNode (It);
      end loop;

      if LastFormal = NullNode then
         LastActual := NullNode;
      else
         -- work out the last actual
         -- simple_name => expression
         LastActual :=
           Next_Sibling
           (Get_Node
              (It => Find_First_Node (Node_Kind    => SP_Symbols.simple_name,
                                      From_Root    => LastFormal,
                                      In_Direction => Up)));
      end if;
      return LastActual;
   end FindLastActualParameterNode;

   -------------------------------------------------------

   function Expression_From_Positional_Argument_Association (Node : SyntaxNode) return SyntaxNode is
      Result : SyntaxNode;
   begin
      Result := Child_Node (Current_Node => Node);
      -- ASSUME Result = positional_argument_association OR expression
      if Syntax_Node_Type (Node => Result) = SP_Symbols.positional_argument_association then
         -- ASSUME Result = positional_argument_association
         Result := Next_Sibling (Current_Node => Result);
      elsif Syntax_Node_Type (Node => Result) /= SP_Symbols.expression then
         Result := NullNode;
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Result = positional_argument_association OR expression " &
              "in STree.Expression_From_Positional_Argument_Association");
      end if;
      -- ASSUME Result = expression
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Result) = SP_Symbols.expression,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Result = expression in STree.Expression_From_Positional_Argument_Association");
      return Result;
   end Expression_From_Positional_Argument_Association;

   -------------------------------------------------------

   function Expression_From_Named_Argument_Association (Node : SyntaxNode) return SyntaxNode is
      Result : SyntaxNode;
   begin
      Result := Child_Node (Current_Node => Node);
      -- ASSUME Result = named_argument_association OR simple_name
      if Syntax_Node_Type (Node => Result) = SP_Symbols.named_argument_association then
         -- ASSUME Result = named_argument_association
         Result := Next_Sibling (Current_Node => Result);
      elsif Syntax_Node_Type (Node => Result) /= SP_Symbols.simple_name then
         Result := NullNode;
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Result = named_argument_association OR simple_name " &
              "in STree.Expression_From_Named_Argument_Association");
      end if;
      -- ASSUME Result = simple_name
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Result) = SP_Symbols.simple_name,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Result = simple_name in STree.Expression_From_Named_Argument_Association");
      -- skip over parameter name to get expression
      Result := Next_Sibling (Current_Node => Result);
      -- ASSUME Result = expression
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Result) = SP_Symbols.expression,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Result = expression in STree.Expression_From_Named_Argument_Association");
      return Result;
   end Expression_From_Named_Argument_Association;

   -------------------------------------------------------

   function LoopParameterSpecFromEndOfLoop (Node : SyntaxNode) return SyntaxNode is
      Result : SyntaxNode;
   begin
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Node) = SP_Symbols.end_of_loop,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Node = end_of_loop in STree.LoopParameterSpecFromEndOfLoop");

      Result := Child_Node (Parent_Node (Current_Node => Node));   -- simple_name or loop_statement_opt
      if Syntax_Node_Type (Node => Result) = SP_Symbols.simple_name then
         Result := Next_Sibling (Result);       -- loop_statement_opt
      end if;
      Result := Child_Node (Child_Node (Result));

      SystemErrors.RT_Assert
        (C       => Result = NullNode
           or else Syntax_Node_Type (Node => Result) = SP_Symbols.loop_parameter_specification
           or else Syntax_Node_Type (Node => Result) = SP_Symbols.condition,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Result = loop_parameter_specification OR condition OR NULL " &
           "in STree.LoopParameterSpecFromEndOfLoop");
      return Result;
   end LoopParameterSpecFromEndOfLoop;

   -------------------------------------------------------

   function IdentifierHasTildeSuffix (Node : SyntaxNode) return Boolean is
   begin
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Node) = SP_Symbols.identifier,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Node = identifier in STree.IdentifierHasTildeSuffix");
      return Syntax_Node_Type (Node => Next_Sibling (Node)) = SP_Symbols.tilde;
   end IdentifierHasTildeSuffix;

   -------------------------------------------------------

   function IdentifierHasPercentSuffix (Node : SyntaxNode) return Boolean is
   begin
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Node) = SP_Symbols.identifier,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Node = identifier in STree.IdentifierHasPercentSuffix");
      return Syntax_Node_Type (Node => Next_Sibling (Node)) = SP_Symbols.percent;
   end IdentifierHasPercentSuffix;

   -------------------------------------------------------

begin
   Table.CurrSyntaxNode := NullNode;
   --# accept Flow, 23, Table.Contents, "Init partial but effective";
   Table.Contents (NullNode) := -- Expect flow error on 1st write to array
     NodeValue'
     (NodeType  => SP_Symbols.SPEND,
      Position  => LexTokenManager.Null_Token_Position,
      Parent    => NullNode,
      Next      => NullNode,
      Child     => NullNode,
      Token_Str => LexTokenManager.Null_String,
      Ref_Str   => LexTokenManager.Null_String,
      Ref_Sym   => Dictionary.NullSymbol);
   --# end accept;
   Table.FreeList := NullNode;
   Table.TopUsed  := NullNode;
   --# accept Flow, 602, Table, Table.Contents, "Init partial but effective";
end STree; --  Init. is partial but effective.  Expect 1 warning.
