------------------------------------------------------------------------------
--                                                                          --
--                           ASIStint COMPONENTS                            --
--                                                                          --
--                        A S I S T I N T . C A L L                         --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--            Copyright (c) 1997, Free Software Foundation, Inc.            --
--                                                                          --
-- ASIStint 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.  ASIStint  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 ASIStint; see file COPYING. --
-- If not, write to the  Free  Software  Foundation,  59 Temple Place Suite --
-- 330, Boston, MA 02111-1307, USA.                                         --
--                                                                          --
-- ASIStint  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.                                                            --
--                                                                          --
-- This work was supported by a  grant  from  the  Swiss  National  Science --
-- Foundation, no 7SUPJ048247, funding a project entitled  "Development  of --
-- ASIS for GNAT with industry quality".                                    --
------------------------------------------------------------------------------

with ASIS;
 use ASIS;

with Asis.Errors;
with Asis.Implementation;

with ASIStint.Common;       use ASIStint.Common;
with ASIStint.S_Parser;     use ASIStint.S_Parser;
with ASIStint.Print;        use ASIStint.Print;
with ASIStint.XTable;       use ASIStint.XTable;
with ASIStint.Text_IO;      use ASIStint.Text_IO;
with ASIStint.Ambiguous_Mapping; use ASIStint.Ambiguous_Mapping;
with 
ASIStint.String_Handling;

with DeAlloc; use DeAlloc;

with funcarr; use funcarr;
with funcenum; use funcenum;

package body ASIStint.Call is

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

  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 1..3 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;
    -- no overloading
  end Resolve_Ambiguous;


  function Call_ASIStint_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
    ASIStint.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);
      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 1..3 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 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 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 260=> -- ElemElemRetElem
        return (Par_Element,
                FElemElemRetElem(sw) (PS(1).E, PS(2).E)
               );

      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 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 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 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 420=> -- RetString
        return (Par_String,
                Save_String( Wide_String( FRetString(sw).All ) )
               );

      when 430=> -- SpanRetBool
        return (Par_Boolean,
                FSpanRetBool(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 ASISTINT_ERROR =>
        raise ASISTINT_ERROR;
      when ASISTINT_LIGHT_ERROR =>
        raise ASISTINT_LIGHT_ERROR;
      when others=>
        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 ASISTINT_ASIS_ERROR;
  end Call_ASIStint_Function;


  function Save_CUnitList (C: Asis.Compilation_Unit_List)
      return CUnitList_Ptr is
    CP: CUnitList_Ptr := new Asis.Compilation_Unit_List(C'Range);

  begin
    for i in C'Range
     loop
       CP.All(i):= C(i);
    end loop;
    return CP;
  end Save_CUnitList;


  function Save_ElemList  (E: Asis.Element_List) return ElemList_Ptr is
    EP: ElemList_Ptr := new Asis.Element_List(E'Range);

  begin
    for i in E'Range
     loop
       EP.All(i):= E(i);
    end loop;
    return EP;
  end Save_ElemList;


  function Save_String (S: Wide_String) return String_Ptr is
    SP: String_Ptr := new Wide_String(S'Range);

  begin
    for i in S'Range
     loop
       SP.All(i):= S(i);
    end loop;
    return SP;
  end Save_String;

end ASIStint.Call;