------------------------------------------------------------------------------
--                                                                          --
--             ASIS Tester And iNTerpreter (ASIStant) COMPONENTS            --
--                                                                          --
--                    A S I S T A N T . S _ P A R S E R                     --
--                                                                          --
--                                 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 Ada.Strings.Wide_Fixed; use Ada.Strings.Wide_Fixed;

with ASIStant.DeAlloc;       use ASIStant.DeAlloc;

package body ASIStant.S_Parser is

------------------------------------------------------------------------------
--  This package provides parsing for the ASIStant language
------------------------------------------------------------------------------

   procedure Reset_Tree is
      NType : Node_Type;
   begin
      for i in 1 .. CurStat.Free - 1 loop
         NType := CurStat.Tree (i).NType;
         if NType = NT_FUNCTION or NType = NT_VARIABLE or
            NType = NT_STRING or NType = NT_INTEGER
         then
            Free (CurStat.Tree (i).SValue);
         end if;
      end loop;
      CurStat.Free := 1;
   end Reset_Tree;

   procedure Get_Func (TS : in out Token_Stream) is
      Cur : Node_Position;
      P   : Natural;
   begin

      --  Get function name
      if not Is_ID (TS) then
         Error (ERR_BADID, Cur_Token (TS));
      end if;
      Cur := CurStat.Free;
      CurStat.Tree (Cur).NType  := NT_FUNCTION;
      P := Cur_Token (TS)'Length;
      CurStat.Tree (Cur).SValue := new Wide_String (1 .. P);
      Move (Cur_Token (TS), CurStat.Tree (Cur).SValue.all);
      CurStat.Tree (Cur).NValue := 0;
      CurStat.Free := CurStat.Free + 1;
      Next_Token (TS);

      --  Check existence of parameters
      if not Is_Active (TS) or else TS.Text (TS.Cur_Token_Start) /= '(' then
         return;
      end if;

      --  Skip '('
      Next_Token (TS);
      CurStat.Tree (Cur).NValue := CurStat.Free;

      --  Get parameters
      loop

         --  Current parameter
         if not Is_Active (TS) or else TS.Text (TS.Cur_Token_Start) = ')' then
            Error (ERR_NEEDPARAM);
         end if;
         Cur := CurStat.Free;
         CurStat.Free := CurStat.Free + 1;
         CurStat.Tree (Cur).NType  := NT_PARAMLIST;
         CurStat.Tree (Cur).NValue := CurStat.Free;

         Get_Expr (TS);

         --  Skip parameter separator
         if Is_Active (TS) and then TS.Text (TS.Cur_Token_Start) = ')' then
            CurStat.Tree (Cur).Next_Node := 0;
            Next_Token (TS); --  Skip ')'
            exit;
         else
            CurStat.Tree (Cur).Next_Node := CurStat.Free;
         end if;

         if not Is_Active (TS) or else TS.Text (TS.Cur_Token_Start) /= ',' then
            Error (ERR_BADPARAMLIST);
         end if;
         Next_Token (TS); --  Skip ','
      end loop;

   end Get_Func;

   procedure Get_Expr (TS : in out Token_Stream) is
      Cur : Node_Position;
      P   : Natural;
   begin

      if not Is_Active (TS) then
         Error (ERR_BADEXPR);
      end if;

      --  Determine expression type
      if Is_ID (TS) then
         Next_Token (TS);
         if Is_Active (TS) and then TS.Text (TS.Cur_Token_Start) = '(' then
            --  Function call with parameters
            Prev_Token (TS);
            Get_Func (TS);
         else
            --  Function call without parameters or variable
            Prev_Token (TS);
            Cur := CurStat.Free;
            begin
               --  Possibly boolean
               CurStat.Tree (Cur).IValue :=
                 Boolean'Pos (Boolean'Wide_Value (Cur_Token (TS)));

               CurStat.Tree (Cur).NType  := NT_BOOLEAN;
               CurStat.Tree (Cur).NValue := 0;
               CurStat.Tree (Cur).Next_Node := 0;
               CurStat.Free := CurStat.Free + 1;
               Next_Token (TS);
            exception
               when Constraint_Error =>
                  --  Value is not boolean
                  CurStat.Tree (Cur).NType  := NT_VARIABLE;
                  P := Cur_Token (TS)'Length;
                  CurStat.Tree (Cur).SValue := new Wide_String (1 .. P);
                  Move (Cur_Token (TS), CurStat.Tree (Cur).SValue.all);
                  CurStat.Tree (Cur).NValue := 0;
                  CurStat.Free := CurStat.Free + 1;
                  Next_Token (TS);
            end;
         end if;
      else
         if Cur_Token (TS) (TS.Cur_Token_Start) = '"' then
            --  String
            Cur := CurStat.Free;
            CurStat.Tree (Cur).NType  := NT_STRING;

            declare
               S : Wide_String (1 .. Cur_Token (TS)'Length - 2);
               C : Natural := 0;
               I : Natural := TS.Cur_Token_Start + 1;
            begin
               loop
                  exit when I > TS.Cur_Token_End - 1;
                  C := C + 1;
                  S (C) := Cur_Token (TS) (I);
                  if Cur_Token (TS) (I) = '"' then  --  Skip double quote
                     I := I + 1;
                  end if;
                  I := I + 1;
               end loop;
               CurStat.Tree (Cur).SValue := new Wide_String (1 .. C);
               CurStat.Tree (Cur).SValue.all := S (1 .. C);
            end;

            CurStat.Tree (Cur).NValue := 0;
            CurStat.Free := CurStat.Free + 1;
            Next_Token (TS);
         else
            if Cur_Token (TS) (TS.Cur_Token_Start) in '0' .. '9' or
               Cur_Token (TS) (TS.Cur_Token_Start) = '-'
            then
               --  Possibly integer
               Cur := CurStat.Free;
               CurStat.Tree (Cur).NType  := NT_INTEGER;
               P := Cur_Token (TS)'Length;
               CurStat.Tree (Cur).SValue := new Wide_String (1 .. P);

               Move (Cur_Token (TS), CurStat.Tree (Cur).SValue.all);

               CurStat.Tree (Cur).NValue := 0;
               CurStat.Free := CurStat.Free + 1;
               Next_Token (TS);
            else
               --  Unknown or empty expression
               Error (ERR_BADEXPR);
            end if;
         end if;
      end if;
   end Get_Expr;

   procedure Get_Stmt (TS : in out Token_Stream) is
   begin

      if TS.Cur_Token_Start = 1 and TS.Cur_Token_End = 0 then
         --  Initialize token stream
         Next_Token (TS);
      end if;

      if not Is_Active (TS) then
         return;
      end if;

      --  Upper level may only contain functions
      Get_Func (TS);

      --  The statement may or may not end with semicolon
      if Is_Active (TS) and then
         Cur_Token (TS) (TS.Cur_Token_Start) = ';' then
         Next_Token (TS);
      end if;

   end Get_Stmt;

end ASIStant.S_Parser;
