------------------------------------------------------------------------------
--                                                                          --
--                           ASIStint COMPONENTS                            --
--                                                                          --
--                    A S I S T I N T . S _ P A R S E R                     --
--                                                                          --
--                                 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 Ada.Strings.Wide_Fixed; use Ada.Strings.Wide_Fixed;
with ASIStint.Common;  use ASIStint.Common;
with DeAlloc; use DeAlloc;

--DBP with ASIStint.Text_IO; use ASItint.Text_IO;

package body ASIStint.S_Parser is

------------------------------------------------------------------------------
-- This package provides parsing for the ASIStint 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;


  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;
            P:= Cur_Token(TS)'Length-2;
            CurStat.Tree(Cur).SValue := new Wide_String(1..P);
            Move( Cur_Token(TS)(TS.Cur_Token_Start+1 .. TS.Cur_Token_End-1),
                  CurStat.Tree(Cur).SValue.All);
            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

    --DBP ATIPut_Line(TS.Text.All, 0);

    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;

    Get_Func(TS); -- Upper level may only contain functions
    --PTI if  not Is_Active(TS)
    --PTI    or else TS.Text(TS.Cur_Token_Start) /= ';' then
    --PTI  Error(ERR_NEEDCHAR, ";");
    --PTI end if;

  end Get_Stmt;

end ASIStint.S_Parser;