------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                             A 4 G . N O R M                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision: 1.13.2.1 $
--                                                                          --
--            Copyright (c) 1995-2002, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-GNAT 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 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY 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 ASIS-for-GNAT; see file     --
-- COPYING. If not, write to the Free Software Foundation,  59 Temple Place --
-- - Suite 330,  Boston, MA 02111-1307, USA.                                --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences.  ASIS-for-GNAT is now maintained by  Ada Core Technologies Inc --
-- (http://www.gnat.com).                                                   --
--                                                                          --
------------------------------------------------------------------------------

with System.Assertions;
with Ada.Exceptions;

with Asis.Exceptions; use Asis.Exceptions;

with Asis.Set_Get;    use  Asis.Set_Get;
with A4G.A_Types;     use A4G.A_Types;
with A4G.A_Debug;     use A4G.A_Debug;
with A4G.A_Output;    use A4G.A_Output;
with A4G.Int_Knds;    use A4G.Int_Knds;
with A4G.Mapping;     use A4G.Mapping;
with A4G.Itests;      use A4G.Itests;
with A4G.Contt.UT;    use A4G.Contt.UT;
with A4G.Vcheck;      use A4G.Vcheck;

with Atree;           use Atree;
with Sinfo;           use Sinfo;
with Einfo;           use Einfo;
with Nlists;          use Nlists;
with Output;          use Output;

package body A4G.Norm is

   use Asis;

   LT : String renames ASIS_Line_Terminator;
   Package_Name : constant String := "A4G.Norm.";

   ----------------------
   --  Local functions --
   ----------------------

   function Get_Type_With_Discr (Constr_Node : Node_Id) return Node_Id;
   --  for a node of N_Index_Or_Discriminant_Constraint type, which
   --  represents a discriminant constraint, this function yields the
   --  node representing the type declaration with a known discriminant
   --  part, where discriminants being constrained are defined. The
   --  intent is to get the right discriminant declarations (as subcomponents
   --  of the results), so these discriminant declarations may be implicit,
   --  as well as the type represented by the result node.
   --
   --  NOTE: this function looks like a particular case of some more
   --        general function useful for finding out the implicit
   --        components of a derived type

   function Unwind_Till_Discriminants (Type_Decl : Node_Id) return Node_Id;
   --  Starting from the node representing the declaration of access or
   --  derived type (ether formal or "normal"), it gives the type
   --  declartion node representing the designated or ancestor type
   --  (unwinding all the intermediate access or derived types) which
   --  has discriminant declarations. This function is supposed to be called
   --  in the situatuin, when it is known for sure, that the desired
   --  type indeed has discriminants
   --
   --  NOTE: this function looks like a particular case of some more
   --        general function useful for finding out the first non-access
   --        designated/non-derived ancestor type for a given access/derived
   --        type

   ----------------------------
   -- Defining_Gen_Parameter --
   ----------------------------

   function Defining_Gen_Parameter (Gen_Form_Par : Node_Id) return Node_Id is
      Result_Node   : Node_Id;
      Gen_Form_Pars : List_Id;
      Next_Par      : Node_Id;
   begin
      --  ONLY PARTIAL IMPLEMENTATION FOR OPERATOR_SYMBOL!!!!

      --  traversing the tree till the declagation of the corresponding
      --  generic unit:

      Result_Node := Parent (Gen_Form_Par); --  generic association
      Result_Node := Parent (Result_Node);  --  generic instantiation
      Result_Node := Sinfo.Name (Original_Node (Result_Node));

      --  the name of the generic  unit being instantiated
      Result_Node := Entity (Result_Node);

      --  the defining name of the generic  unit being instantiated
      while Nkind (Original_Node (Result_Node)) not in
            N_Generic_Declaration
      loop
         Result_Node := Parent (Result_Node);
      end loop;

      Result_Node := Original_Node (Result_Node); --  ???

      --  the node representing the declaration of the corresponding generic
      --  unit, but this is a rewritten node in the current GNAT model for
      --  generics, therefore:

      --  looking for the defining occurence of the corresponding
      --  parameter:

      Gen_Form_Pars := Generic_Formal_Declarations (Result_Node);
      Next_Par      := First_Non_Pragma (Gen_Form_Pars);

      while Present (Next_Par) loop
         --  !!! only partial implementation for generic parameters which
         --  !!! are generic functions-operators
         if Nkind (Next_Par) = N_Formal_Subprogram_Declaration and then
            Nkind (Specification (Next_Par)) = N_Function_Specification
         then
            Result_Node := Defining_Unit_Name (Specification (Next_Par));
            --  cannot have a prefix!!!
            if Chars (Result_Node) = Chars (Gen_Form_Par) then
               --  note, that this is only a "very partial" solution
               --  for generic "+" and "-" functions!!!
               return Result_Node;
            end if;
         end if;

         Next_Par := Next_Non_Pragma (Next_Par);

      end loop;

      return Empty;
      --  to raise an exception in the calling context if we are wrong
   end Defining_Gen_Parameter;

   --------------------
   -- Discr_Def_Name --
   --------------------

   function Discr_Def_Name
     (Association : in Asis.Discriminant_Association)
      return Asis.Defining_Name
   is
      Result_Node     : Node_Id;
      Result_Unit     : Asis.Compilation_Unit;
      Result_Element  : Asis.Defining_Name;
      Inherited_Discr : Boolean;
   begin
      --  a normalized association contains the node on which the result
      --  should be built as the Node field of Association, see the
      --  documentation in the body of Normalized_Discriminant_Associations.
      --  So we may start for creating the "rough" version of Result_Element:

      Result_Node := Node (Association);
      Result_Unit := Enclosing_Unit (Encl_Cont_Id (Association), Result_Node);

      Result_Element := Node_To_Element_New
                          (Node          => Result_Node,
                           Internal_Kind => A_Defining_Identifier,
                           In_Unit       => Result_Unit);

      --  and now we have to correct, if needed, the fields
      --  Is_Part_Of_Implicit, Is_Part_Of_Inherited and Is_Part_Of_Instance
      --  of Result_Element, which are set False by default

      Inherited_Discr := Is_Inherited_Discriminant (Result_Node);

      Set_From_Implicit  (Result_Element, Inherited_Discr);
      Set_From_Inherited (Result_Element, Inherited_Discr);
      --  for discriminants, to be implicit and to be inherited mean the
      --  same
      Set_From_Instance  (Result_Element, Is_From_Instance (Result_Node));

      return Result_Element;
   end Discr_Def_Name;

   -------------------------
   -- Get_Type_With_Discr --
   -------------------------

   function Get_Type_With_Discr (Constr_Node : Node_Id) return Node_Id is
      Result_Node    : Node_Id;
      Curr_Node      : Node_Id;
      Curr_Node_Kind : Node_Kind;
   begin

      -------------------------
      -- Implementation Note --
      -------------------------
      --  The current implementation definitely contains errors and it
      --  is far from being perfect.
      --
      --  For now, at least the problem with the formal types is known
      --  as a real source for ASIS crashes. The problem is that GNAT
      --  rewrites completely all the tree structures for generic
      --  declarations, and the original structures ARE NOT completely
      --  decorated. And (at least, now) ASIS works with original
      --  tree structures only. So some semantic node fields may be
      --  Empty in the original tree structures corresponding to
      --  generics. (ASIS will crash, when a discriminant constraint
      --  being analyzed is in a generic declaration)


      --  first, we have to go from the constraint node to the subtype
      --  indication to which this constraint is applied
      Curr_Node := Sinfo.Subtype_Mark (Parent (Constr_Node));

      --  second, we have to go from this subtype indication to the
      --  corresponding base type
      Curr_Node := Base_Type (Entity (Curr_Node));
      --  this is a defining identifier,
      Curr_Node := Parent (Curr_Node);
      --  and this should be the node representing a type declaration,
      --  the only possible Node Kinds for its *original* node are:
      --
      --     N_Formal_Type_Declaration,
      --     N_Full_Type_Declaration,
      --     N_Incomplete_Type_Declaration,
      --     N_Private_Extension_Declaration,
      --     N_Private_Type_Declaration,
      --     N_Protected_Type_Declaration,
      --
      --  But, for derived and formal derived types, GNAT rewrites the
      --  corresponding tree structures: it replaces the original node
      --  of N_Formal_Type_Declaration or N_Full_Type_Declaration kind
      --  with N_Subtype_Decalration node, but the immediately preseding
      --  node is the (inserted) node of N_Full_Type_Declaration kind,
      --  this type implicitly defines all the discriminants and
      --  components which are inherited by the derived type.

      if Debug_Flag_A then
         Write_Eol;
         Write_Str ("Norm.Get_Type_With_Discr: type on which discriminant ");
         Write_Str ("constraint is imposed");
         Write_Eol;
         Write_Node (Curr_Node);
         Write_Eol;
      end if;

      Curr_Node_Kind := Nkind (Curr_Node);

      --  and now we have to analyze the type declaration (definition?)
      --  and to choose the further traversing depending on this analysis.

      case Curr_Node_Kind is
         when N_Incomplete_Type_Declaration   |
              N_Private_Extension_Declaration |
              N_Private_Type_Declaration      |
              N_Protected_Type_Declaration    =>
            --  these cases are easy: we already have needed discriminats
            --  in the type declaration:
            Result_Node := Curr_Node;

         when N_Formal_Type_Declaration =>
            case Nkind (Sinfo.Formal_Type_Definition (Curr_Node)) is
               when N_Formal_Private_Type_Definition =>
                  --  the situation is the same as for the previous
                  --  alternative of the external case - the discriminant
                  --  declarations are already here
                  Result_Node := Curr_Node;

               --  when N_Formal_Derived_Type_Definition =>
                  --  RM95 12.5.1(11): "The declaration of a formal derived
                  --  type shall not have a known_discriminant_part"
                  --  therefore we have to find implicit discriminant
                  --  declarations

                  --  in fact, this case can never happen - GNAT incerts
                  --  the declaration of (implicit) type having the
                  --  corresponding discriminant declarations just before
                  --  the derived type declaration, and all the semantic
                  --  links in the tree are set to this implicit type

               when N_Access_To_Object_Definition =>
                  --  we have to go to the designated type (unwinding other
                  --  access types, if any) which has these discriminants
                  Result_Node := Unwind_Till_Discriminants (Result_Node);

               when others =>
                  Raise_ASIS_Failed
                    ("Norm.Get_Type_With_Discr: " &
                     "error in finding discriminant declarations " &
                     "(for a formal type)");
            end case;
         when N_Full_Type_Declaration =>
            case Nkind (Sinfo.Type_Definition (Curr_Node)) is
            --   when N_Derived_Type_Definition =>
            --      ?????? (it may have its "own" discriminants, and it may
            --      inherit discriminants from an ancestor
            --
            --  in fact, this case can never happen - GNAT incerts
            --  the declaration of (implicit) type having the
            --  corresponding discriminant declarations just before
            --  the derived type declaration, and all the semantic
            --  links in the tree are set to this implicit type

               when N_Record_Definition =>
                  --  the situation is the same as for the previous
                  --  alternative of the external case - the discriminant
                  --  declarations are already here
                  Result_Node := Curr_Node;

               when N_Access_To_Object_Definition =>
                  --  we have to go to the designated type (unwinding other
                  --  access types, if any) which has these discriminants
                  Result_Node := Unwind_Till_Discriminants (Result_Node);

               when others =>
                  Raise_ASIS_Failed
                    ("Norm.Get_Type_With_Discr: " &
                     "error in finding discriminant declarations " &
                     "(for a full_type_declaration)");
            end case;
         when others =>
            Raise_ASIS_Failed
              ("Norm.Get_Type_With_Discr: " &
               "error in finding discriminant declarations");
      end case;

      return Result_Node;
   end Get_Type_With_Discr;

   ------------------------------------------
   -- Normalized_Discriminant_Associations --
   ------------------------------------------

   function Normalized_Discriminant_Associations
     (Constr_Elem : Asis.Element;
      Constr_Node : Node_Id)
      return Asis.Association_List
   is
      Association_Node_List : List_Id := Constraints (Constr_Node);
      --  Association_Node_List cannot be No_List or Empty_List

      Result_Length         : Natural := 0;
      Curr_Association_Node : Node_Id;
   begin
      -------------------------
      -- Implementation Note --
      -------------------------
      --  This code may be incomplete or it may contain errors originated
      --  from incomplete analyziz of the situation. But we need some code
      --  to start from. So this is the first step of the step-by-step
      --  development of this function

      --  First, we have to compute the length of the result. We cannot use
      --  List_Length (Association_Node_List) for it because of the constraints
      --  like this
      --
      --     T (1, 2, D3|D4 => 3)

      Curr_Association_Node := First (Association_Node_List);

      --  First, couting positional associations which go first (if any)
      while Present (Curr_Association_Node) and then
            Nkind (Curr_Association_Node) /= N_Discriminant_Association
      loop
         Result_Length         := Result_Length + 1;
         Curr_Association_Node := Next (Curr_Association_Node);
      end loop;

      --  Now, we have to count named associations (if any), taking into
      --  account bad style like D3|D4 => 3 in discriminant constraints :[

      while Present (Curr_Association_Node) loop
         --  and if we are here, Curr_Association_Node may be of
         --  N_Discriminant_Association kind only
         Result_Length := Result_Length +
                          Natural (List_Length
                            (Selector_Names (Curr_Association_Node)));
         Curr_Association_Node := Next (Curr_Association_Node);
      end loop;

      declare
         Result_List : Asis.Association_List (1 .. Result_Length);

         --  and now we have to build Result_List in a Element-by-Element
         --  manner
         --
         --  The current implementation approach is:
         --
         --  - GNAT (3.05) does not rewrite the tree structures for
         --    discrinminant associations, so we can use the R_Node fields
         --    of the result Elements to point to the corresponding
         --    expression (and, therefore, we can use the general
         --    R_Node-based approach for Enclosing_Element), and we can
         --    use the Node field to point to the defining occurrence
         --    of the corresponding discriminant
         --
         --  - We have to find and to go through the definitions of the
         --    corresponding discriinats anyway - to order the discriminant
         --    associations in the result, as it is required by the
         --    Normalized parameter set True. So it would not make sense to
         --    postpone finding of the discriminant defining name till
         --    it will be required by the
         --    Asis.Expressions.Discriminant_Selector_Names query

         Discr_Spec_Nodes : List_Id;
         --  here we should have the discriminant specifications from the
         --  corresponding discriminant part
         Type_Decl_Node   : Node_Id;
         --  the type declaration containing these discriminant
         --  specifications
         Discr_Spec_Node       : Node_Id;
         Discr_Def_Id_N        : Node_Id;
         Discr_Def_Name        : Name_Id;

         Association_Trav_Node : Node_Id;
         Discr_Sel_N_Node      : Node_Id;

         Is_Positional_Association  : Boolean := True;
         --  flag indicating if the discriminant association to process is
         --  a positional association
      begin
         Type_Decl_Node   := Get_Type_With_Discr (Constr_Node);
         Discr_Spec_Nodes := Discriminant_Specifications (Type_Decl_Node);
         --  we prefer to have this extra step with Type_Decl_Node to
         --  make the maintenanse of finding the discriminant specifications
         --  easier

         Discr_Spec_Node := First (Discr_Spec_Nodes);
         Curr_Association_Node   := First (Association_Node_List);

         for I in 1 .. Result_Length loop
            --  Result_Length is the same as List_Lenght (Discr_Spec_Nodes),
            --  otherwise it is an error!

            --  We have to process positonal and named associations
            --  separately

            --  Positional associations go first, and they do not have
            --  a discriminant names in the tree strututes for the constraint
            --  being processed, so we have to pick up elements one-by-one
            --  from two lists - Discr_Spec_Nodes and Association_Node_List -
            --  and to form one component of Result_List from each pair

            --  Named associations go last, one named association may
            --  be transformed into several normalized ASIS discriminant
            --  associations

            Discr_Def_Id_N := Defining_Identifier (Discr_Spec_Node);

            if Nkind (Curr_Association_Node) = N_Discriminant_Association then
               Is_Positional_Association := False;
            end if;

            if Is_Positional_Association then
               --  First, we create A_Discriminant_Association Elemen
               --  from Curr_Association_Node, as we do it for non-normalized
               --  associations
               Result_List (I) :=  Node_To_Element_New
                              (Starting_Element => Constr_Elem,
                               Node             => Curr_Association_Node,
                               Internal_Kind    => A_Discriminant_Association,
                               Spec_Case        => Is_Normalized);

               --  And now we have to correct the Node field of this Element:
               Set_Node (Result_List (I), Discr_Def_Id_N);

               --  And now we have to prepare the next iteration of the loop:
               Curr_Association_Node   := Next (Curr_Association_Node);
            else
               Discr_Def_Name := Chars (Discr_Def_Id_N);
               Association_Trav_Node  := Curr_Association_Node;
               --  as soon as all the positional associations have been
               --  processed, Curr_Association_Node is frozed as pointed to the
               --  first named association (if any)

               Scan_Named_Associations : while Present (Association_Trav_Node)
               loop
                  --  this loop scans all the named associations
                  Discr_Sel_N_Node :=
                     First (Selector_Names (Association_Trav_Node));

                  while Present (Discr_Sel_N_Node) loop
                  --  This loop cans all the discriminant selector names
                  --  in a given named discriminant association

                     exit Scan_Named_Associations
                        when Chars (Discr_Sel_N_Node) = Discr_Def_Name;

                     Discr_Sel_N_Node := Next (Discr_Sel_N_Node);
                  end loop;

                  Association_Trav_Node := Next (Association_Trav_Node);
               end loop Scan_Named_Associations;

               --  and when we are here, Association_Trav_Node points to the
               --  (named) discriminant association containing the expression
               --  for Discr_Spec_Node and Discr_Def_Id_N being processed. So:


               Result_List (I) := Node_To_Element_New
                 (Starting_Element => Constr_Elem,
                  Node             => Sinfo.Expression (Association_Trav_Node),
                  Internal_Kind    => A_Discriminant_Association,
                  Spec_Case        => Is_Normalized);

               --  And now we have to correct the Node field of this Element,
               --  just as for positional associations:

               Set_Node (Result_List (I), Discr_Def_Id_N);
            end if;
            Discr_Spec_Node := Next (Discr_Spec_Node);
            --  this should not be under "if Is_Positional_Association",
            --  because we have to go one step ahead in Discr_Spec_Nodes
            --  for every iteration of this loop
         end loop;

         return Result_List;

      end;
      --  and this end is the end for the block statement
      --  where Result_List is defined
   exception
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Nil_Element,
            Outer_Call =>
               Package_Name & "Normalized_Discriminant_Associations");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument   => Nil_Element,
            Diagnosis => "Norm.Normalized_Discriminant_Associations");
   end Normalized_Discriminant_Associations;

   -------------------------------------
   -- Normalized_Generic_Associations --
   -------------------------------------

   function Normalized_Generic_Associations
     (Inst_Elem          : Asis.Element;
      Templ_Node         : Node_Id;
      Association_Number : Positive)
      return Asis.Association_List
   is
      Result              : Association_List (1 .. Association_Number);
      Inst_Node           : Node_Id := R_Node (Inst_Elem);
      Current_Association : ASIS_Positive := 1;
      --  the number of the normalized generic association in Result
      --  being currently processed in the main loop
      Current_Formal      : Node_Id;
      Curr_Form_Original  : Node_Id;
      --  the generic formal parameter declaration node currently
      --  processed, corresponds to Current_Associationin the Result
      Current_Formal_Def  : Node_Id;
      --  the node representing the defining identifier or the defining
      --  program unit name from Current_Formal
      Current_Actual      : Node_Id;
      --  the node representing the actual parameter being a part of
      --  normalized generic association to be constructed
      Current_Spec_Case   : Special_Cases;

      Still_Positional    : Boolean := True;
      --  during constructing the result we traverse both the formal part
      --  and instantiation. This flag shows if we are in the positional
      --  (if any) or in the named (if any) part of the generic
      --  actual part.
      Next_Positional_Actual : Node_Id := Empty;
      --  This is the next generic association (if any) being traversed in
      --  the positional part of the generic actual part. When all
      --  the positional part is traversed, but there are some named
      --  associations after them it is set to the first named
      --  association. Remains equial to Empty, if there is
      --  no generic actual part.
      Next_Actual : Node_Id;
      --  just needed to traverse the generic actual part, when looking
      --  among the named associations for the explicitly provided actual
      Actual_Found : Boolean;

      No_More_Actual : Boolean := False;
      --  Is set to True, when there is no more actual to investigate
      --  in the generic actual part

      procedure Find_Default;
      --  This procedure works on all the objects declared above in
      --  Normalized_Generic_Associations as on global variables.
      --  It should be called if a generic actual part does not contain
      --  any actual for a given pair of Current_Formal-Current_Ass, and
      --  it defines the default to be used in the notmalized generic
      --  association, that is, it defines Current_Actual and
      --  Current_Spec_Case.

      procedure Find_Default is
      begin
         --  if we do not have a box in the declaration of the
         --  corresponding actual parameter, then everything is simple:
         if Nkind (Current_Formal) = N_Formal_Object_Declaration then
            Current_Actual    := Sinfo.Expression (Current_Formal);
            Current_Spec_Case := Is_Normalized_Defaulted;
         elsif Nkind (Current_Formal) =
                  N_Formal_Subprogram_Declaration and then
               Present (Default_Name (Current_Formal))
         then
            Current_Actual    := Default_Name (Current_Formal);
            Current_Spec_Case := Is_Normalized_Defaulted;

         elsif Nkind (Current_Formal) =
                  N_Formal_Subprogram_Declaration and then
               Box_Present (Current_Formal)
         then
            --  and this is the most interesting case...
            --  We need the implicit name defining the actual subprogram
            --  defined at the place of *instantiation*.
            --  We'll go into the artificial package created by the compiler
            --  just before the corresponding instantiation in the declaration
            --  list in the tree, and we'll take the corresponding name
            --  from this package
            --
            --  ??? This approach does not seem to be the only possible.
            --  ??? It looks like the compiler generates the corresponding
            --  ??? generic association also as a part of the tree structure
            --  ??? for the generic actual part, but because of the problem
            --  ??? with the tree dump in 3.11w, we cannot investigate this
            --  ??? in full details

            --  This is the artificial package created for the instantiation
            Next_Actual := Prev (Inst_Node);

            if Nkind (Next_Actual) = N_Package_Body then
               --  Skipping expanded body
               Next_Actual := Prev (Next_Actual);
            end if;

            --  this is the first declaration in this package, it corresponds
            --  to the actual provided fot the first generic formal
            --  parameter
            Next_Actual :=
               First (Visible_Declarations (Specification (Next_Actual)));
            --  and now coming to the parameter number Current_Ass
            for I in 1 .. Current_Association - 1 loop
               Next_Actual := Next (Next_Actual);
            end loop;
            --  here we should have got Next_Actual as
            --  N_Subprogram_Renaming_Declaration node. So we just pick up
            --  callable_entity_NAME from it:
            Current_Actual    := Sinfo.Name (Next_Actual);
            Current_Spec_Case := Is_Normalized_Defaulted_For_Box;
         else
            pragma Assert (False);
            --  should be removed, when the implementation is fully tested!!!
            null;
         end if;
      end Find_Default;

   begin --  Normalized_Generic_Associations

      ----------------------------------------------------------
      --  The implementation approach and the representation  --
      --  of the normalized generic associations              --
      ----------------------------------------------------------

      --  Each normalized generic association in ASIS is represented by
      --  three nodes:
      --
      --  R_Node -        represents the corresponding instantiation,
      --                  is used for Enclosing_Element purposes only;
      --  Node   -        represents the defining node of the corresponding
      --                  generic formal parameter;
      --  Node_Field_1 -  represents the actual parameter
      --
      --  See also the documentation of Asis.Expressions.Actual_Parameter
      --  for the details of obtaining the actual parameter from
      --  a normalized generic association

      if Nkind (Inst_Node) not in
         N_Function_Instantiation .. N_Procedure_Instantiation
      then
         --  may be the case for library-level instantiations ???
         Inst_Node := Node (Inst_Elem);
      end if;

      if No (Generic_Associations (Inst_Node)) then
         Still_Positional := False;
         No_More_Actual   := True;
      else
         Next_Positional_Actual := First (Generic_Associations (Inst_Node));
         if Present (Selector_Name (Next_Positional_Actual)) then
            Still_Positional := False;
         end if;
      end if;

      Current_Formal     := First (Generic_Formal_Declarations (Templ_Node));
      Curr_Form_Original := Original_Node (Current_Formal);
      --  it cannot be any pragma inside a formal part, so we do not
      --  need First/Next_Non_Pragma here

      --  This is the main loop, where the next normalized generic
      --  association is created
      while Present (Current_Formal) loop
         --  The only thing we really have to compute is the actual
         --  parameter for a given association. Three cases can be possible:
         --  1. an actual is passed in the generic association
         --  2. the default defined in the specification of the corresponding
         --     formal parameter is used
         --  3. the corresponding formal procedure has A_Box_Default, and
         --     the actual is defined at the place of the instantiation

         if Nkind (Curr_Form_Original) = N_Formal_Subprogram_Declaration then
            Current_Formal_Def :=
               Defining_Unit_Name (Specification (Curr_Form_Original));
         else
            Current_Formal_Def := Defining_Identifier (Curr_Form_Original);
         end if;

         --  first, trying to define, if there is an actual in the generic
         --  actual part
         if Still_Positional then
            --  well-defined case - we have an actual in the generic
            --  actual part. So, let's just pick it up:
            Current_Actual :=
               Explicit_Generic_Actual_Parameter (Next_Positional_Actual);
            Current_Spec_Case := Is_Normalized;
            --  And now we have to try to move Next_Positional_Actual in the
            --  generic actual part.
            if Present (Next (Next_Positional_Actual)) then
               Next_Positional_Actual := Next (Next_Positional_Actual);
               if Present (Selector_Name (Next_Positional_Actual)) then
                  Still_Positional := False;
               end if;
            else
               Still_Positional := False;
               No_More_Actual   := True;
            end if;
         elsif not No_More_Actual then
            --  Here we have to investigate the named generic associations
            --  to see if there is an actual for the currently created
            --  normalized ASIS association. We just go through all the
            --  named associations and compare Current_Formal_Def with
            --  the name of the formal from an association
            Next_Actual := Next_Positional_Actual;
            Actual_Found := False;
            while Present (Next_Actual) loop
               --  comparing Current_Formal_Def with the name of the
               --  formal parameter in a named association all we have
               --  to compare are Chars field
               if Comes_From_Source (Next_Actual) and then
                  (Chars (Current_Formal_Def) =
                   Chars (Selector_Name (Next_Actual)))
               then
                  Current_Actual :=
                     Explicit_Generic_Actual_Parameter (Next_Actual);
                  Current_Spec_Case := Is_Normalized;
                  Actual_Found := True;
                  exit;
               end if;
               Next_Actual := Next (Next_Actual);
            end loop;
            if not Actual_Found then
               Find_Default;
            end if;
         else
            --  for sure, no actual is provided in the generic actual
            --  part for a given association. We have to pick up the
            --  corresponding default parameter
            Find_Default;
         end if;

         Result (Current_Association) :=
            Node_To_Element_New (Node             => Inst_Node,
                                 Node_Field_1     => Current_Actual,
                                 Starting_Element => Inst_Elem,
                                 Internal_Kind    => A_Generic_Association,
                                 Spec_Case        => Current_Spec_Case);

         --  and here we have to correct the following fields in this
         --  component of the result:

         --  first, Node_To_Element_New set the Node field as Original_Node
         --  of Inst_Node, but we need the defining occurence of the formal
         --  parameter here, therefore:
         Set_Node (Result (Current_Association), Current_Formal_Def);

         --  then, we have to set On the Is_Part_Of_Implicit flag
         Set_From_Implicit (Result (Current_Association));

         Current_Formal       := Next (Current_Formal);
         Current_Association  := Current_Association + 1;
      end loop;

      return Result;

   exception
      when Assert_Error : System.Assertions.Assert_Failure =>
         Raise_ASIS_Failed (
            Argument  => Nil_Element,
            Diagnosis =>
               Package_Name & "Normalized_Generic_Associations - "  & LT
            & "Assert_Failure at "
            &  Ada.Exceptions.Exception_Message (Assert_Error));
      when others =>
         Raise_ASIS_Failed (
            Argument  => Nil_Element,
            Diagnosis =>
               Package_Name & "Normalized_Generic_Associations");
   end Normalized_Generic_Associations;

   -----------------------------------
   -- Normalized_Param_Associations --
   -----------------------------------

   function Normalized_Param_Associations
     (Call_Elem : Asis.Element;
      Call_Node : Node_Id)
      return Asis.Association_List
   is
      Association_Node_List : List_Id := Parameter_Associations (Call_Node);
      Result_Length         : Natural :=
         Natural (List_Length (Association_Node_List));

      Curr_Association_Node : Node_Id;
      Last_Association_Elem : Natural := 0;

      Result_List   : Asis.Association_List (1 .. Result_Length);
      --  and we will have to create the elements of Result_List
      --  one by one...
   begin
      --  Association_Node_List contains all the associations to be included in
      --  the result, but they may be ordered in a way that does not
      --  correspond to the ordering requared in the normalized list

      --  In this function all what we do is ordering assosiations
      --  in a proper way and setting Is_Normalized as a special case
      --  for all of them

      --  Well, position assotiations (if any should go first ordered
      --  in the Result_List in the same way as they are oredered in
      --  Association_Node_List:

      Curr_Association_Node := First (Association_Node_List);

      for I in 1 .. Result_Length loop
         exit when Nkind (Curr_Association_Node) = N_Parameter_Association;
         --  we have nothing to do in this loop after that: positional
         --  associations (if any) go first

         Last_Association_Elem := Last_Association_Elem + 1;

         Result_List (Last_Association_Elem) :=
            Node_To_Element_New
              (Starting_Element => Call_Elem,
               Node             => Curr_Association_Node,
               Internal_Kind    => A_Parameter_Association,
               Spec_Case        => Is_Normalized);

         Curr_Association_Node := Next (Curr_Association_Node);
      end loop;

      --  and here we have to add to Result_List the named associations
      --  starting from (Last_Association_Elem + 1) in Result_List, but NOT
      --  from Curr_Association_Node in Association_Node_List!

      Curr_Association_Node := First_Named_Actual (Call_Node);
      --  note, that now Curr_Association_Node points to the parameter, but
      --  not to its parent N_Parameter_Association node!

      while Present (Curr_Association_Node) loop
         --  we may have no named association to process, but the loop
         --  condition takes this into account
         Curr_Association_Node := Parent (Curr_Association_Node);
         --  here we are in N_Parameter_Association node

         Last_Association_Elem := Last_Association_Elem + 1;

         Result_List (Last_Association_Elem) :=
            Node_To_Element_New
              (Starting_Element => Call_Elem,
               Node             => Curr_Association_Node,
               Internal_Kind    => A_Parameter_Association,
               Spec_Case        => Is_Normalized);

         Curr_Association_Node := Next_Named_Actual (Curr_Association_Node);

      end loop;

      return Result_List;
   exception
      when others =>
         Raise_ASIS_Failed (
            Argument  => Nil_Element,
            Diagnosis => Package_Name & "Normalized_Param_Associations");
   end Normalized_Param_Associations;

   -------------------------------
   -- Unwind_Till_Discriminants --
   -------------------------------

   function Unwind_Till_Discriminants (Type_Decl : Node_Id) return Node_Id is
      Result_Node : Node_Id;
      Curr_Node   : Node_Id;
   begin
      Result_Node := Type_Decl;

      while not Has_Discriminants (Defining_Identifier (Result_Node)) loop
         --  each iteration of the loop unwinds one step of "derivind"
         --  or "accessing"
         --
         --  !!!???!!!??? What really happens with private types in the tree
         if Nkind (Result_Node) = N_Full_Type_Declaration then
            Curr_Node := Sinfo.Type_Definition (Result_Node);

            if Nkind (Curr_Node) = N_Derived_Type_Definition or else
               --  ??can it really happen???
               Nkind (Curr_Node) = N_Access_To_Object_Definition
            then
               Curr_Node := Sinfo.Subtype_Mark (Curr_Node);
            else
               goto Error;
            end if;

            if Nkind (Curr_Node) = N_Subtype_Indication then
               --  this is an error situation - we cannot get any type
               --  with discriminants
               goto Error;
            end if;

         elsif Nkind (Result_Node) = N_Formal_Type_Declaration then
            Curr_Node := Sinfo.Formal_Type_Definition (Result_Node);

            if Nkind (Curr_Node) = N_Formal_Derived_Type_Definition then
               --  ??can it really happen???
               Curr_Node := Sinfo.Subtype_Mark (Curr_Node);
            elsif Nkind (Curr_Node) = N_Access_To_Object_Definition then
               Curr_Node := Sinfo.Subtype_Indication (Curr_Node);
               if Nkind (Curr_Node) = N_Subtype_Indication then
                  --  this is an error situation - we cannot get any type
                  --  with discriminants
                  goto Error;
               end if;
               Curr_Node := Base_Type (Curr_Node);
            else
               goto Error;
            end if;
         else
            goto Error;
         end if;

         --  as the result of this if statement, we have the subtype mark
         --  of the designated/parent subtype

         Curr_Node   := Base_Type (Entity (Curr_Node));
         Result_Node := Parent (Curr_Node);
      end loop;

      return Result_Node;

      <<Error>> Raise_ASIS_Failed (Diagnosis => Package_Name &
         "Unwind_Till_Discriminants - wrong node is traversed");
   exception
      when ASIS_Failed =>
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Nil_Element,
            Diagnosis => Package_Name & "Unwind_Till_Discriminants");
   end Unwind_Till_Discriminants;

end A4G.Norm;
