------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                   A 4 G . S P A N _ B E G I N N I N G                    --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--            Copyright (c) 1995-1999, 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 Asis;               use Asis;
with Asis.Elements;      use  Asis.Elements;
with Asis.Declarations;  use  Asis.Declarations;
with Asis.Definitions;   use  Asis.Definitions;
with Asis.Expressions;   use  Asis.Expressions;
with Asis.Statements;    use  Asis.Statements;
with Asis.Clauses;       use  Asis.Clauses;

with Asis.Set_Get;       use  Asis.Set_Get;
with A4G.Int_Knds;       use A4G.Int_Knds;
with A4G.Vcheck;         use A4G.Vcheck;
with A4G.A_Sinput;       use A4G.A_Sinput;
with A4G.A_Types;        use A4G.A_Types;

with Types;              use  Types;
with Atree;              use Atree;
with Sinfo;              use Sinfo;

package body A4G.Span_Beginning is

   --  !!!??? This file is '-gnatg-compilable', but both its content and its
   --  !!!???  documentation need revising

--  From here and below : for Debugging purposes
--    Ch : Character;
   LT : String renames ASIS_Line_Terminator;
--  From here and above : for Debugging purposes

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

   function Set_Image_Beginning (E : Asis.Element) return Source_Ptr is
   begin
      return Switch (Int_Kind (E)) (E);
   end Set_Image_Beginning;

   ----------------------------------------------------------------------------
   function No_Switch (E : Asis.Element) return Source_Ptr is
   begin

      Raise_ASIS_Failed ("*** A4G.Span_Beginning.No_Switch:"
                    & LT
                    & " this function should never be called");

      return No_Location;

   end No_Switch;

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

   function No_Search (E : Asis.Element) return Source_Ptr is
      S : Source_Ptr := Get_Location (E);
   begin
      return S;
   end No_Search;

   ----------------------------------------------------------------------------
   function Search_Identifier_Beginning
     (E : Asis.Element)
      return Source_Ptr
   is
      S : Source_Ptr := Get_Location (E);
   begin
      if Nkind (Node (E)) = N_Attribute_Definition_Clause then
         --  this is a case of the attribute designator in a
         --  pseudo-attribute-reference from an attribute
         --  definition clause
         S := Sloc (Sinfo.Name (Node (E)));
         S := Search_Rightmost_Symbol (S, ''');
         S := Next_Identifier (S);
      elsif Nkind (Node (E)) = N_Attribute_Reference then
         S := Next_Identifier (S);
      end if;
      return S;
   end Search_Identifier_Beginning;
   ----------------------------------------------------------------------------
   function Search_Subtype_Indication_Beginning
     (E : Asis.Element)
      return Source_Ptr
   is
   begin
      return Set_Image_Beginning (Asis.Definitions.Subtype_Mark (E));
   end Search_Subtype_Indication_Beginning;
   ----------------------------------------------------------------------------

   function Search_Prefix_Beginning (E : Asis.Element) return Source_Ptr is
      Prefix_To_Search : Asis.Element := E;
   --    S : Source_Ptr := Get_Location(E) - 1; -- Alain's fix
      E_Kind : Internal_Element_Kinds := Int_Kind (Prefix_To_Search);
   begin
      if E_Kind = A_Range_Attribute_Reference          or else
         E_Kind = A_Discrete_Range_Attribute_Reference or else
         E_Kind = A_Discrete_Range_Attribute_Reference_As_Subtype_Definition
      then
         Prefix_To_Search :=
            Asis.Definitions.Range_Attribute (Prefix_To_Search);
      elsif E_Kind = A_Qualified_Expression then

         Prefix_To_Search :=
            Asis.Expressions.Converted_Or_Qualified_Subtype_Mark
              (Prefix_To_Search);
      end if;

      if Int_Kind (Prefix_To_Search) = A_Defining_Expanded_Name then
         Prefix_To_Search :=
            Asis.Declarations.Defining_Prefix (Prefix_To_Search);
      elsif Int_Kind (Prefix_To_Search) = An_Identifier then
         return Set_Image_Beginning (Prefix_To_Search);
      else
         Prefix_To_Search := Asis.Expressions.Prefix (Prefix_To_Search);
      end if;
      return Set_Image_Beginning (Prefix_To_Search); -- Alain's fix

   end Search_Prefix_Beginning;

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

   function Component_And_Parameter_Declaration_Beginning
     (E : Asis.Element)
      return Source_Ptr
   is
      Ls : Asis.Element_List := Names (E);
   begin
      return Get_Location (Ls (Ls'First));
   end Component_And_Parameter_Declaration_Beginning;

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

   function Exception_Declaration_Beginning
     (E : Asis.Element)
      return Source_Ptr
   is
      Ls : Asis.Element_List := Names (E);
   begin
      return Get_Location (Ls (Ls'First));
   end Exception_Declaration_Beginning;

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

      ----------------------------------
      -- Derived_Definition_Beginning --
      ----------------------------------

      function Derived_Definition_Beginning
        (E : Asis.Element)
         return Source_Ptr
      is
         S : Source_Ptr := Get_Location (E);
      begin
         if Trait_Kind (E) = An_Abstract_Trait and then
            Int_Kind (E) /=  A_Formal_Derived_Type_Definition
         then
            --  the second condition is just a patch, needed because of the
            --  tree rewritting...
            S := Search_Prev_Word (S);
            S := Search_Beginning_Of_Word (S);
         end if;

         return S;

      end Derived_Definition_Beginning;

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

   function Type_Definition_Beginning (E : Asis.Element) return Source_Ptr is
      S  : Source_Ptr       := Get_Location (E);
      Tr : Asis.Trait_Kinds := Trait_Kind (E);
   begin
      if Tr = A_Limited_Trait or else Tr = A_Limited_Private_Trait then
         S := Search_Prev_Word (S);
         S := Search_Beginning_Of_Word (S);
      end if;

      return S;

   end Type_Definition_Beginning;

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

      --------------------------------------
      -- Tagged_Type_Definition_Beginning --
      --------------------------------------

      function Tagged_Type_Definition_Beginning
        (E : Asis.Element)
         return Source_Ptr
      is
         S  : Source_Ptr       := Get_Location (E);
         Tr : Asis.Trait_Kinds := Trait_Kind (E);
      begin

         --  S points either to RECORD or to NULL. Therefore, we have
         --  to go at least one word left to take into account the
         --  TAGGED keyword. Depending on the trait, we may have one
         --  ot two more words left

         S := Search_Prev_Word (S);
         S := Search_Beginning_Of_Word (S);

         if Tr = An_Abstract_Limited_Trait         or else
            Tr = A_Limited_Trait                   or else
            Tr = An_Abstract_Limited_Private_Trait or else
            Tr = A_Limited_Private_Trait
         then
            S := Search_Prev_Word (S);
            S := Search_Beginning_Of_Word (S);
         end if;

         if Tr = An_Abstract_Limited_Trait         or else
            Tr = An_Abstract_Trait                 or else
            Tr = An_Abstract_Limited_Private_Trait or else
            Tr = An_Abstract_Private_Trait
         then
            S := Search_Prev_Word (S);
            S := Search_Beginning_Of_Word (S);
         end if;

         return S;

      end Tagged_Type_Definition_Beginning;

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

   function Simple_Expression_Range_Beginning
     (E : Asis.Element)
      return Source_Ptr
   is
      El : Asis.Element := Lower_Bound (E);
   begin

      return Set_Image_Beginning (El);

   end Simple_Expression_Range_Beginning;

   ----------------------------------------------------------------------------
      ------------------------------------
      -- Component_Definition_Beginning --
      ------------------------------------

      function Component_Definition_Beginning
        (E : Asis.Element)
         return Source_Ptr
      is
         Arg_Node   : Node_Id    := Node (E);
         Arg_N_Kind : Node_Kind  := Nkind (Arg_Node);
         S          : Source_Ptr := Sloc (Arg_Node);
         --  S may be corrected
         Dummy      : Asis.Element := E;
         --  I am not sure that using this Dummy element makes a good style...
         --  ???
      begin
         --  first, we should set S pointing to the beginning of the subtype
         --  indication:

         case Arg_N_Kind is
            when N_Subtype_Indication | N_Identifier =>
               null;
               --  no need to adjust S
            when N_Expanded_Name =>
               --  S points to period and it should be processed as
               --  A_Selected_Component element here:
               Set_Int_Kind (Dummy, A_Selected_Component); --  ???
               S := Search_Prefix_Beginning (Dummy);
            when others =>
               Raise_ASIS_Failed (Diagnosis =>
                  "A4G.Span_Beginning.Component_Definition_Beginning:" & LT &
                  "unexpected node kind for A_Component_Definition (" &
                  Node_Kind'Image (Arg_N_Kind) & ")");
         end case;
         --  And now - taking into account the aliased keyword, if any:
         if Trait_Kind (E) = An_Aliased_Trait then
            S := Search_Prev_Word (S);
            S := Search_Beginning_Of_Word (S);
         end if;
         return S;
      end Component_Definition_Beginning;
   ----------------------------------------------------------------------------

   function Search_Left_Parenthesis_After
      (E : Asis.Element) return Source_Ptr
   is
      S : Source_Ptr := Get_Location (E);
   begin
      return Search_Rightmost_Symbol (S, '(');
   end Search_Left_Parenthesis_After;

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

   function Private_Extension_Definition_Beginning
     (E : Asis.Element)
      return Source_Ptr
   is
      N : Node_Id    := Node (E);
      S : Source_Ptr;
   begin
      --  PRIVATE_EXTENSION_DECLARATION ::=
      --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is
      --      [abstract] new ancestor_SUBTYPE_INDICATION with private;

      --  Note: private extension declarations are not allowed in Ada 83 mode

      --  N_Private_Extension_Declaration
      --  Sloc points to TYPE
      --  Defining_Identifier (Node1)
      --  Discriminant_Specifications (List4) (set to No_List if no
      --   discriminant part)
      --  Unknown_Discriminants_Present (Flag13) set if (<>) discriminant
      --  Abstract_Present (Flag4)
      --  Subtype_Indication (Node5)

      N := Sinfo.Subtype_Indication (N);
      S := Sloc (N);
      --  S points to the first character of ancestor_SUBTYPE_INDICATION

      S := Search_Prev_Word_Start (S);
      --  "new" was skipped now
      if Abstract_Present (Parent (N))then
         --  skipping "abstract":
         S := Search_Prev_Word_Start (S);
      end if;

      return S;
   end Private_Extension_Definition_Beginning;

   ----------------------------------------------------------------------------
   function Private_Type_Definition_Beginning
     (E : Asis.Element)
      return Source_Ptr
   is
      N : Node_Id    := Node (E);
      S : Source_Ptr := Sloc (N);
   begin
         --  PRIVATE_TYPE_DECLARATION ::=
         --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART]
         --      is [[abstract] tagged] [limited] private;

         --  Note: TAGGED is not permitted in Ada 83 mode

         --  N_Private_Type_Declaration
         --  Sloc points to TYPE
         --  Defining_Identifier (Node1)
         --  Discriminant_Specifications (List4) (set to No_List if no
         --   discriminant part)
         --  Unknown_Discriminants_Present (Flag13) set if (<>) discriminant
         --  Abstract_Present (Flag4)
         --  Tagged_Present (Flag15)
         --  Limited_Present (Flag17)
      S := Search_Rightmost_Symbol (S, ';');

      --  skipping "private"
      S := Search_Prev_Word_Start (S);
      if Tagged_Present (N) then
         --  skipping "tagged"
         S := Search_Prev_Word_Start (S);
      end if;

      --  skipping "abstract"
      if Abstract_Present (N) then
         S := Search_Prev_Word_Start (S);
      end if;

      --  skipping "limited"
      if Limited_Present (N) then
         S := Search_Prev_Word_Start (S);
      end if;

      return S;
   end Private_Type_Definition_Beginning;
   ----------------------------------------------------------------------------
   function Explicit_Dereference_Beginning
     (E : Asis.Element)
      return Source_Ptr
   is
   begin
      return Set_Image_Beginning (Asis.Expressions.Prefix (E));
   end Explicit_Dereference_Beginning;
   ----------------------------------------------------------------------------

   function Function_Call_Beginning (E : Asis.Element) return Source_Ptr is
   begin

      if Is_Prefix_Call (E) then
         return Set_Image_Beginning (Asis.Expressions.Prefix (E));
      else

         declare
            Param : Asis.Element_List := Function_Call_Parameters (E);
         begin
            if Param'Length > 1 then
               return Set_Image_Beginning (Param (Param'First));
            else
               return Set_Image_Beginning (Asis.Expressions.Prefix (E));
            end if;
         end;

      end if;
   end Function_Call_Beginning;

   ----------------------------------------------------------------------------
   -----------------------------
   -- Short_Circuit_Beginning --
   -----------------------------

   function Short_Circuit_Beginning (E : Asis.Element) return Source_Ptr is
   begin
      return Set_Image_Beginning (Short_Circuit_Operation_Left_Expression (E));
   end Short_Circuit_Beginning;

   -------------------------------
   -- Membership_Test_Beginning --
   -------------------------------

   function Membership_Test_Beginning (E : Asis.Element) return Source_Ptr is
   begin
      return Set_Image_Beginning (Membership_Test_Expression (E));
   end Membership_Test_Beginning;

   ------------------------------
   -- Null_Component_Beginning --
   ------------------------------

   function Null_Component_Beginning (E : Asis.Element) return Source_Ptr is
      S : Source_Ptr := Get_Location (E);
   begin
      --  first, looking for ';' after "null"
      S := Search_Rightmost_Symbol (S, ';');
      --  then, going to the left to this "null" itself:
      S := Search_Prev_Word (S);
      --  it can ne nothing except comments between this ';' and "null", so:
      S := S - 3;
      return S;
   end Null_Component_Beginning;

   ---------------------------------------------------------------------------
   --  ??? <tree problem 4.1>
   ---------------------------------
   -- Indexed_Component_Beginning --
   ---------------------------------

   function Indexed_Component_Beginning (E : Asis.Element) return Source_Ptr
   is
   begin
      return Set_Image_Beginning (Asis.Expressions.Prefix (E));
   end Indexed_Component_Beginning;
   --  ??? <tree problem 4.1>  -- end

   -------------------------------------
   -- Component_Association_Beginning --
   -------------------------------------

   function Component_Association_Beginning
     (E : Asis.Element)
      return Source_Ptr
   is
      First_Choice : Asis.Element := Asis.Nil_Element;
   begin
      if Int_Kind (E) = An_Array_Component_Association then
         declare
            Choices : Asis.Element_List := Array_Component_Choices (E);
         begin
            if not Is_Nil (Choices) then
               First_Choice := Choices (Choices'First);
            end if;
         end;
      else  --  Int_Kind (E) = A_Record_Component_Association
         declare
            Choices : Asis.Element_List := Record_Component_Choices (E);
         begin
            if not Is_Nil (Choices) then
               First_Choice := Choices (Choices'First);
            end if;
         end;
      end if;

      if not Is_Nil (First_Choice) then
         return Set_Image_Beginning (First_Choice);
      else
         return Set_Image_Beginning (Component_Expression (E));
      end if;
   end Component_Association_Beginning;

   -------------------------------------
   -- Parameter_Association_Beginning --
   -------------------------------------

   function Parameter_Association_Beginning
     (E : Asis.Element)
      return Source_Ptr
   is
      Formal_Param : Asis.Element := Formal_Parameter (E);
   begin
      if Is_Nil (Formal_Param) then
         return Set_Image_Beginning (Asis.Expression (Actual_Parameter (E)));
      else
         --  we have nothing to do: Sloc points to the first token of the
         --  formal parameter name in the given Named association
         return No_Search (E);
      end if;
   end Parameter_Association_Beginning;

   function Parenthesized_Expression_Beginning
     (E : Asis.Element)
      return Source_Ptr
   is
      El : Asis.Element    := Expression_Parenthesized (E);
      S  : Source_Ptr := Set_Image_Beginning (El);
   begin
      return  Search_Left_Parenthesis (S);
   end Parenthesized_Expression_Beginning;

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

   function Assignment_Statement_Beginning
     (E : Asis.Element)
      return Source_Ptr
   is
      El : Asis.Element := Assignment_Variable_Name (E);
   begin
      return Set_Image_Beginning (El);
   end Assignment_Statement_Beginning;

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

   function Named_Statement_Beginning (E : Asis.Element) return Source_Ptr is
      El : Asis.Element := Statement_Identifier (E);
   begin
      if not Is_Nil (El) then
         return Set_Image_Beginning (El);
      else
         return Get_Location (E);
      end if;
   end Named_Statement_Beginning;
   ----------------------------------------------------------------------------
   function Call_Statement_Beginning (E : Asis.Element) return Source_Ptr is
   begin
      return Set_Image_Beginning (Asis.Statements.Called_Name (E));
   end Call_Statement_Beginning;
   ----------------------------------------------------------------------------

   function While_Loop_Statement_Beginning
     (E : Asis.Element)
      return Source_Ptr
   is
      El : Asis.Element := Statement_Identifier (E);
      S  : Source_Ptr;
   begin

      if not Is_Nil (El) then
         return Set_Image_Beginning (El);
      end if;

      El := While_Condition (E);

      S := Set_Image_Beginning (El);
      S := Search_Prev_Word (S);
      S := Search_Beginning_Of_Word (S);

      return S;

   end While_Loop_Statement_Beginning;

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

   function For_Loop_Statement_Beginning
     (E : Asis.Element)
      return Source_Ptr
   is
      El : Asis.Element := Statement_Identifier (E);
      S  : Source_Ptr;

   begin

      if not Is_Nil (El) then
         return Set_Image_Beginning (El);
      end if;

      El := For_Loop_Parameter_Specification (E);

      if not Is_Nil (El) then
         S := Set_Image_Beginning (El);
         S := Search_Prev_Word (S);
         S := Search_Beginning_Of_Word (S);
         return S;
      else
         return Get_Location (E);
      end if;

   end For_Loop_Statement_Beginning;

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

   function Else_Path_Beginning (E : Asis.Element) return Source_Ptr is
      Ls : Asis.Element_List :=
        Sequence_Of_Statements (Path            => E,
                                Include_Pragmas => True);
      S : Source_Ptr := Set_Image_Beginning (Ls (Ls'First));
   begin
      S := Search_Prev_Word (S);
      S := Search_Beginning_Of_Word (S);
      return S;
   end Else_Path_Beginning;
   ----------------------------------------------------------------------------

   function With_Clause_Beginning (E : Asis.Element) return Source_Ptr is

      S : Source_Ptr := Get_Location (E);

   begin

      S := Search_Prev_Word (S);
      S := Search_Beginning_Of_Word (S);

      return S;

   end With_Clause_Beginning;

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

   function Component_Clause_Beginning (E : Asis.Element) return Source_Ptr is

      El : Asis.Element := Representation_Clause_Name (E);

   begin

      return Set_Image_Beginning (El);

   end Component_Clause_Beginning;

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

   -------------------------------
   -- Subprogram_Spec_Beginning --
   -------------------------------

   function Subprogram_Spec_Beginning (E : Asis.Element) return Source_Ptr is
      N : Node_Id := Node (E);
   begin
      N := Specification (N);
      return Sloc (N);
   end Subprogram_Spec_Beginning;

   -----------------------------------------
   -- Formal_Object_Declaration_Beginning --
   -----------------------------------------

   function Formal_Object_Declaration_Beginning
     (E : Asis.Element)
      return Source_Ptr
   is
      N : Node_Id := Node (E);
   begin
      return Sloc (Sinfo.Defining_Identifier (N));
   end Formal_Object_Declaration_Beginning;

end A4G.Span_Beginning;