-------------------------------------------------------------------------------
-- (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.
--
--=============================================================================

--------------------------------------------------------------------------------
--  STree
--
--  Description:
--    The package STree implements an ASM which maitains a syntax
--    tree derived from the analysed source text.  The structure of the
--    tree strictly follows the LLR1 grammar described in spark.lla.
--    The syntax tree is logically a multi-child tree but is physically
--    a binary tree using a "left-son-right-sibling" representation.
--    That is the left branch of a node, N, represents the leftmost child, L,
--    of N and the right branch of L is a list of the siblings of L (i.e., the
--    remaining children of N).
--------------------------------------------------------------------------------

with Dictionary;
with ExaminerConstants;
with LexTokenManager;
with SP_Symbols;

use type Dictionary.Symbol;
use type LexTokenManager.Str_Comp_Result;
use type LexTokenManager.Token_Position;
use type SP_Symbols.SP_Symbol;

--# inherit Dictionary,
--#         ExaminerConstants,
--#         LexTokenManager,
--#         SPARK_IO,
--#         SP_Symbols,
--#         Statistics,
--#         SystemErrors;

package STree
--# own Table : TableStructure;
--# initializes Table;
is
   type SyntaxNode is private;
   NullNode : constant SyntaxNode;

   procedure RetrieveCurrentRoot (Root : out SyntaxNode);
   --# global in out Table;
   --# derives Root,
   --#         Table from Table;

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

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

   procedure NewProduction (Production : in     SP_Symbols.SP_Non_Terminal;
                            Node       :    out SyntaxNode);
   --# global in out Table;
   --# derives Node  from Table &
   --#         Table from *,
   --#                    Production;

   procedure NewTerminal
     (Terminal    : in     SP_Symbols.SP_Terminal;
      TerminalVal : in     LexTokenManager.Lex_Value;
      Node        :    out SyntaxNode);
   --# global in out Table;
   --# derives Node  from Table &
   --#         Table from *,
   --#                    Terminal,
   --#                    TerminalVal;

   procedure AddDerivative (Child_Node : in SyntaxNode);
   --# global in out Table;
   --# derives Table from *,
   --#                    Child_Node;

   procedure AddChildNode (Node         : in SyntaxNode;
                           ChildNode    : in SyntaxNode;
                           LinkToParent : in Boolean);
   --# global in out Table;
   --# derives Table from *,
   --#                    ChildNode,
   --#                    LinkToParent,
   --#                    Node;

   -----------------------------------------------------------------------------
   --  Child_Node
   --
   --  Description:
   --    Child_Node gets the first (left) child of a node (if one exists).  The
   --    remaining children are obtained using calls to
   --    Next_Sibling initially applied to the first node returned by
   --    Child_Node and then applied to the successive nodes returned by
   --    the calls to Next_Sibling.
   --    Child_Node returns a NulNode if there is no child nodes.
   -----------------------------------------------------------------------------
   function Child_Node (Current_Node : SyntaxNode) return SyntaxNode;
   --# global in Table;

   -----------------------------------------------------------------------------
   --  Next_Sibling
   --
   --  Description:
   --    Next_Sibling gets sibling nodes by applying each
   --    call to the preceding sibling.  If there are no further siblings
   --    Next_Sibling returns a NullNode.
   -----------------------------------------------------------------------------
   function Next_Sibling (Current_Node : SyntaxNode) return SyntaxNode;
   --# global in Table;
   -- pre Current_Node /= NullNode;

   function Parent_Node (Current_Node : SyntaxNode) return SyntaxNode;
   --# global in Table;
   -- pre Current_Node /= NullNode;

   -----------------------------------------------------------------------------
   --  Syntax_Node_Type
   --
   --  Description:
   --    Returns the grammar symbol associated with the Node from the grammar
   --    symbols defined in SP_Symbols.SP_Symbol.
   -----------------------------------------------------------------------------
   function Syntax_Node_Type (Node : SyntaxNode) return SP_Symbols.SP_Symbol;
   --# global in Table;

   function Node_Position (Node : SyntaxNode) return LexTokenManager.Token_Position;
   --# global in Table;

   procedure Set_Node_Lex_String (Sym  : in Dictionary.Symbol;
                                  Node : in SyntaxNode);
   --# global in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in out Table;
   --# derives Table from *,
   --#                    Dictionary.Dict,
   --#                    Node,
   --#                    Sym &
   --#         null  from LexTokenManager.State;
   --# post Table = Table~;
   -- pre Node /= NullNode and Syntax_Node_Type (Node, Table) in SP_Symbols.SP_Terminal;

   function Node_Lex_String (Node : SyntaxNode) return LexTokenManager.Lex_String;
   --# global in Table;
   -- pre Node /= NullNode and Syntax_Node_Type (Node, Table) in SP_Symbols.SP_Terminal;

   function Node_Token_String (Node : SyntaxNode) return LexTokenManager.Lex_String;
   --# global in Table;
   --# pre Syntax_Node_Type (Node, Table) = SP_Symbols.identifier;

   ----------------------------------------------------------------------
   --  DeleteSyntaxTree
   --
   --  Description:
   --    Returns the tree rooted at Root to the Free List, _except_ subtrees
   --    rooted at the following node types, which are needed by the VCG:
   --    procedure_constraint
   --    function_constraint
   --    generic_actual_part
   --    Subtrees rooted at constant_declaration nodes are not deleted iff
   --    KeepConstants is True
   ----------------------------------------------------------------------
   procedure DeleteSyntaxTree (Root          : in SyntaxNode;
                               KeepConstants : in Boolean);
   --# global in out Table;
   --# derives Table from *,
   --#                    KeepConstants,
   --#                    Root;

   -- Function returns the left most leaf node of the tree.
   function Last_Child_Of (Start_Node : SyntaxNode) return SyntaxNode;
   --# global in Table;
   -- pre Start_Node /= NullNode;

   function Last_Sibling_Of (Start_Node : SyntaxNode) return SyntaxNode;
   --# global in Table;
   -- pre Start_Node /= NullNode;

   -- procedure to poke symbol into tree for retrieval by VCG
   procedure Add_Node_Symbol (Node : in SyntaxNode;
                              Sym  : in Dictionary.Symbol);
   --# global in     Dictionary.Dict;
   --#        in out Table;
   --# derives Table from *,
   --#                    Node,
   --#                    Sym &
   --#         null  from Dictionary.Dict;
   --# pre ((Syntax_Node_Type (Node, Table) = SP_Symbols.attribute_designator or
   --#         Syntax_Node_Type (Node, Table) = SP_Symbols.annotation_attribute_designator or
   --#         Syntax_Node_Type (Node, Table) = SP_Symbols.positional_argument_association or
   --#         Syntax_Node_Type (Node, Table) = SP_Symbols.annotation_positional_argument_association) ->
   --#        (Dictionary.Is_Null_Symbol (Sym) or
   --#           Dictionary.IsTypeMark (Sym, Dictionary.Dict) or
   --#           Dictionary.IsParameterConstraint (Sym, Dictionary.Dict))) and
   --#   ((Syntax_Node_Type (Node, Table) = SP_Symbols.inside or Syntax_Node_Type (Node, Table) = SP_Symbols.outside) ->
   --#      (Dictionary.Is_Null_Symbol (Sym) or
   --#         Dictionary.IsTypeMark (Sym, Dictionary.Dict) or
   --#         Dictionary.IsEnumerationLiteral (Sym, Dictionary.Dict))) and
   --#   ((Syntax_Node_Type (Node, Table) = SP_Symbols.type_mark) ->
   --#      (Dictionary.Is_Null_Symbol (Sym) or
   --#         Dictionary.IsTypeMark (Sym, Dictionary.Dict) or
   --#         Dictionary.IsArrayIndex (Sym, Dictionary.Dict))) and
   --#   ((Syntax_Node_Type (Node, Table) = SP_Symbols.expression) ->
   --#      (Dictionary.Is_Null_Symbol (Sym) or
   --#         Dictionary.IsTypeMark (Sym, Dictionary.Dict) or
   --#         Dictionary.IsArrayIndex (Sym, Dictionary.Dict) or
   --#         Dictionary.IsConstant (Sym, Dictionary.Dict))) and
   --#   ((Syntax_Node_Type (Node, Table) = SP_Symbols.procedure_call_statement) ->
   --#      (Dictionary.Is_Null_Symbol (Sym) or
   --#         Dictionary.IsProcedure (Sym, Dictionary.Dict) or
   --#         Dictionary.IsOwnVariable (Sym, Dictionary.Dict))) and
   --#   ((Syntax_Node_Type (Node, Table) = SP_Symbols.selected_component or
   --#       Syntax_Node_Type (Node, Table) = SP_Symbols.annotation_selected_component or
   --#       Syntax_Node_Type (Node, Table) = SP_Symbols.identifier) ->
   --#      Syntax_Node_Type (Node, Table) /= SP_Symbols.identifier ->
   --#      Dictionary.IsFunction (Sym, Dictionary.Dict)) and
   --#   ((Syntax_Node_Type (Node, Table) = SP_Symbols.primary) ->
   --#      (Dictionary.Is_Null_Symbol (Sym) or
   --#         Dictionary.IsTypeMark (Sym, Dictionary.Dict) or
   --#         Dictionary.IsFunction (Sym, Dictionary.Dict) or
   --#         Dictionary.IsOwnVariableOrConstituentWithMode (Sym, Dictionary.Dict))) and
   --#   (Syntax_Node_Type (Node, Table) = SP_Symbols.identifier ->
   --#      (Dictionary.IsEnumerationLiteral (Sym, Dictionary.Dict) or
   --#         Dictionary.IsConstant (Sym, Dictionary.Dict) or
   --#         Dictionary.IsRulePolicy (Sym, Dictionary.Dict) or
   --#         Dictionary.IsVariable (Sym, Dictionary.Dict) or
   --#         Dictionary.IsQuantifiedVariable (Sym, Dictionary.Dict) or
   --#         Dictionary.IsTypeMark (Sym, Dictionary.Dict) or
   --#         Dictionary.IsSubprogram (Sym, Dictionary.Dict) or
   --#         Dictionary.IsFunction (Sym, Dictionary.Dict) or
   --#         Dictionary.IsImplicitReturnVariable (Sym, Dictionary.Dict))) and
   --#   (Syntax_Node_Type (Node, Table) = SP_Symbols.operator_symbol ->
   --#      Dictionary.IsOperator (Sym, Dictionary.Dict)) and
   --#   ((Syntax_Node_Type (Node, Table) = SP_Symbols.global_variable or
   --#       Syntax_Node_Type (Node, Table) = SP_Symbols.null_import_list) ->
   --#      Dictionary.IsGlobalVariable (Sym, Dictionary.Dict)) and
   --#   ((Syntax_Node_Type (Node, Table) /= SP_Symbols.attribute_designator and
   --#       Syntax_Node_Type (Node, Table) /= SP_Symbols.annotation_attribute_designator and
   --#       Syntax_Node_Type (Node, Table) /= SP_Symbols.positional_argument_association and
   --#       Syntax_Node_Type (Node, Table) /= SP_Symbols.annotation_positional_argument_association and
   --#       Syntax_Node_Type (Node, Table) /= SP_Symbols.inside and
   --#       Syntax_Node_Type (Node, Table) /= SP_Symbols.outside and
   --#       Syntax_Node_Type (Node, Table) /= SP_Symbols.type_mark and
   --#       Syntax_Node_Type (Node, Table) /= SP_Symbols.expression and
   --#       Syntax_Node_Type (Node, Table) /= SP_Symbols.procedure_call_statement and
   --#       Syntax_Node_Type (Node, Table) /= SP_Symbols.selected_component and
   --#       Syntax_Node_Type (Node, Table) /= SP_Symbols.annotation_selected_component and
   --#       Syntax_Node_Type (Node, Table) /= SP_Symbols.primary and
   --#       Syntax_Node_Type (Node, Table) /= SP_Symbols.operator_symbol and
   --#       Syntax_Node_Type (Node, Table) /= SP_Symbols.global_variable and
   --#       Syntax_Node_Type (Node, Table) /= SP_Symbols.null_import_list and
   --#       Syntax_Node_Type (Node, Table) /= SP_Symbols.identifier) ->
   --#      (Dictionary.Is_Null_Symbol (Sym) or Dictionary.IsTypeMark (Sym, Dictionary.Dict)));
   --# post Table = Table~;

   function NodeSymbol (Node : SyntaxNode) return Dictionary.Symbol;
   --# global in Table;

   procedure ReportUsage;
   --# global in     Table;
   --#        in out Statistics.TableUsage;
   --# derives Statistics.TableUsage from *,
   --#                                    Table;

   ------------------------------------------------------------------------
   -- Iterators
   --
   -- Description:
   --    An Iterator is an ADT which embodies the information traverse
   --    successive nodes of the syntax tree based on given criteria:
   --       Search Kind - Undefined, Node, Branch, or Formal Parameter search.
   --       Node Kind   - the sort of node to be located on each
   --                     iteration (as defined by SP_Symbols.SP_Symbol).
   --       Direction   - Whether the traversal is up through its predecessors
   --                     or down the tree through its children and siblings.
   ------------------------------------------------------------------------

   type Iterator is private;
   --
   -- This iterator can be used to traverse the syntax tree.

   NullIterator : constant Iterator;

   type TraverseDirection is (Up, Down);
   --
   -- Up:   Looks for relevant nodes in the parent chain above (and including)
   --       the specified root.
   --
   -- Down: Looks for relevant nodes in a pre-order (or depth first) fashion
   --       below (and including) the root.

   -----------------------------------------------------------------------------
   --  GetNode
   --
   --  Description:
   --    Gets the currently located node from an Iterator.
   --    If there is no located node (IsNull is True), then a NullNode
   --    is returned.
   -----------------------------------------------------------------------------
   function Get_Node (It : Iterator) return SyntaxNode;
   --# return S => ((It = NullIterator) -> (S = NullNode));

   -----------------------------------------------------------------------------
   --  IsNull
   --
   --  Description:
   --    Returns True if the Iterator, It, does not contain a located node,
   --    otherwise returns false.
   -----------------------------------------------------------------------------
   function IsNull (It : Iterator) return Boolean;
   --# return It = NullIterator;

   -----------------------------------------------------------------------------
   --  Find_First_Node
   --
   --  Description:
   --    Intialises the returned Iterator with the following criteria:
   --    Search Kind = Node Search,
   --    Node Kind   = NodeKind, and
   --    Direction   = InDirection.
   --    The details of the first node found starting from, and including, the
   --    FromNode and meeting the criteria are recorded.
   --    If the Direction is Down the node is located using a pre-order search
   --    of the tree.  If the Direction is Up the tree is traversed through the
   --    ancestors of the FromNode.
   --    If no node of NodeKind is found then a call to IsNull will return True,
   --    otherwise a call to GetNode (with no intervining
   --    calls to NextNode) returns the located node.
   --    Once the iterator is initialised it will retain the same criteria in
   --    successive calls of NextNode.
   --    NOTE: once a relevant node is found successive calls to NextNode
   --    will traverse its ancestors (up) or its siblings (down) it will
   --    not traverse the children of the located node.
   -----------------------------------------------------------------------------
   function Find_First_Node
     (Node_Kind    : SP_Symbols.SP_Symbol;
      From_Root    : SyntaxNode;
      In_Direction : TraverseDirection)
     return         Iterator;
   --# global in Table;
   --# return It => ((Syntax_Node_Type (Get_Node (It), Table) = Node_Kind) or IsNull (It));

   -----------------------------------------------------------------------------
   --  Find_First_Branch_Node
   --
   --  Description:
   --    Sets up an iterator to find nodes which have more than one child.
   --    Intialises the returned Iterator with the following criteria:
   --    Search Kind = Barnch Search,
   --    Node Kind   = n/a, and
   --    Direction   = InDirection.
   --    The details of the first node starting from FromNode and meeting
   --    the criteria are recorded.
   --    If no branch nodes are found then a call IsNull will return True,
   --    otherwise a call to GetNode (with no intervining
   --    calls to NextNode) returns the located node.
   --    Once the iterator is initialised it will retain the same criteria in
   --    successive calls of NextNode.
   --    NOTE: once a relevant node is found successive calls to NextNode
   --    will traverse its ancestors (up) or its siblings (down) it will
   --    not traverse the children of the located node.
   -----------------------------------------------------------------------------
   function Find_First_Branch_Node (From_Root    : SyntaxNode;
                                    In_Direction : TraverseDirection) return Iterator;
   --# global in Table;

   -----------------------------------------------------------------------------
   --  Find_First_Formal_Parameter_Node
   --
   --  Description:
   --    This function is used when processing subprogram calls with named
   --    parameter association.
   --    Intialises the returned Iterator with the following criteria:
   --    Search Kind = Formal Parameter Search,
   --    Node Kind   = n/a, and
   --    Direction   = Down.
   --    IMPORTANT: the FromRoot parameter must have a node kind of
   --    SP_Symbols.named_argument_association
   --    otherwise an Examiner Fatal Error will occur.
   --    The details of the first node starting from FromNode and meeting
   --    the criteria are recorded.
   --    If no Formal Parameter Nodes are found then a call to IsNull will
   --    return True, otherwise a call to GetNode (with no intervining
   --    calls to NextNode) returns the located node.
   --    Once the iterator is initialised it will retain the same criteria in
   --    successive calls of NextNode.
   --    Once a formal parameter node of a subprogram is found, successive
   --    calls to NextNode will return each of the formal parameters of the
   --    subprogram.
   -----------------------------------------------------------------------------
   function Find_First_Formal_Parameter_Node (From_Root : SyntaxNode) return Iterator;
   --# global in Table;
   --# pre Syntax_Node_Type (From_Root, Table) = SP_Symbols.named_argument_association;
   --# return It => (Syntax_Node_Type (Get_Node (It), Table) = SP_Symbols.identifier);

   -----------------------------------------------------------------------------
   --  FindLastActualParameterNode
   --
   --  Description:
   --    This function is used when processing subprogram calls with named
   --    parameter association.
   --    Intialises the returned Iterator with the following criteria:
   --    Search Kind = Node Search,
   --    Node Kind   = SP_Symbols.simple_name, and
   --    Direction   = Up.
   --    IMPORTANT: the FromRoot parameter must have a node kind of
   --    SP_Symbols.named_argument_association
   --    otherwise an Examiner Fatal Error will occur.
   --    The details of the first node starting from FromNode and meeting
   --    the criteria are recorded.
   --    If no Actual Parameter Nodes are found then a call to IsNull will
   --    return True, otherwise a call to GetNode (with no intervining
   --    calls to NextNode) returns the located node.
   --    Once the iterator is initialised it will retain the same criteria in
   --    successive calls of NextNode.
   --    NOTE: it does not appear that preceding actual parameters will be
   --    found by successive calls to NextNode.
   -----------------------------------------------------------------------------
   function FindLastActualParameterNode (FromRoot : SyntaxNode) return SyntaxNode;
   --# global in Table;
   -- pre Syntax_Node_Type (FromRoot, Table) = SP_Symbols.named_argument_association;

   -----------------------------------------------------------------------------
   --  NextNode
   --
   --  Description:
   --    Traverses the syntax tree via successive iterative calls.
   --    The traversal depends on the traversal criteria set by
   --    Find_First_Node, Find_First_Branch_Node, Find_First_Formal_Parameter_Node,
   --    or FindLastActualParameterNode.
   --    See the above descriptions of these subprograms for details.
   -----------------------------------------------------------------------------
   function NextNode (It : Iterator) return Iterator;
   --# global in Table;
   --# return Next_It => ((Syntax_Node_Type (Get_Node (It), Table) = Syntax_Node_Type (Get_Node (Next_It), Table)) or
   --#                      IsNull (Next_It));

   ------------------------------------------------------------------------
   -- Larger-scale accessor functions to aid SyntaxTree navigation
   ------------------------------------------------------------------------

   function FindLastItemInDependencyRelation (Node : SyntaxNode) return LexTokenManager.Token_Position;
   --# global in Table;
   --# pre Syntax_Node_Type (Node, Table) = SP_Symbols.dependency_relation;
   --  return "The right-most, bottom-most item in the relation"
   --  Useful for reporting items missing from a derives annotation
   --  type Traversal is (Up, Down, Across);

   function Expression_From_Positional_Argument_Association (Node : SyntaxNode) return SyntaxNode;
   --# global in Table;
   --# pre Syntax_Node_Type (Node, Table) = SP_Symbols.positional_argument_association;
   --# return Result => Syntax_Node_Type (Result, Table) = SP_Symbols.expression;

   function Expression_From_Named_Argument_Association (Node : SyntaxNode) return SyntaxNode;
   --# global in Table;
   --# pre Syntax_Node_Type (Node, Table) = SP_Symbols.named_argument_association;
   --# return Result => Syntax_Node_Type (Result, Table) = SP_Symbols.expression;

   function LoopParameterSpecFromEndOfLoop (Node : SyntaxNode) return SyntaxNode;
   --# global in Table;
   --# return Result => (Result = NullNode or
   --#                     Syntax_Node_Type (Result, Table) = SP_Symbols.loop_parameter_specification or
   --#                     Syntax_Node_Type (Result, Table) = SP_Symbols.condition);
   -- pre Syntax_Node_Type (Node, Table) = SP_Symbols.end_of_loop;

   function IdentifierHasTildeSuffix (Node : SyntaxNode) return Boolean;
   --# global in Table;
   -- pre Syntax_Node_Type (Node, Table) = SP_Symbols.identifier;

   function IdentifierHasPercentSuffix (Node : SyntaxNode) return Boolean;
   --# global in Table;
   -- pre Syntax_Node_Type (Node, Table) = SP_Symbols.identifier;

private

   type SyntaxNode is range 0 .. ExaminerConstants.SyntaxTreeSize;
   --# assert SyntaxNode'Base is Integer; -- for the "Large" Examiner

   NullNode : constant SyntaxNode := 0;

   type SearchKind is (Undefined, NodeTypeSearch, BranchSearch, FormalParameterSearch);

   type Iterator is record
      TheSearchKind   : SearchKind;
      SearchNodeType  : SP_Symbols.SP_Symbol;
      SearchDirection : TraverseDirection;
      Current         : SyntaxNode;
      Root            : SyntaxNode;
   end record;

   NullIterator : constant Iterator :=
     Iterator'
     (TheSearchKind   => Undefined,
      SearchNodeType  => SP_Symbols.SP_Symbol'First,
      SearchDirection => TraverseDirection'First,
      Current         => NullNode,
      Root            => NullNode);

end STree;
