------------------------------------------------------------------------------
--                                                                          --
--             ASIS Tester And iNTerpreter (ASIStant) COMPONENTS            --
--                                                                          --
--                        A S I S T A N T . C A L L                         --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (c) 1997-2006, Free Software Foundation, Inc.         --
--                                                                          --
-- ASIStant  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.  ASIStant is  distributed  in the hope  that it will be useful, --
-- 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 GNAT;  see file COPYING. If --
-- not,  write to the  Free Software Foundation,  51 Franklin Street, Fifth --
-- Floor, Boston, MA 02110-1301, USA.                                       --
--                                                                          --
-- ASIStant  is an evolution of  ASIStint tool that was created by  Vasiliy --
-- Fofanov  as  part  of  a  collaboration  between  Software   Engineering --
-- Laboratory  of the  Swiss  Federal Institute of Technology in  Lausanne, --
-- Switzerland,  and the Scientific Research Computer Center of the  Moscow --
-- University, Russia,  supported by the  Swiss National Science Foundation --
-- grant #7SUPJ048247, "Development of ASIS for GNAT with industry quality" --
--                                                                          --
-- ASIStant  is  distributed as a part of the  ASIS implementation for GNAT --
-- (ASIS-for-GNAT) and is maintained by AdaCore (http://www.adacore.com).   --
------------------------------------------------------------------------------

with Asis; use Asis;

with Asis.Compilation_Units.Relations; use  Asis.Compilation_Units.Relations;
with Asis.Errors;
with Asis.Exceptions;                  use Asis.Exceptions;
with Asis.Implementation;

with ASIStant.Add_Ons;                 use ASIStant.Add_Ons;
with ASIStant.Ambiguous_Mapping;       use ASIStant.Ambiguous_Mapping;
with ASIStant.FuncArr;                 use ASIStant.FuncArr;
with ASIStant.String_Handling;
with ASIStant.Text_IO;                 use ASIStant.Text_IO;
with ASIStant.XTable;                  use ASIStant.XTable;

package body ASIStant.Call is

------------------------------------------------------------------------------
--  Package for calling of ASIS queries
------------------------------------------------------------------------------

   procedure Resolve_Ambiguous (sw : in out Switch_Index; PS : Parameter_Set);
   --  Local subprogram:
   --  Attempts to find a current name/profile in the ambiguous queries list
   --  (also see asistant.ambiguous_mapping)

   function Identify_Function (N : Node_Position)
     return Function_Type is
   begin
      return Function_Type'Wide_Value ("FT_" & CurStat.Tree (N).SValue.all);
   exception
      when Constraint_Error => return FT_CALL;
   end Identify_Function;

   procedure Resolve_Ambiguous
     (sw :  in out Switch_Index;
      PS : Parameter_Set)
   is
      Amb : Amb_Index;
      Match : Boolean;
   begin
      Amb := Amb_Index'Value (Switch_Index'Image (sw));
      for i in 1 .. AI_LENGTH loop
         exit when Amb_Info (Amb, i).New_Index = Invalid_Index;
         Match := True;
         for j in Parameter_Range loop
            if Amb_Info (Amb, i).Synt (j) /= PS (j).RType then
               Match := False;
               exit;
            end if;
         end loop;
         if Match then
            sw := Amb_Info (Amb, i).New_Index;
            return;
         end if;
      end loop;
      Error (ERR_UNKNOWNSYNTAX, Switch_Index'Wide_Image (sw));
   exception
      when Constraint_Error => null;
      --  it just means no overloading for a given query
   end Resolve_Ambiguous;

   function Call_ASIStant_Function
     (N  : Wide_String;
      PS : Parameter_Set)
      return Query_Result
   is
      sw :    Switch_Index;
      Match : Boolean;
      Local : Boolean := True;
      Key :   Natural;
      Name : Wide_String (N'Range) := N;
   begin
      ASIStant.String_Handling.To_Upper (Name);

      begin
         if Name = "AND" then
            return (Par_Boolean, PS (1).B and PS (2).B);
         elsif Name = "OR" then
            return (Par_Boolean, PS (1).B or PS (2).B);
         elsif Name = "NOT" then
            return (Par_Boolean, not PS (1).B);
         elsif Name = "LENGTH" then
            return (Par_Integer, Length (PS (1)));
         else
            Local := False;
            sw := Switch_Index'Wide_Value (Name);
         end if;
      exception
         when Constraint_Error =>
            if Local then
               Error (ERR_BADPARAM, "for query " & Name);
            else
               Error (ERR_UNKNOWNQUERY, Name);
            end if;
      end;

      ATIPut_Line ("Calling query " & Name, 0);

      Resolve_Ambiguous (sw, PS);

      --  Determine key and check syntax
      for i in Switch_Info'Range loop

         if sw in Switch_Info (i).From .. Switch_Info (i).To then
            Key := Switch_Info (i).SelectID;
            Match := True;

            for j in Parameter_Range loop

               if Switch_Info (i).Synt (j) /= PS (j).RType then

                  Match := False;
                  exit;
               end if;

            end loop;

            if not Match then
               Error (ERR_UNKNOWNSYNTAX, Name);
            end if;
            exit;
         end if;

      end loop;

      case Key is

         when  10 => -- CtxRetBool
            return (Par_Boolean,
                    FCtxRetBool (sw) (ATIContext (PS (1).I))
                   );

         when  20 => -- CtxRetCUnitList
            return
              (Par_CUnitList,
               Save_CUnitList (FCtxRetCUnitList (sw) (ATIContext (PS (1).I))));

         when  30 => -- CtxRetElemList
            return
              (Par_ElemList,
               Save_ElemList (FCtxRetElemList (sw) (ATIContext (PS (1).I))));

         when  40 => -- CtxRetNull
            FCtxRetNull (sw) (ATIContext (PS (1).I));
            return (RType => Par_Absent);

         when  50 => -- CtxRetString
            return (Par_String,
                    Save_String (FCtxRetString (sw) (ATIContext (PS (1).I))));

         when  60 => --  CtxStringStringRetNull
            FCtxStringStringRetNull (sw)
             (ATIContext (PS (1).I), PS (2).S.all, PS (3).S.all);

            return (RType => Par_Absent);

         when  70 => --  CUnitBoolRetElemList
            return (Par_ElemList,
                    Save_ElemList (FCUnitBoolRetElemList (sw)
                      (PS (1).C, PS (2).B)));

         when  80 => --  CUnitCtxRetCUnit
            return (Par_CUnit,
                    FCUnitCtxRetCUnit (sw) (PS (1).C, ATIContext (PS (2).I)));

         when  90 => --  CUnitCtxRetCUnitList
            return (Par_CUnitList,
                    Save_CUnitList (FCUnitCtxRetCUnitList (sw)
                      (PS (1).C, ATIContext (PS (2).I))));

         when  93 => --  CUnitCUnitRetBool
            return (Par_Boolean,
                    FCUnitCUnitRetBool (sw) (PS (1).C, PS (2).C));

         when  95 => --  CUnitIntIntRetElem
            return (Par_Element,
                    FCUnitIntIntRetElem (sw) (PS (1).C, PS (2).I, PS (3).I));

         when  97 => --  CUnitListCtxRetRelship
            return (Par_Relationship,
                    Save_Relship (FCUnitListCtxRetRelship (sw)
                      (PS (1).CL.all, ATIContext (PS (2).I))));
         when  98 => --  CUnitListCUnitListCtxStringRetRelship
            return (Par_Relationship,
                    Save_Relship (FCUnitListCUnitListCtxStringRetRelship (sw)
                      (PS (1).CL.all, PS (2).CL.all, ATIContext (PS (3).I),
                       PS (4).S.all)));
         when 100 => -- CUnitListRetBool
            return (Par_Boolean,
                    FCUnitListRetBool (sw) (PS (1).CL.all));

--         when 105 => -- CUnitListRetInt
--            return (Par_Integer,
--                    FCUnitListRetInt (sw) (PS (1).CL.all));

         when 110 => -- CUnitRetBool
            return (Par_Boolean,
                    FCUnitRetBool (sw) (PS (1).C));

         when 130 => -- CUnitRetCUnit
            return (Par_CUnit,
                    FCUnitRetCUnit (sw) (PS (1).C));

         when 140 => -- CUnitRetCUnitList
            return (Par_CUnitList,
                    Save_CUnitList (FCUnitRetCUnitList (sw) (PS (1).C)));

         when 150 => -- CUnitRetElem
            return (Par_Element,
                    FCUnitRetElem (sw) (PS (1).C));

         when 160 => -- CUnitRetElemList
            return (Par_ElemList,
                    Save_ElemList (FCUnitRetElemList (sw) (PS (1).C)));

         when 180 => -- CUnitRetString
            return (Par_String,
                    Save_String (FCUnitRetString (sw) (PS (1).C)));

         when 200 => -- CUnitStringRetBool
            return (Par_Boolean,
                    FCUnitStringRetBool (sw) (PS (1).C, PS (2).S.all)
                  );

         when 210 => -- CUnitStringRetString
            return (Par_String,
                    Save_String (FCUnitStringRetString (sw)
                      (PS (1).C, PS (2).S.all)));

         when 212 => --  DDA_ArrCRetDDA_ArrC
            return (Par_DDA_Array_Component,
                    FDDA_ArrCRetDDA_ArrC (sw) (PS (1).AC));
         when 214 => --  DDA_ArrCRetDDA_RecCList
            return (Par_DDA_Record_Component_List,
                    Save_DDA_RecCList
                      (FDDA_ArrCRetDDA_RecCList (sw) (PS (1).AC)));
         when 216 => --  DDA_ArrCRetElem
            return (Par_Element,
                    FDDA_ArrCRetElem (sw) (PS (1).AC));
         when 217 => --  DDA_RecCRetDDA_ArrC
            return (Par_DDA_Array_Component,
                    FDDA_RecCRetDDA_ArrC (sw) (PS (1).RC));
         when 218 => --  DDA_RecCRetDDA_RecCList
            return (Par_DDA_Record_Component_List,
                    Save_DDA_RecCList
                      (FDDA_RecCRetDDA_RecCList (sw) (PS (1).RC)));
         when 219 => --  DDA_RecCRetElem
            return (Par_Element,
                    FDDA_RecCRetElem (sw) (PS (1).RC));
         when 220 => -- ElemBoolRetElemList
            return (Par_ElemList,
                    Save_ElemList (FElemBoolRetElemList (sw)
                       (PS (1).E, PS (2).B)));

         when 230 => -- ElemCtxRetElem
            return (Par_Element,
                    FElemCtxRetElem (sw) (PS (1).E, ATIContext (PS (2).I)));

         when 240 => -- ElemElemBoolRetBool
            return (Par_Boolean,
                    FElemElemBoolRetBool (sw) (PS (1).E, PS (2).E, PS (3).B));

         when 250 => -- ElemElemBoolRetElemList
            return (Par_ElemList,
                    Save_ElemList (FElemElemBoolRetElemList (sw)
                      (PS (1).E, PS (2).E, PS (3).B)));

         when 255 => -- ElemElemRetBool
            return (Par_Boolean,
                    FElemElemRetBool (sw) (PS (1).E, PS (2).E));

         when 260 => -- ElemElemRetElem
            return (Par_Element,
                    FElemElemRetElem (sw) (PS (1).E, PS (2).E));

         when 265 => -- ElemIntIntRetLineList
            return (Par_Line_List,
                    Save_LineList (FElemIntIntRetLineList (sw)
                      (PS (1).E, PS (2).I, PS (3).I)));

         when 270 => -- ElemListRetBool
            return (Par_Boolean,
                    FElemListRetBool (sw) (PS (1).EL.all));

--         when 275 => -- ElemListRetInt
--            return (Par_Integer,
--                    FElemListRetInt (sw) (PS (1).EL.all));

         when 280 => -- ElemRetBool
            return (Par_Boolean,
                    FElemRetBool (sw) (PS (1).E));

         when 290 => -- ElemRetCUnit
            return (Par_CUnit,
                    FElemRetCUnit (sw) (PS (1).E));

         when 293 => -- ElemRetDDA_ArrC
            return (Par_DDA_Array_Component,
                    FElemRetDDA_ArrC (sw) (PS (1).E));

         when 295 => -- ElemRetDDA_RecCList
            return (Par_DDA_Record_Component_List,
                    Save_DDA_RecCList (FElemRetDDA_RecCList (sw) (PS (1).E)));

         when 300 => -- ElemRetElem
            return (Par_Element,
                    FElemRetElem (sw) (PS (1).E));

         when 310 => -- ElemRetElemList
            return (Par_ElemList,
                    Save_ElemList (FElemRetElemList (sw) (PS (1).E)));

         when 320 => -- ElemRetInt
            return (Par_Integer,
                    FElemRetInt (sw) (PS (1).E));

         when 325 => -- ElemRetLineList
            return (Par_Line_List,
                    Save_LineList (FElemRetLineList (sw) (PS (1).E)));

         when 330 => -- ElemRetSpan
            return (Par_Span,
                    FElemRetSpan (sw) (PS (1).E));

         when 340 => -- ElemRetString
            return (Par_String,
                    Save_String (Wide_String (FElemRetString (sw)
                      (PS (1).E))));

         when 343 => -- IntIntRetBool
            return (Par_Boolean,
                    FIntIntRetBool (sw) (PS (1).I, PS (2).I));

         when 346 => -- IntIntRetInt
            return (Par_Integer,
                    FIntIntRetInt (sw) (PS (1).I, PS (2).I));

         when 347 => --  LineRetString
            return (Par_String,
                    Save_String (FLineRetString (sw) (PS (1).L)));

         when 348 => --  RelshipRetCUnitList
            return (Par_CUnitList,
                    Save_CUnitList (
                      FRelshipRetCUnitList (sw) (PS (1).R.all)));

         when 350 => -- RetBool
            return (Par_Boolean,
                    FRetBool (sw).all);

         when 360 => -- RetCUnit
            return (Par_CUnit,
                    FRetCUnit (sw).all);

         when 370 => -- RetCUnitList
            return (Par_CUnitList,
                    Save_CUnitList (Compilation_Unit_List
                      (FRetCUnitList (sw).all)));

         when 380 => -- RetElem
            return (Par_Element,
                    FRetElem (sw).all);

         when 390 => -- RetElemList
            return (Par_ElemList,
                    Save_ElemList (Element_List (FRetElemList (sw).all)));

         when 405 => -- RetRelship
            return (Par_Relationship,
                    Save_Relship (Relationship (FRetRelship (sw).all)));

         when 420 => -- RetString
            return (Par_String,
                    Save_String (Wide_String (FRetString (sw).all)));

         when 430 => -- SpanRetBool
            return (Par_Boolean,
                    FSpanRetBool (sw) (PS (1).Sp));

         when 435 => -- SpanRetInt
            return (Par_Integer,
                    FSpanRetInt (sw) (PS (1).Sp));

         when 440 => -- StringCtxRetCUnit
            return (Par_CUnit,
                    FStringCtxRetCUnit (sw)
                      (PS (1).S.all, ATIContext (PS (2).I)));

         when 450 => -- StringRetNull
            FStringRetNull (sw) (PS (1).S.all);
            return (RType => Par_Absent);

         when 460 => -- StringStringRetBool
            return (Par_Boolean,
                    FStringStringRetBool (sw) (PS (1).S.all, PS (2).S.all));

         when 470 => -- StringStringRetString
            return (Par_String,
                    Save_String (FStringStringRetString (sw)
                      (PS (1).S.all, PS (2).S.all)));

         when others => Error (ERR_NOTSUPPORTED, Switch_Index'Wide_Image (sw));

      end case;

   exception
      when ASIStant_ERROR =>
         raise ASIStant_ERROR;
      when ASIS_Inappropriate_Context          |
           ASIS_Inappropriate_Container        |
           ASIS_Inappropriate_Compilation_Unit |
           ASIS_Inappropriate_Element          |
           ASIS_Inappropriate_Line             |
           ASIS_Inappropriate_Line_Number      |
           ASIS_Failed                         =>

         ATIPut_Line ("Exception is raised by ASIS query "
                                  & Name & ".", 5);
         ATIPut_Line ("Status : " &
           Asis.Errors.Error_Kinds'Wide_Image (Asis.Implementation.Status), 5);
         ATIPut_Line ("Diagnosis : ", 5);
         ATIPut_Line (Asis.Implementation.Diagnosis, 5);
         raise ASIStant_ASIS_ERROR;
   end Call_ASIStant_Function;

   function Save_CUnitList (C : Asis.Compilation_Unit_List)
      return CUnitList_Ptr
   is
   begin
      return new Asis.Compilation_Unit_List'(C);
   end Save_CUnitList;

   function Save_ElemList  (E : Asis.Element_List) return ElemList_Ptr is
   begin
      return new Asis.Element_List'(E);
   end Save_ElemList;

   function Save_LineList  (L : Asis.Text.Line_List) return LineList_Ptr is
   begin
      return new Asis.Text.Line_List'(L);
   end Save_LineList;

   function Save_DDA_ArrCList  (A : DDA.Array_Component_List)
      return DDA_ArrCList_Ptr is
   begin
      return new DDA.Array_Component_List'(A);
   end Save_DDA_ArrCList;

   function Save_DDA_RecCList  (R : DDA.Record_Component_List)
      return DDA_RecCList_Ptr is
   begin
      return new DDA.Record_Component_List'(R);
   end Save_DDA_RecCList;

   function Save_String (S : Wide_String) return String_Ptr is
   begin
      return new Wide_String'(S);
   end Save_String;

   function Save_Relship (R : Asis.Compilation_Units.Relations.Relationship)
      return Relship_Ptr is
   begin
      return new Asis.Compilation_Units.Relations.Relationship'(R);
   end Save_Relship;

end ASIStant.Call;
