with Ada.Text_IO;  use Ada.Text_IO;
with Ada.Exceptions; use Ada.Exceptions;
--with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Ada.Characters.Handling; use Ada.Characters.Handling;
separate (UMC_box)
package body UML_Parser is
------------------   SPEC -----------------
--  procedure Parse (Uml_File_Name: String);
--  --
--  Max_Line_Length: Positive := 10000;
--  Max_Empty_lines: Natural := 500;
--  Max_Comment_lines: Natural := 500;
--  Max_Components: Positive := 500;
--  Max_Synchronizations: Positive := 10000;
------------------------------------------------
use UML_Types;
--
--
--
--    TOKENS MANAGEMENT AND GENERIC PARSING ROUTINES
--
  HT: Character := Character'Val(9); -- Horizontal Tab
  CR: Character := Character'Val(13); -- Horizontal Tab
  LF: Character := Character'Val(10); -- Horizontal Tab
  type Token_Kind is (Num, Id, Str, Special);  --  special num id   12a

  type Token is record
     Item: String_Ref;
     Line: Natural;
     Line_Ref: String_Ref;
     Column: Natural;
     Kind: Token_Kind;
     PrecedingBlockComment: String_Table_Ref;
  end record;
  LastBlock: String_Table_Ref  := Empty_String_Table_Ref;

  type Comment_Element is record
     Item: String_Ref;
     Line: Natural;
     Column: Natural;
     AfterToken: Natural;
  end record;

  type Tokens_Table is  array (natural range <>) of Token;
  type Tokens_Table_Ref is access Tokens_Table;

  type Comments_Table is  array (natural range <>) of Comment_Element;
  type Comments_Table_Ref is access Comments_Table;

--------------------------------------------------------------------
  F: File_Type;
  Fincluded: File_Type;
  Main_File_Name: String_Ref;
  Included_File_Name: String_Ref;
  Current_File_Name: String_Ref;
  Parsing_Failed: Boolean;
  Parsing_Errors: Natural;
--------------------------------------------------------------------
--  data to be saved / restore in case of multiple file parsing
  Tokens: Tokens_Table_Ref := new Tokens_Table(1..0);  -- dynamically extended by Read_Tokens
  Current_Token: Natural :=0;
  Current_Position: Positive;
  Line_Number: Natural :=0;
  Last_Line: String_Ref;
  Input_line: String(1..Max_Line_Length);
  Previous: Character := '^';
  Line_Length: Natural := 0;
  --------------
  All_Comments: Comments_Table_Ref := new Comments_Table(1..0);
  All_Comments_Buffer: Comments_Table(1..1000);
  All_Comments_Count: Natural :=0;
-- repository for Main data saved while parsing included files
--  data to be saved / restore in case of multiple file parsing
  MainTokens: Tokens_Table_Ref;
  MainCurrent_Token: Natural :=0;
  MainCurrent_Position: Positive;
  MainLine_Number: Natural :=0;
  MainLast_Line: String_Ref;
  MainInput_line: String(1..Max_Line_Length);
  MainPrevious: Character := '^';
  MainLine_Length: Natural := 0;
--  MainAll_Comments: Comments_Table_Ref := new Comments_Table(1..0);
--  MainAll_Comments_Buffer: Comments_Table(1..1000);
--  MainAll_Comments_Count: Natural :=0;
--------------------------------------------------------------------
  --  more implementation vars
  Max_Token_Size : Natural := 200;
--------------------------------------------------------------------

  pragma SHARED (Current_Token);
  pragma VOLATILE (Current_Token);

  procedure Read_Tokens(F:File_Type);
  procedure Give_Error (Msg : in String);
  procedure Skip_Token (Item: String := "");


  function CleanControls (From: String) return String is
    res: String := From;
    Count: Natural :=0;
  begin
    for I in From'Range loop
      if not Is_Control(From(I))then
         Count := Count+1;
         res(Count) := From(I);
      end if;
    end loop;
    return res(1..Count);
  end CleanControls;

  function Current_Item return String is
  begin
    return Tokens(Current_Token).Item.all;
  end Current_Item;

  function Next_Item return String is
  begin
    if Current_Token + 1 > Tokens.all'Length then
     return "";
    else
     return Tokens(Current_Token+1).Item.all;
    end if;
  end Next_Item;

  function Next_Next_Item return String is
  begin
    if Current_Token+2 > Tokens.all'Length then
     return "";
    else
     return Tokens(Current_Token+2).Item.all;
    end if;
  end Next_Next_Item;

---------------------------------------------------------------------------
--  IMPLEMENTATION OF TOKENS MANAGENT AND GENERIC PARSING

  procedure Skip_Token (Item: String := "") is
    begin
    if Current_Token = 0 then
      Give_Error ("138 File Empty ??? ");
      raise Parsing_Error;
    elsif Current_Token = Tokens.all'Length then
        Give_Error ("141 Unexpected End of File");
        raise Parsing_Error;
    elsif Item'Length = 0 then
      Current_Token := Current_Token+1;
    elsif Tokens(Current_Token).Item.all = Item then
        Current_Token := Current_Token+1;
    else
      Give_Error ("148 Failure while looking for token " &  Item);
      raise Parsing_Error;
    end if;
  end Skip_Token;

  procedure Give_Error (Msg : in String) is
    Where:Token;
  begin
    Parsing_Errors := Parsing_Errors+1;
    Parsing_Failed := True;
    if Current_Token in Tokens.all'Range then
      Where := Tokens(Current_Token);
    end if;
    New_Line(Current_Error);
    Put_Line (Current_Error,
               Current_File_Name.all & ": " &
               "### Error found at line " & Natural'Image(Where.Line) &
               ", column " & Natural'Image(Where.Column) & " ###" );
    if Where.Line_Ref /= null then
      Put_Line(Current_Error, "> " & Where.Line_Ref.all);
      Put(Current_Error, "  ");
      for I in 1..Where.Column-1 loop
        Put(Current_Error, " ");
      end loop;
      Put_line(Current_Error, "^");
    end if;
    Put_line(Current_Error, Msg);
  end Give_Error;

  --------------------------------------------------------
  -- deletes the comment part from the current line
  --  if the current line contains "--" or "//" the remainaing part is removed.
  --  ( c-like     var--  operator causes error)
  --------------------------------------------------------
  procedure Remove_Comments is
    Inside_String_Literal: Boolean := False;
    Thecomment: Comment_Element;
  begin
    if Line_Length >=2 and then
      (Input_Line(1..2) = "--" or Input_Line(1..2) = "//") then
      Thecomment.Item := new String'(Input_Line(1..Line_Length));
      Thecomment.Line :=  Line_Number;
      Thecomment.Column := 1;
      Thecomment.AfterToken := Current_Token;
      All_Comments_Count := All_Comments_Count+1;
      All_Comments_Buffer(All_Comments_Count) := Thecomment;
      if All_Comments_Count= All_Comments_Buffer'Last then
         All_Comments := new Comments_Table'(All_Comments.all & All_Comments_Buffer);
         All_Comments_Count:=0;
      end if;
      LastBlock := new String_Table'(LastBlock.all & Thecomment.Item);
      Line_Length :=0;
      return;
    end if;
    -- NOTICE!!
    -- COMMENTS NOT STARTING AT THE BEGIN OF LINE ARE IGNORED 
    --
    for I in 1..Line_Length loop
      if Input_Line(I)= '"' then
         Inside_String_Literal := not Inside_String_Literal;
      end if;
      if Input_Line(I) not in '0'..'9' and then
         Input_line(I) not in 'A'..'Z' and then
         Input_line(I) not in 'a'..'z' and then
         not Inside_String_Literal and then
          I+1 < Line_Length  and then
         ((Input_Line(I+1) = '-' and then Input_Line(I+2) = '-') or
          (Input_Line(I+1) = '/' and then Input_Line(I+2) = '/')) then
        --
        Thecomment.Item := new String'(Input_Line(I+1..Line_Length));
        Thecomment.Line :=  Line_Number;
        Thecomment.Column := I+1;
        Thecomment.AfterToken := Current_Token;
        All_Comments_Count := All_Comments_Count+1;
        All_Comments_Buffer(All_Comments_Count) := Thecomment;
        if All_Comments_Count= All_Comments_Buffer'Last then
           All_Comments := new Comments_Table'(All_Comments.all & All_Comments_Buffer);
           All_Comments_Count:=0;
        end if;
        Line_Length := I;
        exit;                     --  comment found: line is truncated here
      end if;
    end loop;
  end Remove_Comments;

  -- skips lf and cr characters and calls Remove_Comments
  procedure Read_New_Line(F: File_Type) is
  begin
    Line_Length :=0;
    if Previous = '^' then
      if not End_of_File(F) then
        Get_Immediate(F,Previous);  -- maybe blank or comment
      else
        return;
      end if;
    end if;
    --
    -- read until first not blank or comment line
    --
    while Line_Length =0 loop
      -- until a non blank line is found, or end-of-file
        -- leggi fino alla fine di tutta la riga, saltando tutti i caratteri do controllo finali.
        -- read chars 2.. up to end of line
        while Previous /= cr and then Previous /= lf loop
           -- continue reading until end-of-line
            Line_Length := Line_Length+1;
            Input_Line(Line_Length) := Previous;
            if not End_of_File(F) then
              Get_Immediate(F,Previous);
            else
              Previous := '^';
              exit;
            end if;
        end loop;
        -- skip lf or lf-cr
        if Previous = lf and not End_of_File(F) then
            Get_Immediate(F,Previous);
            if Previous = cr and not End_of_File(F) then
              Get_Immediate(F,Previous);
              Previous := '^';
            end if;
        -- skip cr-lf
        elsif Previous = cr and not End_of_File(F) then
            Get_Immediate(F,Previous);
            if Previous = lf and not End_of_File(F) then
              Get_Immediate(F,Previous);
              Previous := '^';
            end if;
        end if;
      --
      Line_Number := Line_Number +1;
      if  Line_Length > 0 then
         -- found some characters ...
         -- strip contrls
         --  save original line in Last_Line
         Last_Line := new String'(CleanControls(Input_Line(1..Line_Length)));
         Input_Line(1..Last_Line.all'Length) := Last_Line.all;
         Line_Length := Last_Line.all'Length;
         Current_Position := 1;
         Remove_Comments;    -- maybe Line_Length  returns to 0
         --
        for I in 1..Line_Length loop
          if Character'Pos(Input_Line(I)) > 126 or
             ( Character'Pos(Input_Line(I)) < 32 and
               Character'Pos(Input_Line(I)) /= 9 and  --  ht
               Character'Pos(Input_Line(I)) /= 10 and -- lf
               Character'Pos(Input_Line(I)) /= 13     -- cr
             ) then
            Give_error("287 Error: Non printable character at line" &
                         Integer'Image(Line_Number) & ", column " &
                        Integer'Image(I) & "." );
            raise Parsing_Error;
          end if;
          if I < Line_Length and
              Input_Line(I) ='&' and Input_Line(I+1) ='#' then
               -- this is an HTML encoding of a non printable character
            Give_error("295 Error: Non printable character at  line" &
                        Integer'Image(Line_Number) & ", column " &
                        Integer'Image(I) & "." );
            raise Parsing_Error;
          end if;
        end loop;
        --
      end if;
      if End_of_File(F) and (Previous = '^' or Previous = cr or Previous = lf) then
        Previous := '^';
        exit;
      end if;
    end loop;
  end Read_New_Line;

  -----------------------------------------------------------------
  -- At startup calls Read_New_Line which sets the current input_line.
  -- Continue the reading of the INPUT_LINE until a non-white char is found
  -- If not found, further lin es are read.
  -- the INPUT_LINE has been prepared by one or more Read_New_Line skipping
  -- empty lines or purely comment lines.
  --  when EOF, sets Line_Length to 0
  -- Skips spaces and skip new_lines if needed, up to some nonblank char
  -----------------------------------------------------------------
  procedure Skip_Spaces(F: File_Type) is
  begin
    --
    if Line_Length = 0 and not End_Of_File(F) then
      Read_New_Line(F);
    end if;
    --
    -- cycle reading until a non empty is found
    loop
      -- find first next non space char
      for I in Current_Position .. Line_Length loop
        if Input_line(I) /= ' ' and Input_line(I) /= HT then
          Current_Position := I;
          return;                         -- found not blank char
        end if;
      end loop;
      --  empty line or completely white rest of line
--      if End_Of_File(F) then
      if Previous = '^' then
         Line_Length :=0;
         return;
      else
        Read_New_Line(F);
      end if;
    end loop;
  end Skip_Spaces;

  --------------------------------------------------------------------
  -- extracts the next token from the stream
  -- returns a token with empty string item  when EOF;
  --  Comment lines and comment fragment are skipped by Skip_Spaces
  --  TOKENS are:
  --   numbers      0..9     0..9
  --   ids    a..z  A..Z  0..9 _ '
  --   strings  "any"
  --   specials long:  )->  -(  :=  ++ --  ->  >=  <= ==  !=  && ||  /* */   $* ..
  --   specials short: ( ) , ; = : - [ ] /  $ & * + > < | .  ^ # % ! ?
  --
  --   "*"  is the times operator or the star matching sybol, unless it appears in $*
  --     "/* .. */ " is a comment separator
  --     "// " is a comment separator
  --     "--"  is comment separator only if
  --      a)  appears at the beginnning of the line
  --  or  b)  is preceeded by a white space or non alfanumeric character
  --   N.B.  Tokens are buffered by Read_Tokens
  --------------------------------------------------------------------
  function Get_Token(F:File_Type) return Token is
    This_Token: Token;
    StringBuffer: String(1..Max_Token_Size);
    Item_Size: Natural :=0;
  begin
    -- skip spaces and skip new_lines if needed, up to some nonblank char
    Skip_Spaces(F);
    -- if empty file, Current_Position =1  and
    This_Token.Line :=  Line_Number;
    This_Token.Line_Ref := Last_Line;
    This_Token.Column :=  Current_Position;
    This_Token.PrecedingBlockComment := LastBlock;
    LastBlock := Empty_String_Table_Ref;
    -- if file empty return null final token
    if Line_Length = 0  then
       This_Token.Item := new String'("");
       Current_Token := Current_Token +1;  --  reset to 1 when all tokens are read
       return  This_Token;   --  Item= null;
    end if;
    --
    -- find the token kind
    --
    if Input_line(Current_Position) in '0'..'9' then
      This_Token.Kind := Num;
    elsif Input_line(Current_Position) in 'a'..'z' or else
          Input_line(Current_Position) in 'A'..'Z' or else
          (Input_line(Current_Position) = '$' and then Input_line(Current_Position+1) /= '*')  or else
          Input_line(Current_Position) = '_'  then
      This_Token.Kind := Id;
    elsif Input_line(Current_Position) = '"' then
      This_Token.Kind := Str;
    else
      This_Token.Kind := Special;
    end if;
    --
    -- get the token item
    --
    for I in Current_Position .. Line_Length loop
      case This_Token.Kind is
      when Id =>
        Item_Size := Item_Size +1;
        StringBuffer(Item_Size) := Input_line(Current_Position);
        Current_Position := Current_Position +1;
        -- this is the last char of the item
        if Current_Position > Line_Length or else
           (Input_line(Current_Position) not in 'a'..'z' and then
           Input_line(Current_Position) not in 'A'..'Z' and then
           Input_line(Current_Position) not in '0'..'9' and then
           Input_line(Current_Position) /= '_' ) then
           exit;
        end if;
        -- continue the cycle
      when Num =>
        Item_Size := Item_Size +1;
        StringBuffer(Item_Size) := Input_line(Current_Position);
        Current_Position := Current_Position +1;
        -- this is the last char of the item
        if Current_Position > Line_Length or else
           Input_line(Current_Position) not in '0'..'9' then
           exit;
        end if;
        -- continue the cycle
      when Str =>
          Item_Size := Item_Size +1;
          StringBuffer(Item_Size) := Input_line(Current_Position);
        Current_Position := Current_Position +1;
          -- this is the last char of the item
        if Item_Size > 1 and then Input_line(Current_Position) = '"' then
          exit;
        elsif Current_Position > Line_Length then
          Give_Error ("426 Unterminated String Literal");
          raise Parsing_Error;
        end if;
        -- continue the cycle
        --
      when Special =>
--
--   specials long:  )->  -(  :=  ++ --  ->  >=  <= ==  !=  && || /  /= => .. /* */  $*
--   specials short: ( ) , ; = : - [ ] /  $ & * + > < | .  ^ # % ! ?
--
        Item_Size := Item_Size +1;
        StringBuffer(Item_Size) := Input_line(Current_Position);
        -- this is the last char of the item
        if Current_Position+1 <= Line_Length and then
           Input_Line(Current_Position..Current_Position+1)= ".." then
           Item_Size := Item_Size+1;
           StringBuffer(2) := '.';
           Current_Position := Current_Position +2;
           exit;
        elsif Current_Position+1 <= Line_Length and then
           Input_Line(Current_Position..Current_Position+1)= "$*" then
           Item_Size := Item_Size+1;
           StringBuffer(2) := '*';
           Current_Position := Current_Position +2;
           exit;
        elsif Current_Position+1 <= Line_Length and then
           Input_Line(Current_Position..Current_Position+1)= "/*" then
           Item_Size := Item_Size+1;
           StringBuffer(2) := '*';
           Current_Position := Current_Position +2;
           exit;
        elsif Current_Position+1 <= Line_Length and then
           Input_Line(Current_Position..Current_Position+1)= "*/" then
           Item_Size := Item_Size+1;
           StringBuffer(2) := '/';
           Current_Position := Current_Position +2;
           exit;
        elsif Current_Position+1 <= Line_Length and then
           Input_Line(Current_Position..Current_Position+1)= "=>" then
           Item_Size := Item_Size+1;
           StringBuffer(2) := '>';
           Current_Position := Current_Position +2;
           exit;
        elsif Current_Position+1 <= Line_Length and then
           Input_Line(Current_Position..Current_Position+1)= "->" then
           Item_Size := Item_Size+1;
           StringBuffer(2) := '>';
           Current_Position := Current_Position +2;
           exit;
        elsif Current_Position+1 <= Line_Length and then
           Input_Line(Current_Position..Current_Position+1)= ":=" then
           Item_Size := Item_Size+1;
           StringBuffer(2) := '=';
           Current_Position := Current_Position +2;
           exit;
        elsif Current_Position+1 <= Line_Length and then
           Input_Line(Current_Position..Current_Position+1)= "++" then
           Item_Size := Item_Size+1;
           StringBuffer(2) := '+';
           Current_Position := Current_Position +2;
           exit;
        elsif Current_Position+1 <= Line_Length and then
           Input_Line(Current_Position..Current_Position+1)= "--" then
           Item_Size := Item_Size+1;
           StringBuffer(2) := '-';
           Current_Position := Current_Position +2;
           exit;
        elsif Current_Position+1 <= Line_Length and then
           Input_Line(Current_Position..Current_Position+1)= "->" then
           Item_Size := Item_Size+1;
           StringBuffer(2) := '>';
           Current_Position := Current_Position +2;
           exit;
        elsif Current_Position+1 <= Line_Length and then
           Input_Line(Current_Position..Current_Position+1)= ">=" then
           Item_Size := Item_Size+1;
           StringBuffer(2) := '=';
           Current_Position := Current_Position +2;
           exit;
        elsif Current_Position+1 <= Line_Length and then
           Input_Line(Current_Position..Current_Position+1)= "<=" then
           Item_Size := Item_Size+1;
           StringBuffer(2) := '=';
           Current_Position := Current_Position +2;
           exit;
        elsif Current_Position+1 <= Line_Length and then
           Input_Line(Current_Position..Current_Position+1)= "==" then
           Item_Size := Item_Size+1;
           StringBuffer(2) := '=';
           Current_Position := Current_Position +2;
           exit;
        elsif Current_Position+1 <= Line_Length and then
           Input_Line(Current_Position..Current_Position+1)= "!=" then
           Item_Size := Item_Size+1;
           StringBuffer(2) := '=';
           Current_Position := Current_Position +2;
           exit;
        elsif Current_Position+1 <= Line_Length and then
           Input_Line(Current_Position..Current_Position+1)= "/=" then
           Item_Size := Item_Size+1;
           StringBuffer(2) := '=';
           Current_Position := Current_Position +2;
           exit;
        elsif Current_Position+1 <= Line_Length and then
           Input_Line(Current_Position..Current_Position+1)= "&&" then
           Item_Size := Item_Size+1;
           StringBuffer(2) := '&';
           Current_Position := Current_Position +2;
           exit;
        elsif Current_Position+1 <= Line_Length and then
           Input_Line(Current_Position..Current_Position+1)= "||" then
           Item_Size := Item_Size+1;
           StringBuffer(2) := '|';
           Current_Position := Current_Position +2;
           exit;
        else   --- special  one char token
               -- do not check for unexpected chars
           Current_Position := Current_Position +1;
           exit;
        end if;
      end case;
    end loop;
    --
    This_Token.Item := new String'(StringBuffer(1..Item_Size));
    if This_Token.Item.all ="False" then This_Token.Item(1):= 'f'; end if;
    if This_Token.Item.all ="True" then This_Token.Item(1):= 't'; end if;
    if This_Token.Item.all = "$*" then
     This_Token.Kind := Id;
    end if;
    -- FlowComments, if any, are added by Skip_Spaces.
    -- reset to one after all tokens are read
    -- needed to remember the placing of comments extracted by Remove_Comments
    Current_Token := Current_Token+1;
    return This_Token;
  end Get_Token;

  -- fills the Tokens tables by calling Get_Token, 
  -- sets Current_Token to 1
  --  block comments within  /* ... */  are ignored !!!
  procedure  Read_Tokens(F:File_Type) is
    --  1000 IS NOT an HARD LIMIT. Just the slot size used to fill Tokens table
    Buffer: Tokens_Table(1..1000);  -- Tokens is a vector of Buffers
    Count: Natural := 0;
    Tmp: Token;
  begin
    Tmp:= Get_Token(F);
    --  block comments within  /* ... */  are ignored !!!
    if Tmp.Item.all="/*" then
      while Tmp.Item.all = "/*" loop
        while Tmp.Item.all /= "*/" and then
             Tmp.Item.all /= "" loop
          Tmp:= Get_Token(F);
        end loop;
        if Tmp.Item.all = "*/" then Tmp:= Get_Token(F); end if;
      end loop;
    end if;
    Count := Count +1;
    Buffer(Count) := Tmp;
    while Tmp.Item.all'Length /= 0  loop
      Tmp:= Get_Token(F);
      if Tmp.Item.all="/*" then
        while Tmp.Item.all = "/*" loop
        while Tmp.Item.all /= "*/" and then
               Tmp.Item.all /= "" loop
           Tmp:= Get_Token(F);
        end loop;
        if Tmp.Item.all = "*/" then Tmp:= Get_Token(F); end if;
        end loop;
      end if;
      Count := Count +1;
      Buffer(Count) := Tmp;
      if Count =1000 then
        Tokens := new Tokens_Table'(Tokens.all & Buffer);
        Count :=0;
      end if;
    end loop;
    Tokens := new Tokens_Table'(Tokens.all & Buffer(1..Count));
    Current_Token := 1;
  end Read_Tokens;



--------------------------------------------------------------------------
--    UML SPECIFIC  PARSIMG ROUTINES
--------------------------------------------------------------------------
-- Parses the uml file indentified by the given name and creates
-- the corresponding uml object in "This_Uml_Object"
--
-- procedure Parse (Tab_File_Name: String);
--
------------------------------------------------------------------------
  -- chart #1 = OUT    chart #2=ERR
------------------------------------------------------------------------

-- Class  MY_STATE_CHART is
--   Signals
--     r2,a2,e1,e2,f1,r1,e(x), a(x), OUT.done, ERR.failure
--   Operations
--     o1, o2:int, o3(x,y):obj
--   Vars
--     x, y:int:=0, z:obj, w
--   Transitions
--   State S0 = S1, s2, s3  Defers:  a,a(x),c
--   State S0.S1 = S4 / S5 Defers:  a,b(x,y),c
--     S1.S5.s8      -(a(x)/y:=x;e1)->  s3
--     s3            -(a2/e1)->  S1.S5.s9
--     S1.S4.S7.s10  -(e2/e2)->  s3
--     S1.S4.s6      -(r1/a1)->  s2
--     S1            -(e1/-)->   s2
--     s2            -(a1/r2)->  S1
--     (s2)          -(a1/r2)->  (S1)
--     (S1.S4.s6,S1.S5.s8) -(-/-)-> (S1.S4.s6,S1.S5.s8)
-- end MY_STATE_CHART;
--
-- Object obj1: class1;
-- Object obj2: class2 (attr=> value, link => obj3);
-- Object  obj3: class3;
--
--  Chartype.event  is a broacast message to all elems of the type ????

subtype Action_Ref is UML_Types.Action_Ref;

  Current_Object: Natural :=0;
  Current_Class: Natural :=0;

  Max_States_Number: Positive := 100000;
  Max_Parallelism: Natural :=0;
--   This_State: State_Ref;

  --
  -- side effect of Parse_Action - used by Parse_Transition_Structure
  Return_or_Caller_Found: Boolean := False;
  -- side effect of Parse_Transition_Structure - used by Parse_Transition_Structure
  Is_Operation_Body: Boolean := False;


  function Parse_Id return String_Ref;
  function Parse_Composite_Name return String_Ref;
  function Parse_Int_Token return String;
  function Parse_Names_List return String_Table_Ref;
  procedure  Parse_Vars;

  function Parse_Actions (TEnv:EventVars_Table_Ref) return Actions_Table_Ref;
  procedure Parse_Class_Body (This_Class_Name: String_Ref;
                         Prev_Comments: String_Table_Ref := Empty_String_Table_Ref);

  function Find_SystemVar(Prefix:String) return Natural;
  function Parse_IntExpr (Env: EventVars_Table) return IntExpr_Ref;
  function Parse_SimpleExpr(Env: EventVars_Table; In_FunctCall: Boolean := False) 
            return SimpleIntExpr_Ref;
  procedure Parse_Transitions;
  function Find_Var(Prefix:String) return Natural;
--  function Find_Var(The_Class:Natural; Prefix:String) return Natural;
  function Find_State (This_State_Name: String) return State_Ref ;
  function Just_Find_State (This_State_Name: String) return State_Ref ;
  function Add_To_Outgoing_Catalogue (This_Transition: Transition_Ref;
    This_Catalogue: TransitionsCatalogue_Ref) return TransitionsCatalogue_Ref;
  function Build_Outgoing_Catalogue (These_Transitions: Transitions_Table)
            return TransitionsCatalogue_Ref;
  procedure Load_Outgoing_Catalogues (This_State: State_Ref);
  procedure Check_Missing_Definitions;
  procedure Set_Ancestors;
  procedure Set_Finals;
  function Check_Class (Class_Name: String) return Integer;

 function IsNested (s1,s2: State)
 return boolean;

--  function Parse_States (From_String: String) return States_Table;

  function Is_Number (Token: String) return Boolean;

--------------------------------------------------------------------
--    UML specific routines
--------------------------------------------------------------------

  function IsNested (s1,s2: State) return boolean is
  begin
    if s1.FullName.all'Length > s2.FullName.all'Length+1 and then
       s1.FullName.all(1..s2.FullName.all'Length) = s2.FullName.all and then
       s1.FullName.all(s2.FullName.all'Length+1) = '.' then
       return True;
    else
       return False;
    end if;
  end IsNested;

  function Prefix (source: String) return String is
  begin
     for I in reverse source'Range loop
       if source(I) = '.' then
         return source(source'First .. I-1);
       end if;
     end loop;
     return "";
  end Prefix;

  function Suffix (source: String) return String is
  begin
     for I in reverse source'Range loop
       if source(I) = '.' then
         declare
           Str: String (1..source'Last-I);
         begin
           Str :=  source(I+1 .. source'Last);
           return Str;
         end;
       end if;
     end loop;
     return source;
  end Suffix;

  ----------------------------------------------------------------------
  --  Called by  Parse_Signals when '(' is found (and skipped) after the eventid
  --  returns  a new EventVars_Table
  --   possibly empty  '(No_EventVars)
  ----------------------------------------------------------------------
  function Parse_EventVars (AddTo: EventVars_Table) return EventVars_Table is
    This_Var: EventVar_Ref := new EventVar;
    This_Kind: String_Ref;
  begin
    if Current_Item  = ")" then
      return AddTo;
    end if;
    --
    This_Var.Name := Parse_Id;
    This_Var.Num_Key := AddTo'Length+1;
    --
    if Current_Item = ":" then
      Skip_Token;
      This_Kind := Parse_Id;
      if This_kind.all = "obj" then
        This_Var.Kind := Object;
        if Current_Item = "[" then
          This_Var.Kind := Objvector;
          Skip_Token ("["); 
          if Current_Item = "[" then
            -- var: obj[[]]; 
            This_Var.Kind := Objmatrix;
            Skip_Token; -- "["
            if Current_Item = "[" then
              This_Var.Kind := Objcube;
              Skip_Token("["); 
              Skip_Token("]");
            end if;
            Skip_Token("]");
          end if;
          Skip_Token ("]"); 
        end if;
      elsif This_kind.all = "bool" then
        This_Var.Kind :=  Bool;
        if Current_Item = "[" then
          This_Var.Kind := Boolvector;
          Skip_Token ("["); 
          if Current_Item = "[" then
            -- var: obj[[]]; 
            This_Var.Kind := Boolmatrix;
            Skip_Token; -- "["
            if Current_Item = "[" then
              This_Var.Kind := Boolcube;
              Skip_Token("["); 
              Skip_Token("]");
            end if;
            Skip_Token("]");
          end if;
          Skip_Token ("]"); 
        end if;
      elsif This_kind.all /= "int"  then --  must be a Class Name
        This_Var.Kind := Object;
        This_Var.Typeinfo := Check_Class(This_kind.all);
        if Current_Item = "[" then
          This_Var.Kind := Boolvector;
          Skip_Token ("["); 
          if Current_Item = "[" then
            -- var: obj[[]]; 
            This_Var.Kind := Boolmatrix;
            Skip_Token; -- "["
            if Current_Item = "[" then
              This_Var.Kind := Boolcube;
              Skip_Token("["); 
              Skip_Token("]");
            end if;
            Skip_Token("]");
          end if;
          Skip_Token ("]"); 
        end if;
      else
        This_Var.Kind := Number;
        if Current_Item = "[" then
          This_Var.Kind := Numvector;
          Skip_Token ("["); 
          if Current_Item = "[" then
            -- var: obj[[]]; 
            This_Var.Kind := Nummatrix;
            Skip_Token; -- "["
            if Current_Item = "[" then
              This_Var.Kind := Numcube;
              Skip_Token("["); 
              Skip_Token("]");
            end if;
            Skip_Token("]");
          end if;
          Skip_Token ("]"); 
        end if;
      end if;
    end if;
    --
    if Current_Item = "," then
      Skip_Token;
      return Parse_EventVars (AddTo & This_Var);
    else
      return (AddTo & This_Var);
    end if;
  end Parse_EventVars;

  -------------------------------------------------------------------
  -- CALLED WHEN ELABORATING A CHART Signals or Operations  DECLARATION
  -- (once for each declared event)
  --  a new event declaration is introduced. (if not already there) in the
  --  global  ALL_EVENTS table.
  --  The same Event is also linked in the local CLASS.CHART_EVENTS table
  --
  --  IN THE CASE OF OPERATIONS, THE PROFILE CONTAING ALSO THE CALLER PARAM
  --  Looks into the global ALL_EVENTS table.
  --  This_Event  can be:  opevent(_caller,arg1,arg2)  or  sigevent(arg1.arg2)
  -------------------------------------------------------------------
  procedure Check_Event (This_Event: Event_Ref) is
    TheseEvents: Events_Table_Ref;
    Declared_Events: Events_Table_Ref;
    This_Size: Natural;
    Tmp_Size: Natural;
--    Renamed_Event: Event_Ref;
  begin
    TheseEvents:=All_Events;
    Declared_Events := All_Classes(Current_Class).ChartEvents;
    --
    --  first, look if a forward definition already exists,
    --    (because a corresponding signal has been elaborated (Kind=Undefined) )
    --
    -- This_Size, Tmp_Size  are the actual parameters count, without considering
    --   the implicit "caller" one.
    This_Size := This_Event.Params.all'Length;
    if This_Event.Kind = Operation then
       This_Size := This_Size -1;  -- the actual params size
    end if;
    --  1 =  "-"
    --  2 =  "lostevent"
    --  3 =  "Run_Time_Error"
    --  4 =  "assign"
    --  5..17 =  OpReturn_Event ... OpReturnBoolC_Event
    --
    for I in OpReturnBoolC_Event.Num_Key+1 .. TheseEvents.all'length loop
      Tmp_Size := TheseEvents(I).Params.all'Length;
      if TheseEvents(I).Kind = Operation then
        Tmp_Size  := Tmp_Size  -1;   -- the actual params size in All_Events(I)
      end if;
      --
      --  if we find a similer event with the same name and the
      --  same number of parameters we RECYCLE that definition
      --  WITHOUT giving an error if there is a mismatch in the type pf the args
      --   or in the type of the result
      --
      if TheseEvents(I).Name.all = This_Event.Name.all and then
            This_Size  = Tmp_Size then
        if TheseEvents(I).Kind /= Undefined and then
            TheseEvents(I).Kind /= This_Event.Kind then
           Give_Error("897 Error: cannod declare a signal and an operation with the same name and args count");
           -- the problem is when we find actions with undeclared event:
           --     XX.foo;     -- maybe intending signal   (introducing undefined uevent foo)
           --     YY.foo;     -- maybe intending operation (fininding undefined event foo)
           --  Signals foo    -- redefining undefined foo as signal (for all cases)
           --  Operations foo -- disallowed or newly introduced but never used
           raise Parsing_Error;
        end if;
        --
        This_Event.Num_Key := I;  -- necessary in the lazy case
        --
        --  if the event was registered as a signal, (while it is a call),
        --   then adjust its kind and params;
        -- WASN'T SIMPLER  TheseEvents(I) := This_Event ?!?!?!?
        if TheseEvents(I).Kind = Undefined then
          TheseEvents(I).Kind := This_Event.Kind;  -- Operation or Signal
          TheseEvents(I).Params := This_Event.Params;
          TheseEvents(I).Return_Type := This_Event.Return_Type;
        end if;
        --
        -- OK the args length is correct, now check the names.
        --  (in case of multiple class defining the same event)
        --
        --  MAybe we should also check that all the event params
        --  names are matching.  I.e. that no two charts declare
        --   Events:  init(arg_a)     and    Events: init(arg_b)
        --
-- REMOVED  21-12-2010 to allow multipler decalration of events overloading arg names
--        for J in TheseEvents(I).Params.all'Range loop
--             if TheseEvents(I).Params(J) /= null and then
--                TheseEvents(I).Params(J).Name /= null and then
--                This_Event.Params(J) /= null and then
--                This_Event.Params(J).Name /= null and then
--                TheseEvents(I).Params(J).Name.all /=
--                    This_Event.Params(J).Name.all then
--                Give_Error ("Error: type mismatch for event " &
--                   This_Event.Name.all);
--                raise Parsing_Error;
--             end if;
--        end loop;
--        if TheseEvents(I).Return_Type /= This_Event.Return_Type then
--           Give_Error ("Error: type mismatch for event " & This_Event.Name.all);
--           raise Parsing_Error;
--        end if;
        --
        -- when an event is found for the first time inside
        --   a signal action, it does not have the event
        --    param names, hence when its declaration is first
        --    encountered, we must fill its definition with the names
        --   NO MORE - ALL_EVENTS CAN HAVE NO PARAM NAMES
        --  PARAM NAMES AND TYPES ARE CLASS DEPENDENT
--        if TheseEvents(I).Params.all'Length >0 and then
--           (TheseEvents(I).Params(1) = null or else
--           TheseEvents(I).Params(1).Name = null) then
--           for J in TheseEvents(I).Params.all'Range loop
--            TheseEvents(I).Params(J).Name := This_Event.Params(J).Name;
--            TheseEvents(I).Params(J).Kind := This_Event.Params(J).Kind;
--           end loop;
--        end if;
        -- make a copy of TheseEvents(I) using the current param names
        --  WHY INSTEAD NOT USE JUST THE ORIGINAL THIS_EVENT??????
--        Renamed_Event := new Event'(TheseEvents(I).all); --  adjusr num_key etc
--        Renamed_Event.Params := new EventVars_Table'(TheseEvents(I).Params.all);
--        for J in This_Event.Params.all'Range loop
--          Renamed_Event.Params(J) := new  EventVar'(TheseEvents(I).Params(J).all);
--          Renamed_Event.Params(J).Name := This_Event.Params(J).Name;
--        end loop;
        All_Classes(Current_Class).ChartEvents :=
--          new Events_Table'(Declared_Events.all & Renamed_Event);
          new Events_Table'(Declared_Events.all & This_Event);
        return;
      end if;
    end loop;
    --
    -- The event is a new event
    --
    This_Event.Num_Key := All_Events.all'Length+1;
    All_Events := new Events_Table'(TheseEvents.all & This_Event);
    All_Classes(Current_Class).ChartEvents :=
        new Events_Table'(Declared_Events.all & This_Event);
    --
  end Check_Event;

  -------------------------------------------------------------------------
  --  called while parsing the trigger of a transition OR a DEFERRED DECL.
  --  Notice that given an event Name, its declaration is UNIQUE
  --  notice that when checking a trigger, the event MUST be declared
  --  LOOKS INTO  THE LOCAL CHARTEVENTS TABLE
  --  WHEN CHECKING THE CORRECT SIZE, we DO NOT COUNT THE IMPLICIT CALLER
  -- The argslist of "this_event" MAY does NOT contain the implicit caller
  ------------------------------------------------------------------------d
  function Find_Event (This_Event: Event_Ref ) return Event_Ref is
--   This_String_Ref: String_Ref;
   TheseEvents: Events_Table_Ref;
   This_Size: Natural;
--   Lazy_Event: Event_Ref;
  begin
    if This_Event.Name.all = "-" then
      return Null_Event;
    end if;
    --
    if This_Event.Params /= null then
      This_Size := This_Event.Params.all'Length;
    else
      This_Size :=0;
    end if;
    TheseEvents := All_Classes(Current_Class).ChartEvents;
    for I in TheseEvents.all'Range loop
       if TheseEvents(I).Kind = Signal and then
          TheseEvents(I).Name.all = This_Event.Name.all and then
          TheseEvents(I).Params.all'Length = This_Size  then
          return TheseEvents(I);
       elsif TheseEvents(I).Kind = Operation and then
          TheseEvents(I).Name.all = This_Event.Name.all and then
          TheseEvents(I).Params.all'Length = This_Size+1  then
          return TheseEvents(I);
       end if;
    end loop;
    --
    if not Lazy_Parsing then
      Give_Error("1017 Error: Found use of undeclared event " & This_Event.Name.all);
      raise Parsing_Error;
    else
      All_Classes(Current_Class).ChartEvents :=
         new Events_Table'(TheseEvents.all & This_Event);
      This_Event.Kind := Signal;
      Check_Event(This_Event);  -- adds into All_Events
      return This_Event;
    end if;
  end Find_Event;

  ----------------------------------------------------------------------
  -- CALLED WHEN PARSING A SIGNAL/CALL OF A TRANSITION ACTION
  --  if the corresponding definition exists, checks its correctness
  --   otherwise introduces a new event placeholder in All_Events.
  --  Looks into the global ALL_EVENTS table.
  --    Obj.foo(x)     matches   opfoo(_caller,x)  and sigfoo(x)
  ----------------------------------------------------------------------
  function Check_Event (This_Event_Name: String;
                            My_Args: umlExpr_Table_Ref) return Event_Ref is
    VK: Value_Kind;
    Tmp: Event_Ref;
  begin
    for I in All_Events.all'Range loop
       if All_Events(I).Name.all = This_Event_Name  then
          if All_Events(I).Kind = Signal or  All_Events(I).Kind = Undefined then
            if All_Events(I).Params.all'Length = My_Args.all'Length then
              if This_Event_Name /= "return" then
                Tmp :=  All_Events(I);
                -- We do not set the Kind to Signal in order to be able to check, at the end,
                -- if all events are declared somewhere, and to distinguish the case of a previous
                -- found signal declaration from the case of a use of yet undeclared event
                exit;
              else
                --  get the Value_Kind VK
                --  FROM the expression KIND
                if My_Args= null or else My_Args(1) = null then
                    VK := Undefined;
                elsif My_Args(1).umlBool /= null then
                    VK := Bool;
                else
                     VK := IntExpr_Kind(My_Args(1).umlInt.all);
                end if;
                --
                if VK = Undefined then
                   return OpReturn_Event;
                elsif VK = Number then
                   return OpReturnInt_Event;
                elsif VK = Object then
                   return OpReturnObj_Event;
                elsif VK = Bool then
                   return OpReturnBool_Event;
                elsif VK = Numvector then
                   return OpReturnIntV_Event;
                elsif VK = Objvector then
                   return OpReturnObjV_Event;
                elsif VK = Boolvector then
                   return OpReturnBoolV_Event;
                elsif VK = Nummatrix then
                   return OpReturnIntM_Event;
                elsif VK = Objmatrix then
                   return OpReturnObjM_Event;
                elsif VK = Boolmatrix then
                   return OpReturnBoolM_Event;
                elsif VK = Numcube then
                   return OpReturnIntC_Event;
                elsif VK = Objcube then
                   return OpReturnObjC_Event;
                elsif VK = Boolcube then
                   return OpReturnBoolC_Event;
                end if;
              end if;
            end if;
          else  ---  All_Events(I).Kind = Call
            if All_Events(I).Params.all'Length = My_Args.all'Length+1 then
              Tmp :=  All_Events(I);
              exit;
            end if;
          end if;
       end if;
    end loop;
    if Tmp = null then
      Tmp := new Event;
      Tmp.Name := new String'(This_Event_Name);
      Tmp.Kind := Undefined;
      Tmp.Num_Key := All_Events.all'Length+1;
      Tmp.Params := new EventVars_Table'(1..My_Args.all'Length => new EventVar);
      All_Events := new Events_Table'(All_Events.all & Tmp);
      --
      for I in 1.. My_Args'Length loop
        Tmp.Params(I).Num_Key := I;
--        if Tmp.Params(I).Kind = Undefined then
--          if My_Args(I).umlInt = null then
--            Tmp.Params(I).Kind := Bool;
--          else
--            Tmp.Params(I).Kind := IntExpr_Kind(My_Args(I).umlInt.all);
--          end if;
--        end if;
      end loop;
    end if;
    return Tmp;
  end Check_Event;

  ---------------------------------------------
  --  adds the local trigger declarations to the All_Events table
  --  (if necessary)
      -- Parse the event Declarations (if any)
      --       Signals: r2,a2,e1,e2,f1,r1,e(x), a(x)
  ---------------------------------------------
  procedure Parse_Signals is
    This_Event: Event_Ref;
  begin
    if Current_Item = "Signals" or else
       Current_Item = "signals"  then
      Skip_Token;
      if Current_Item = ":" then
        Skip_Token;
      end if;
    else
     return;
    end if;
    -- in case of no signals  just return
    if Current_Item = "Operations" or else
       Current_Item = "operations" or else
        Current_Item = "Vars" or else
        Current_Item = "vars" or else
         Current_Item = "State" or else
         Current_Item = "state" then
      return;
    end if;
    loop
    declare
    begin
      This_Event := new Event;
      This_Event.Kind := Signal;
      This_Event.Name := Parse_Id;
      if Current_Item  = "(" then
        Skip_Token;
        This_Event.Params :=
          new EventVars_Table'(Parse_EventVars(No_EventVars));
        Skip_Token(")");
      else
       This_Event.Params := new EventVars_Table'(No_EventVars);
      end if;
      Check_Event(This_Event);
      if Current_Item = "," or Current_Item = ";" then
        Skip_Token;
      else
        if  Current_Item /= "end" and then
            Next_Item /= ":" and then
            Current_Item /= "Vars" and then
            Current_Item /= "State" and then
            Current_Item /= "Transitions" and then
            Current_Item /= "Behavior" and then
            Current_Item /= "Behaviour" and then
            Current_Item /= "behavior" and then
            Current_Item /= "behaviour" and then
            Current_Item /= "Operations" and then
            Next_Item /= "->" then
          Give_Error("1176 Error: Expecting "","" or "";"" or Vars Section or State definitions.");
          if Parsing_Errors > 5 then
             raise Parsing_Error;
          else
            Parsing_Failed := True;
            Parsing_Errors := Parsing_Errors+1;
            while  Current_Item /= "end" loop
              Skip_Token;
            end loop;
          end if;
        end if;
        exit;
      end if;
      --  error case:     Signals:  foo; fee;    Vars:
      if Next_Item = ":" or
         Current_Item="Vars" or
         Current_Item="vars" or
         Current_Item="Signals" or
         Current_Item="signals" or
         Current_Item="Operations"  or
         Current_Item="operations"  or
         Current_Item="State" or
         Current_Item="state" or
         Current_Item="Class"  or
         Current_Item="class"  or
         Current_Item="end"  or
         Current_Item="Behavior"  or
         Current_Item="behavior"  or
         Current_Item="Behaviour"  or
         Current_Item="behaviour"  or
         Current_Item="Transitions"  or
         Current_Item="transitions"  then
        exit;
      end if;
  exception
     when others =>
      Parsing_Failed := True;
      if Parsing_Errors > 5 then
         raise Parsing_Error;
      else
        while  Current_Item /= "" and then
             Current_Item /= ";" and then
             Current_Item /= "State" and then
             Current_Item /= "state" and then
             Current_Item /= "Vars" and then
             Current_Item /= "vars" and then
             Current_Item /= "Behavior" and then
             Current_Item /= "behavior" and then
             Current_Item /= "Behaviour" and then
             Current_Item /= "behaviour" and then
             Current_Item /= "Transitions" and then
             Current_Item /= "transitions" and then
             Current_Item /= "Class" and then
             Current_Item /= "class" and then
             Current_Item /= "Operations" and then
             Current_Item /= "operations" and then
             Current_Item /= "Objects" and then
             Current_Item /= "objects" loop
           Skip_Token;
        end loop;
        if Current_Item = ";" then Skip_Token; end if;
      end if;
    end;
    end loop;
--    All_Classes(Current_Class).ObservedEvents :=
--      new Bool_Table'(
--         1..All_Classes(Current_Class).ChartEvents.all'Length => True);
  exception
   when others =>
     Parsing_Failed := True;
     if Parsing_Errors > 5 then
       raise Parsing_Error;
     else
       while  Current_Item /= "" and then
           Current_Item /= "State" and then
           Current_Item /= "state" and then
           Current_Item /= "Vars" and then
           Current_Item /= "vars" and then
           Current_Item /= "Behavior" and then
           Current_Item /= "behavior" and then
           Current_Item /= "Behaviour" and then
           Current_Item /= "behaviour" and then
           Current_Item /= "Transitions" and then
           Current_Item /= "transitions" and then
           Current_Item /= "Class" and then
           Current_Item /= "class" and then
           Current_Item /= "Operations" and then
           Current_Item /= "operations" and then
           Current_Item /= "Objects" and then
           Current_Item /= "objects" loop
         Skip_Token;
       end loop;
     end if;
  end  Parse_Signals;
  --
  ---------------------------------------------
  --  adds the local trigger declarations to the All_Events table
  --  (if necessary)
  -- Parse the event Declarations (if any)
  --       Events: r2,a2,e1,e2,f1,r1,e(x), a(x)
  --  Operation Events DO HAVE an additional IMPLICIT first parameter
  --    for the ("caller")
  ---------------------------------------------
  procedure Parse_Operations is
    This_Event: Event_Ref;
    This_Kind: String_Ref;
  begin
    if Current_Item = "Operations" or
       Current_Item = "operations" then
      Skip_Token;
      if Current_Item = ":" then
        Skip_Token;
      end if;
    else
      return;
    end if;
    -- in case of no operations  just return
    if Current_Item = "Vars" or else
       Current_Item = "vars" or else
       Current_Item = "Signals" or else
       Current_Item = "signals" or else
         Current_Item = "State" or else
         Current_Item = "state" then
      return;
    end if;
    loop
    declare
    begin
      This_Event := new Event;
      This_Event.Kind := Operation;
      if Current_Item = "Vars"  or else
         Current_Item = "State" or else
         Current_Item = "Signals" or else
         Current_Item = "Operations" or else
         Next_Item = "->" or else
         Current_Item = "end" then
       return;
      end if;
      This_Event.Name := Parse_Id;
      if Current_Item  = "(" then
        Skip_Token;
        This_Event.Params :=
           new EventVars_Table'(Parse_EventVars((1..1 => null)));
        Skip_Token(")");
      else
       This_Event.Params := new EventVars_Table'(
                              (1..1 => null));
      end if;
      This_Event.Params(1) := new EventVar;
      This_Event.Params(1).Name := new String'("_caller");
      This_Event.Params(1).Kind := Object;
      This_Event.Params(1).Num_Key := 1;
      if Current_Item  = ":" then
        Skip_Token;
        --
        This_Kind := Parse_Id;
        if This_kind.all = "obj" then
          This_Event.Return_Type := Object;
          if Current_Item = "[" then
          This_Event.Return_Type := Objvector;
          Skip_Token ("["); 
          if Current_Item(1) in '0'..'9' then
            --?  This_Var.StaticSize := Integer'Value(Current_Item);
            Skip_Token; -- "number"
            Skip_Token("]"); 
          elsif Current_Item = "[" then
            -- var: obj[[]]; 
            This_Event.Return_Type := Objmatrix;
              Skip_Token; -- "["
              if Current_Item = "[" then
                This_Event.Return_Type := Objcube;
              Skip_Token("["); 
                Skip_Token("]");
              end if;
            Skip_Token("]");
            end if;
          Skip_Token ("]"); 
          end if;
        elsif This_kind.all = "bool" then
          This_Event.Return_Type :=  Bool;
          if Current_Item = "[" then
          This_Event.Return_Type := Boolvector;
          Skip_Token ("["); 
          if Current_Item(1) in '0'..'9' then
            --?  This_Var.StaticSize := Integer'Value(Current_Item);
            Skip_Token; -- "number"
            Skip_Token("]"); 
          elsif Current_Item = "[" then
            -- var: obj[[]]; 
            This_Event.Return_Type := Boolmatrix;
              Skip_Token; -- "["
              if Current_Item = "[" then
                This_Event.Return_Type := Boolcube;
              Skip_Token("["); 
              Skip_Token("]");
              end if;
            Skip_Token("]");
            end if;
          Skip_Token ("]"); 
          end if;
        elsif This_kind.all = "int" then
          This_Event.Return_Type :=  Number;
          if Current_Item = "[" then
          This_Event.Return_Type := Numvector;
          Skip_Token ("["); 
          if Current_Item(1) in '0'..'9' then
            --?  This_Var.StaticSize := Integer'Value(Current_Item);
            Skip_Token; -- "number"
            Skip_Token("]"); 
          elsif Current_Item = "[" then
            -- var: obj[[]]; 
            This_Event.Return_Type := Nummatrix;
              Skip_Token; -- "["
              if Current_Item = "[" then
                This_Event.Return_Type := Numcube;
              Skip_Token("["); 
              Skip_Token("]");
              end if;
            Skip_Token("]");
            end if;
          Skip_Token ("]"); 
          end if;
        else  -- Kind = Class_Name
          This_Event.Return_Type:= Object;
          if Current_Item = "[" then
            Skip_Token; -- "["
            if Current_Item(1) in '0'..'9' then
              --?  This_Var.StaticSize := Integer'Value(Current_Item);
              Skip_Token; -- "number"
            end if;
            Skip_Token("]"); -- "]"
            This_Event.Return_Type := Objvector;
          end if;
        end if;
      end if;
      Check_Event(This_Event);
      --
      --  add also implicit the corresponding "return"  Event
      --
      --    nk = Find_Event(This_Event);
      --    Check_Event(return#nk, [rv:This_Event.Return_Type])
      --  WHAT ABOUT  ALLOWING DIFFERENT TYPE PROFILES INSTEAD OF GIVING ERR?
      --   NOT POSSIBLE BECAUSE WHEN WE FIND A PLACEHOLDER WE MAY NOT KNOW THE
      --    CURRENT ARGS and RESULT TYPE (Find_Event uses only the event NAME)
      --
      if Current_Item = "," or Current_Item = ";" then
        Skip_Token;
      else
         exit;
      end if;
      if Current_Item="Vars" or
         Current_Item="vars" or
         Current_Item="Signals" or
         Current_Item="signals" or
         Current_Item="Operations"  or
         Current_Item="operations"  or
         Current_Item="State" or
         Current_Item="state" or
         Current_Item="Class"  or
         Current_Item="class"  or
         Current_Item="end"  or
         Current_Item="Behavior"  or
         Current_Item="behaviour"  or
         Current_Item="Behaviour"  or
         Current_Item="behavior"  or
         Current_Item="Transitions"  or
         Current_Item="transitions"  then
        exit;
       end if;
  exception
     when others =>
      Parsing_Failed := True;
      if Parsing_Errors > 5 then
         raise Parsing_Error;
      else
        while  Current_Item /= "" and then
             Current_Item /= ";" and then
             Current_Item /= "State" and then
             Current_Item /= "state" and then
             Current_Item /= "Vars" and then
             Current_Item /= "vars" and then
             Current_Item /= "Behavior" and then
             Current_Item /= "behavior" and then
             Current_Item /= "Behaviour" and then
             Current_Item /= "behaviour" and then
             Current_Item /= "Transitions" and then
             Current_Item /= "transitions" and then
             Current_Item /= "Class" and then
             Current_Item /= "class" and then
             Current_Item /= "Objects" and then
             Current_Item /= "objects" loop
           Skip_Token;
        end loop;
        if Current_Item = ";" then Skip_Token; end if;
      end if;
    end;
    end loop;
--    All_Classes(Current_Class).ObservedEvents :=
--      new Bool_Table'(
--         1..All_Classes(Current_Class).ChartEvents.all'Length => True);
  exception
   when others =>
      Parsing_Failed := True;
      if Parsing_Errors > 5 then
         raise Parsing_Error;
      else
        while  Current_Item /= "" and then
             Current_Item /= "State" and then
             Current_Item /= "state" and then
             Current_Item /= "Vars" and then
             Current_Item /= "vars" and then
             Current_Item /= "Behavior" and then
             Current_Item /= "behavior" and then
             Current_Item /= "Behaviour" and then
             Current_Item /= "behaviour" and then
             Current_Item /= "Transitions" and then
             Current_Item /= "transitions" and then
             Current_Item /= "Class" and then
             Current_Item /= "class" and then
             Current_Item /= "Signals" and then
             Current_Item /= "signals" and then
             Current_Item /= "Objects" and then
             Current_Item /= "objects" loop
           Skip_Token;
         end loop;
     end if;
  end  Parse_Operations;

  -------------------------------------------------------------------------------------
  -- elaborates the sequence of var declarations which appear inside a class definition
  -- Notice that vars Placeholders may already exists, in which case the placeholder
  --   definitions should be completed (redefined).
  -------------------------------------------------------------------------------------

  -- x
  -- x, y
  -- x, y, z 
  -- x, y;
  -- x,y,z:=34,       -- ALLOWED???
  -- x,y,z:int;
  -- x:int,   x:int;   
  -- x,y,z:int;      -- ALLOWED
  -- x,y,z:int :=3;  -- DISALLOWED
  -- x,y,z:=34;       -- DISALLOWED
  -- x:int, y:bool  -- SHOULD BE ALLLOWED USE of ',' instead of ';'
  -- x,y:int,       -- DISALLOWED  BECAUSE AMBIGUOUS
  function Parse_VarDecl return Vars_Table is
    This_Table: Vars_Table(1..100);
    Vars_Count:Natural :=0;
    This_Kind: String_Ref;
    PlaceHolder: Natural :=0;
--    Tmp: Int_Table_Ref;
    This_Simple: SimpleIntExpr;
    This_Var: SystemVar_Ref; 
  begin
   This_Var := new SystemVar;
   This_Var.Name := Parse_Id;
   This_Var.Chart := Current_Class;
   Vars_Count := Vars_Count+1;
   This_Table(Vars_Count):= This_Var;
   while Current_Item = "," loop
     Skip_Token;  -- ","
     This_Var := new SystemVar;
     This_Var.Name := Parse_Id;
     This_Var.Chart := Current_Class;
     Vars_Count := Vars_Count+1;
     This_Table(Vars_Count):= This_Var;
   end loop;
    --
    -- This_Var is the last declared variable of the table;
    --
    if Current_Item = ":" then
      -- parse the type [and initial value]
      Skip_Token;
      if Current_Item(1) in '0'..'9' and then
         Next_Item = ".." and then
         Next_Next_Item(1) in '0'..'9'  then
         This_Var.Kind :=  BoundedNat;
         This_Var.Initial := Zero.Simple;
         Skip_Token;  -- "0"
         Skip_Token;  -- ".."
         This_Var.NatBound :=  Integer'Value(Current_Item);
         Skip_Token;
      else
      This_Kind := Parse_Id;
      if This_kind.all = "obj" then
        This_Var.Initial := NullObject.Simple;
        This_Var.Kind := Object;
        if Current_Item = "[" then
          This_Var.Initial := NullStruct.Simple;
          This_Var.Kind := Objvector;
          Skip_Token ("["); 
          if Current_Item(1) in '0'..'9' then
            This_Var.StaticSize := Integer'Value(Current_Item);
            This_Var.Initial := null;
            Skip_Token; -- "number"
            Skip_Token("]"); 
          elsif Current_Item = "[" then
            -- var: obj[[]]; 
            This_Var.Kind := Objmatrix;
            Skip_Token; -- "["
            if Current_Item = "[" then
              This_Var.Kind := Objcube;
              Skip_Token("["); 
              Skip_Token("]");
            end if;
            Skip_Token("]");
          end if;
          Skip_Token ("]"); 
        end if;
      elsif This_kind.all = "bool" then
        This_Var.Kind :=  Bool;
        This_Var.Initial := BoolFalse.Simple;
        if Current_Item = "[" then
          This_Var.Initial := NullStruct.Simple;
          This_Var.Kind := Boolvector;
          Skip_Token ("["); 
          if Current_Item(1) in '0'..'9' then
            This_Var.StaticSize := Integer'Value(Current_Item);
            This_Var.Initial := null;
            Skip_Token; -- "number"
            Skip_Token("]"); 
          elsif Current_Item = "[" then
            -- var: obj[[]]; 
            This_Var.Kind := Boolmatrix;
            Skip_Token; -- "["
            if Current_Item = "[" then
              This_Var.Kind := Boolcube;
              Skip_Token("["); 
              Skip_Token("]");
            end if;
            Skip_Token("]");
          end if;
          Skip_Token ("]"); 
        end if;
      elsif This_kind.all = "int" then
        This_Var.Kind :=  Number;
        This_Var.Initial := Zero.Simple;
        if Current_Item = "[" then
          This_Var.Initial := NullStruct.Simple;
          This_Var.Kind := Numvector;
          Skip_Token ("["); 
          if Current_Item(1) in '0'..'9' then
            This_Var.StaticSize := Integer'Value(Current_Item);
            This_Var.Initial := null;
            Skip_Token; -- "number"
            Skip_Token("]"); 
          elsif Current_Item = "[" then
            -- var: obj[[]]; 
            This_Var.Kind := Nummatrix;
            Skip_Token; -- "["
            if Current_Item = "[" then
              This_Var.Kind := Numcube;
              Skip_Token("["); 
              Skip_Token("]");
            end if;
            Skip_Token("]");
          end if;
          Skip_Token ("]"); 
        end if;
      else  -- Kind = Class_Name
        This_Var.Kind := Object;
        This_Var.Initial := NullObject.Simple;
        This_Var.Typeinfo := Check_Class(This_kind.all);
        if Current_Item = "[" then
          This_Var.Initial := NullStruct.Simple;
          This_Var.Kind := Objvector;
          Skip_Token ("["); 
          if Current_Item(1) in '0'..'9' then
            This_Var.StaticSize := Integer'Value(Current_Item);
            This_Var.Initial := null;
            Skip_Token; -- "number"
            Skip_Token("]"); 
          elsif Current_Item = "[" then
            -- var: obj[[]]; 
            This_Var.Kind := Objmatrix;
            Skip_Token; -- "["
            if Current_Item = "[" then
              This_Var.Kind := Objcube;
              Skip_Token("["); 
              Skip_Token("]");
            end if;
            Skip_Token("]");
          end if;
          Skip_Token ("]"); 
        end if;
      end if;  -- ": id"
      end if;  -- ":0..n"
    --
    --  added to allow   x:int, y:=bool
    if Vars_Count=1 and Current_Item="," then 
      Tokens(Current_token).Item(1) := ';';
    end if; 
    --
    end if;  -- ":"
    --
    if Current_Item = ":=" or else Current_Item = "=" then
      Skip_Token;
      This_Var.Initial := Parse_SimpleExpr(No_EventVars);
      --
      -- CHECK  SIMPLE_EXPR DOES NOT CONTAIN INDEXING, HEAD, TAIL, LENGTH, UNDEFINEDNAMES
      --
      if Current_Item = "or" or else
         Current_Item = "and" or else
         Current_Item = "+" or else
         Current_Item = "-" or else
         Current_Item(1) = '>' or else
         Current_Item(1) = '<' or else
         Current_Item(1) = '/' or else
         Current_Item(1) = '!' or else
         Current_Item(1) = '&' or else
         Current_Item(1) = '|' or else
         Current_Item(1) = '*' then
        Give_Error("1666 no operators allowed in this context.");
        raise Parsing_Error;
      end if;
      if Current_Item = "." then
        Give_Error("1670 function calls not allowed.");
        raise Parsing_Error;
      end if;
        --
    --  added to allow   x:=0, y:=true
    if Vars_Count=1 and Current_Item="," then  
      Tokens(Current_token).Item(1) := ';';
    end if;
    --
    end if;
    --
    for V in 1.. Vars_Count-1 loop
      This_Table(V).Kind := This_Var.Kind;
      This_Table(V).StaticSize := This_Var.StaticSize;
      This_Table(V).NatBound := This_Var.NatBound;
      This_Table(V).Initial := This_Var.Initial;
      This_Table(V).Typeinfo := This_Var.Typeinfo;
    end loop;
    --
    return This_Table(1..Vars_Count);
  end  Parse_VarDecl;

  --------------------------------------------------------------
  --  called after finding Vars:   in
  --   Vars:  x:int=3, z:obj, k,l,m
  --------------------------------------------------------------
  procedure Parse_Vars is
--    Result: Vars_Table_Ref;
    separator: character := ' ';
  begin
    if Current_Item = "Vars" or
        Current_Item = "vars" then
      Skip_Token;
      All_Classes(Current_Class).Top_State_Num := 1;
      if Current_Item = ":" then
          Skip_Token;
      end if;
    else
      return;
    end if;
      --
      -- Vars   x y w w  --  TO BE DISALLOWED  !!!!!
      -- Vars   x,y,r :=234;
      -- Vars   x y,z,w:int :=3;  --  !!! only w is initialised!!!!
      -- Vars   x y;z;w
--      while  Current_Item = "," or else Current_Item = ";" loop
    loop   -- form each variable declaration
      -- end of sequence of variables (maybe empty region)
      if Current_Item="Vars" or
           Current_Item="vars" or
           Current_Item="Signals" or
           Current_Item="signals" or
           Current_Item="Operations"  or
           Current_Item="operations"  or
           Current_Item="end" or
           Current_Item = "(" or
           Next_Item = "->" or
           Next_Item = "." or
           Current_Item="State" or
           Current_Item="state" or
           Current_Item="Class"  or
           Current_Item="class"  or
           Current_Item="Behavior"  or
           Current_Item="behavior"  or
           Current_Item="Behaviour"  or
           Current_Item="behaviour"  or
           Current_Item="Transitions"  or
           Current_Item="transitions"  then
        exit;
      end if;
      declare
       This_Vars_Table: Vars_Table := Parse_VarDecl;
       This_Var: SystemVar_Ref; 
      begin
        for V in This_Vars_Table'Range loop 
          This_Var := This_Vars_Table(V);
          -- check if var already defined
          for I in All_Classes(Current_Class).ChartVars.all'Range loop
            if All_Classes(Current_Class).ChartVars(I).Name.all =  This_Var.Name.all then
               --This_Var.Local_Num_Key := I;
               --All_Classes(Current_Class).ChartVars(I) := This_Var;
               --This_Var:= null;
               --exit;
               Give_Error("1752 Variable " & This_Var.Name.all & " already defined ");
               raise Parsing_Error;
            end if;
          end loop;
          --if This_Var /= null then
          This_Var.Local_Num_Key := All_Classes(Current_Class).ChartVars.all'length+1;
            All_Classes(Current_Class).ChartVars :=
               new Vars_Table'(All_Classes(Current_Class).ChartVars.all & This_Var);
          --end if;
          --
         end loop;
        exception
        when others =>
          Parsing_Failed := True;
          if Parsing_Errors > 5 then
             raise Parsing_Error;
          else
           while Current_Item /= "" and then
              Current_Item /= ";" and then
              Current_Item /= "State" and then
              Current_Item /= "end" and then
              Current_Item /= "state" and then
              Current_Item /= "Class" and then
              Current_Item /= "class" and then
               Current_Item /= "Behavior" and then
               Current_Item /= "behavior" and then
               Current_Item /= "Behaviour" and then
               Current_Item /= "behaviour" and then
               Current_Item /= "Transitions" and then
               Current_Item /= "transitions" and then
              Current_Item /= "Objects" and then
              Current_Item /= "objects" loop
             Skip_Token;
           end loop;
           if Current_Item = ";" then Skip_Token; end if;
           end if;
      end;
      --
      if  -- end of sequence of variables (maybe empty region)
           Current_Item="Vars" or
           Current_Item="vars" or
           Current_Item="Signals" or
           Current_Item="signals" or
           Current_Item="Operations"  or
           Current_Item="operations"  or
           Current_Item="end" or
           Current_Item = "(" or
           Next_Item = "->" or
           Next_Item = "." or
           Current_Item="State" or
           Current_Item="state" or
           Current_Item="Class"  or
           Current_Item="class"  or
           Current_Item="Behavior"  or
           Current_Item="behavior"  or
           Current_Item="Behaviour"  or
           Current_Item="behaviour"  or
           Current_Item="Transitions"  or
           Current_Item="transitions"  then
          exit;
      elsif Current_Item /= ";" then
         Give_Error("1813  "";"" expected as variable decl separator");
         raise Parsing_Error;
      else  -- Current_Item = ";"
           Skip_Token;
      end if;
    end loop;  -- for all variables
  end Parse_Vars;

  -----------------------------------------------------------------
  --  given  non-empty sequence of token like:
  --    aa . bb . cc , dd . ee , ff
  --
  --  returns the table: [  "aa.bb.cc" , "dd.ee", "ff" ]
  --  where each item is the full name of a state.
  -----------------------------------------------------------------
  function Parse_Names_List return String_Table_Ref is
     Tmp_Name: String_Ref;
  begin
    Tmp_Name := Parse_Composite_Name;
    if Current_Item = "," then
      Skip_Token;
      declare
         More_Ids: String_Table_Ref := Parse_Names_List;
      begin
         return new String_Table'(Tmp_Name & More_Ids.all);
      end;
    else
      return new String_Table'(1..1 => Tmp_Name);
    end if;
  end Parse_Names_List;


  -----------------------------------------------------
  --  given a possily NON empty sequence of
  --   id , id(...,...) , id   returns the corresponding String_Table
  -----------------------------------------------------
  procedure Parse_Substates_List(Parent_State: State_Ref) is
     This_Ident: String_Ref;
     Current_State: State_Ref;
  begin
    if Tokens(Current_Token).Kind /= Id then
      Give_Error("1854 State id expected");
      raise Parsing_Error;
    end if;
    This_Ident := Parse_Id;
    --
       if Parent_State.SubStates /= null and then
          Parent_State.SubStates.all'Length >0 and then
          This_Ident.all = "initial" then
          Give_Error ("1862 ""initial"" must be the first of a substates list.");
          raise Parsing_Error;
       end if;
    --
    -- CREATE A NEW STATE for the class WITH GIVEN FULL_NAME
    --
    Current_State :=  Find_State(Parent_State.FullName.all & '.' & This_Ident.all);
    Current_State.Parent := Parent_State;
    Current_State.Depth := Parent_State.Depth + 1;
    Current_State.Priority := Parent_State.Priority + 1;
    Parent_State.SubStates := new States_table'(Parent_State.SubStates.all & Current_State);
    --
    if Current_Item = "(" and then Next_Next_Item /= "[" then  -- this is a composite substate
      Current_State.Kind := Composite;
      Current_State.Priority := Parent_State.Priority + 1;
      Skip_Token ( "(" );
      Parse_Substates_List(Current_State);
      Skip_Token ( ")" );
    elsif Current_Item = "(" and then Next_Next_Item = "[" then  -- this is a composite substate
      Current_State.Kind := Parallel;
      Current_State.Priority := Parent_State.Priority + 1;
      Skip_Token ( "(" );
      Parse_Substates_List(Current_State);
      Skip_Token ( ")" );
    elsif Current_Item = "[" then  -- this is a composite substate
      Current_State.Kind := Composite;
      if Parent_State.Kind /= Parallel then
         Give_Error ("1889 Error: Unexpected Region state inside composite sequential state");
         raise Parsing_Error;
      end if;
      Current_State.Priority := Parent_State.Priority + 1;
      Skip_Token ( "[" );
      Parse_Substates_List(Current_State);
      Skip_Token ( "]" );
    end if;
    --
    if Current_Item = "," then    -- this is just a simple (or deferred) substate
      Skip_Token;
      Parse_Substates_List(Parent_State);
    end if;
  end Parse_Substates_List;


  procedure Parse_Regions_List (Parent_State: State_Ref) is
     This_Ident: String_Ref;
     Current_State: State_Ref;
  begin
    if Tokens(Current_Token).Kind /= Id then
      Give_Error("1910 State id expected");
      raise Parsing_Error;
    end if;
    This_Ident := Parse_Id;
    --
    -- CREATE A NEW STATE for the class WITH GIVEN FULL_NAME
    --
    Current_State :=  Find_State(Parent_State.FullName.all & '.' & This_Ident.all);
    Current_State.Parent := Parent_State;
    Current_State.Depth := Parent_State.Depth + 1;
    Current_State.Priority := Parent_State.Priority + 1;
    Parent_State.SubStates := new States_table'(Parent_State.SubStates.all & Current_State);
    --
    if Current_Item = "[" then  -- this is a composite substate
      if Parent_State.Parent=null or else
           Parent_State.Parent.Kind = Parallel then
         Give_Error ("1926 Error:  Concurrent regions must appear inside a composite sequentual state");
         raise Parsing_Error;
      end if;
      if Parent_State.Kind /= Parallel then
         Give_Error ("1930 Error: Unexpected Region state inside composite sequential state");
         raise Parsing_Error;
      end if;
      Skip_Token ( "[" );
      Parse_Substates_List(Current_State);
      Skip_Token ( "]" );
    end if;
    --
    if Current_Item = "/"  or Current_Item = "," then
      Skip_Token;
      Parse_Regions_List(Parent_State);
    end if;
  end Parse_Regions_List;

  -------------------------------------------------------------------------
  -- If a state with the given Name is already present in the All_State table
  -- then its state ref is returned, otherwise a new state is created and
  -- introduced in the table, and the ref of the new state returned.
  --
  -- The given This_State_Name  must univoquely identify the state.
  -- If the state has  name  "top" (or other simple name) and it is not already
  --  defined, that this is the STATECHART  TOPLEVEL STATE.
  --  Clearly it must be the FIRST STATE DEFINITION !!!
  --  In all other cases the state will be already definied as it has been
  --   introduced by the declaration of the parent state structure.
  --  -----------------------
  -- if the lazy_parsing  flas is set, we try to handle inside Parse_transition
  --  previously undeclared state names.
  --  When we try to find "aa.bb", if it does not exist, we look for "aa" and create bb
  --  as substate.  If neithe "aa" exists, it is created as well.
  -------------------------------------------------------------------------
  function Find_State (This_State_Name: String) return State_Ref is
     Result: State_Ref;
     These_States: States_Table_Ref;
     Last_State: State_Ref;
     Last_Count: Natural;
     FullName: String_Ref;
  begin
    These_States := All_Classes(Current_Class).ChartStates;
    for I in These_States.all'Range loop
      FullName := These_States(I).FullName;
      if FullName.all = This_State_Name  then
        return These_States(I);
      elsif FullName'Length > This_State_Name'Length and then
        -- the given name is a unique suffix
        This_State_Name =
          FullName(FullName'Length-This_State_Name'Length+1 .. FullName'Length) and then
          FullName(FullName'Length-This_State_Name'Length) = '.' then
           if Result = null then
               Result := These_States(I);
           else
               Give_Error("1981 Error: Ambiguous State Name (" &
                 FullName.all & " or " &
                 Result.FullName.all & ") - please use a full pathname.");
               raise Parsing_Error;
           end if;
      end if;
    end loop;
    if Result /= null then
       return Result;
    end if;
    --
    -- if not found, then the given name is added to the states
    --  This happens for the TOPLEVEL state declaration and
    --   for the NESTED SUBSTATES FOUND when parsing a composite name stucture
    Last_State := new State;
    Last_State.FullName := new String'(This_State_Name);
    --
    if (This_State_Name /= "initial" and then
         (This_State_Name'Length <= 8 or else
            This_State_Name(This_State_Name'Last-7 .. This_State_Name'Last) /= ".initial")) then
      Last_Count := These_States.all'Length + 1;
      Last_State.Num_Key := These_States.all'Length +1;
      All_Classes(Current_Class).ChartStates :=
           new States_Table'(These_States.all & Last_State);
    end if;
    --
    -- Should FREE the old Table ...
    --
    return Last_State;
  end Find_State;


  -------------------------------
  --  Called by Parse Transitions when the -lazy flag is set
  --  The stste structure of the class is deduced by the transitions structure
  --  As new State Names  are found, they are introduced in the class ChartStates table.
  -------------------------------
  function Lazy_Find_State (This_State_Name: String) return State_Ref is
    Top_State: State_Ref;
    Parent: State_Ref;
    This_State: State_Ref;
    --
    Result: State_Ref;
    These_States: States_Table_Ref;
    FullName: String_Ref;
  begin
    if not Lazy_Parsing and not Almost_Lazy_Parsing then
       return Find_State (This_State_Name);
    end if;
    --
    -- if lazy_parsing but the State already exists, return it!
    --
    These_States := All_Classes(Current_Class).ChartStates;
    for I in These_States.all'Range loop
      FullName := These_States(I).FullName;
      if FullName.all = This_State_Name  then
        return These_States(I);
      elsif FullName'Length > This_State_Name'Length and then
        -- the given name is a unique suffix
        This_State_Name =
          FullName(FullName'Length-This_State_Name'Length+1 .. FullName'Length) and then
          FullName(FullName'Length-This_State_Name'Length) = '.' then
           if Result = null then
               Result := These_States(I);
           else
               Give_Error("2046 Error: Ambiguous State Name (" &
                 FullName.all & " or " &
                 Result.FullName.all & ") - please use a full pathname.");
               raise Parsing_Error;
           end if;
      end if;
    end loop;
    if Result /= null then
       return Result;
    end if;
    --
    if All_Classes(Current_Class).ChartStates.all'Length = 0 then
      --  missing Top State
      Top_State := Find_State("Top");  -- inserts Top_State in ChartStates
      All_Classes(Current_Class).Top_State_Num := 1;
      Top_State.Kind := Composite;
     else
      Top_State := All_Classes(Current_Class).ChartStates(1);
    end if;
    --
    -- find the parent state (possibly creating it)
    if Prefix(This_State_Name) = "" then
       Parent := Top_State;
    else
       Parent :=  Lazy_Find_State(Prefix(This_State_Name));
       -- with Full_name preperly adjusted
    end if;
    if This_State_Name = "Top" then
        return Top_State;
    end if;
    --if This_State_Name /= "initial" and then
    --         (This_State_Name'Length < 8 or else
    --           This_State_Name(This_State_Name'Last-7 .. This_State_Name'Last)
    --              /= ".initial") then
      This_State := Find_State(Parent.FullName.all & '.' & Suffix(This_State_Name));
    --else
     --  This_State:= new State;
     --  This_State.FullName :=
     --    new String'(Parent.FullName.all & '.' & Suffix(This_State_Name));
    --end if;
    -- BUG   This_State=NULL when initial
    --
    if This_State.Parent = null then
      -- was just created, must be properly initialized
      This_State.Parent := Parent;
      This_State.Depth := Parent.Depth+1;
      This_State.Priority := Parent.Priority+1;
      if Parent.Kind = Simple then
         Parent.Kind := Composite;
      end if;
      -- ADD TO PARENT SUBSTATES ONLY IF NOT DEFAULT_INITIAL
      if This_State /= null and then
            This_State.FullName.all /= "initial" and then
             (This_State.FullName.all'Length < 8 or else
               This_State.FullName(This_State.FullName'Last-7 .. This_State.FullName'Last)
                  /= ".initial") then
        Parent.SubStates :=
          new States_Table'(Parent.SubStates.all & This_State);
       end if;
    end if;
    -- in any case we return This_State, even if not linked to the parent.
    return This_State;
  end Lazy_Find_State;


  -------------------------------------------------------------------------
  -- If a state with the given Name is already present in the All_State table
  -- then its state ref is returned, otherwise returns null;
  -------------------------------------------------------------------------
  function Just_Find_State (This_State_Name: String) return State_Ref is
    Result: State_Ref;
    These_States: States_Table_Ref;
  begin
    These_States := All_Classes(Current_Class).ChartStates;
    for I in These_States.all'Range  loop
      if These_States(I).FullName.all =
                 This_State_Name then
        Result := These_States(I);
        exit;
      elsif These_States(I).FullName'Length > This_State_Name'Length and then
        -- the given name is a unique suffix
        This_State_Name = These_States(I).FullName(
             These_States(I).FullName'Length -This_State_Name'Length +1 ..
               These_States(I).FullName'Length) then
           if Result = null then
               Result := These_States(I);
           else
               Give_Error("2133 Error: Ambiguous State Name (" &
                 These_States(I).FullName.all & " or " &
                 Result.FullName.all & ") - please use a full pathname.");
               raise Parsing_Error;
           end if;
      end if;
    end loop;
    --
    return Result;
  end Just_Find_State;


  --
  -- return the position id of the given Chart,
  --  (for a new chart return a new position id)
  --
  function Check_Object (Chart_Name: String) return Integer is
     Tmp: Chart;
  begin
    for I in 1..All_Charts.all'Length loop
       if All_Charts(I).Name.all = Chart_Name then
         return I;
       end if;
    end loop;
    Tmp.Name := new String'(Chart_Name);
    --  symbolic: record the last poimnt of use
    Tmp.Top_State_Num := -Tokens(Current_Token).Line;
    All_Charts := new Chart_Table'(All_Charts.all & Tmp);
    return All_Charts.all'Length;
  end Check_Object;

  --
  -- return the position index (in All_Classes) of the given class.
  --  if not present, a class placeholder is created.
  --
  --  COME DISTINGUERE PLACEHOLDERS noin definiti (errori) da
  --  classi vuote (e.g. Tokens?)
  --
  function Check_Class (Class_Name: String) return Integer is
     Tmp: Chart;
  begin
    for I in 1..All_Classes.all'Length loop
       if All_Classes(I).Name.all = Class_Name then
         return I;
       end if;
    end loop;
    Tmp.Name := new String'(Class_Name);
    All_Classes := new Chart_Table'(All_Classes.all & Tmp);
    return All_Classes.all'Length;
  end Check_Class;

  function Find_Class (Class_Name: String) return Integer is
     Tmp: Chart;
  begin
    for I in 1..All_Classes.all'Length loop
       if All_Classes(I).Name.all = Class_Name then
         return I;
       end if;
    end loop;
    return 0;
  end Find_Class;

  function Find_Object (Chart_Name: String) return Integer is
     Tmp: Chart;
  begin
    for I in 1..All_Charts.all'Length loop
       if All_Charts(I).Name.all = Chart_Name then
         return I;
       end if;
    end loop;
    return 0;
  end Find_Object;
  --
  -- return the position id of the given Chart,
  --  (for a new chart return a new position id)
  --  if ChartName is a system var or event var returns -1
  --
--  function Check_Chart (Chart_Name: String;
--                         Env: EventVars_Table) return Integer is
--    This_Simple: SimpleIntExpr;
----    Tmp_Ref: String_Ref;
--    Tmp: Chart;
--  begin
--    --
--    This_Simple.Local_Variable := Find_Var(Chart_Name);
--    if This_Simple.Local_Variable /= 0 then
--      return -1 ;
--    end if;
--    for I in Env'Range loop
--      if Env(I).Name.all = Chart_Name then
--         This_Simple.Event_Variable :=  Env(I);
--         return -1;
--      end if;
 --   end loop;
--    for I in 1..All_Charts.all'Length loop
--       if All_Charts(I).Name.all = Chart_Name then
--         return I;
--       end if;
--    end loop;
--    Tmp.Name := new String'(Chart_Name);
--    All_Charts :=
--       new Chart_Table'(All_Charts.all & Tmp);
--    return All_Charts.all'Length;
--    --
--  end Check_Chart;


  ----------------------------------
  -- called by Parse_Object_Declarations when
  --  we find a "Chart" declaration
  --  we find an object declaration    Obj: Class ( var -> Value)
  --  we find a sequence of object declarations  Obj1,Obj2,Obj3: Class
  --  FAILS in the case:   Obj1,Obj2,Obj3: Class (var -> Value)
  ----------------------------------
  procedure Create_Object_Instance (This_Object_Name: String_Ref;
                                    This_Class_Name: String_Ref) is
    Vars_Count: Natural;
    This_Var: SystemVar_Ref;
--    This_State: State_Ref;
    This_Object: Chart;
    This_UML_Object: UML_Object;
    Saved_Lazy_Flag: Boolean;
  begin
    Saved_Lazy_Flag := Flags.Lazy_Parsing;
    Flags.Lazy_Parsing := False;
    --
    --  objects can be named even before declaration
    --   if this happen, the object instance is already present in All_Charts
    --   and its name is already defined (all other fields not)
    --   (in particular, until fully defined, Object.ChartParent = 0)
    --
    --  ERR and OUT  objects are teh only oly ones which can be redeclared.
    --   (overloading their default definitions)
    --
    Current_Object := Find_Object(This_Object_Name.all);
    if Current_Object > 2 and then
        All_Charts(Current_Object).ChartParent > 0 then
      Give_Error ("2270 Error: Object " & This_Object_Name.all &
                    " already defined!");
      raise Parsing_Error;
    end if;
    --
    if Current_Object in 1..2  and then
        All_Charts(Current_Object).Top_State_Num > 0 then
      Give_Error ("2277 Error: Object " & This_Object_Name.all &
                    " already defined!");
      raise Parsing_Error;
    end if;
    --
    if Current_Object = 0 then
      This_Object.Name := This_Object_Name;
      All_Charts :=
         new Chart_Table'(All_Charts.all & This_Object);
      Current_Object := All_Charts.all'Length;
    end if;
    --
    This_UML_Object.The_Object := Current_Object;
    --
    -- if Current_Object = 1 or 2 or  >2&ChartParent=0 then the existing
    --   instance is recycled
    --
    Current_Class:= Find_Class(This_Class_Name.all);
    if Current_Class = 0 then
      Give_Error ("2296 Error: Chart " & This_Class_Name.all & " not yet defined!");
      raise Parsing_Error;
    end if;
    All_Charts(Current_Object).ChartParent := Current_Class;
    All_Charts(Current_Object).NiceParallelism := All_Classes(Current_Class).NiceParallelism;
    All_Charts(Current_Object).IsRandom := All_Classes(Current_Class).IsRandom;
    All_Charts(Current_Object).Top_State_Num :=
         All_Classes(Current_Class).Top_State_Num;
    --
    if All_Charts(Current_Object).Top_State_Num > 0 then
      Active_Charts := new Num_Table'(Active_Charts.all & Current_Object);
      All_Charts(Current_Object).Chart_Position := Active_Charts.all'Length;
    end if;
    --
    --  vars cannot be simply shared because the All_Vars table must be extended
    --  and new initial values maybe provided.
    -- (we might adopt a chart "vars_Base" and chart vars_initial)
    --
    Vars_Count := All_Classes(Current_Class).ChartVars.all'Length;
    --
    All_Charts(Current_Object).ChartVars :=
         new Vars_Table(1..Vars_Count);
    for I in 1..Vars_Count loop
      This_Var := new SystemVar;
      This_Var.Name := All_Classes(Current_Class).ChartVars(I).Name;
      This_Var.Local_Num_Key := I;
      This_Var.Chart := Current_Object;
      This_Var.Observed  := False;
      This_Var.Initial := All_Classes(Current_Class).ChartVars(I).Initial;
      This_Var.Kind := All_Classes(Current_Class).ChartVars(I).Kind;
      This_Var.TypeInfo := All_Classes(Current_Class).ChartVars(I).TypeInfo;
      This_Var.StaticSize := All_Classes(Current_Class).ChartVars(I).StaticSize;
      This_Var.NatBound := All_Classes(Current_Class).ChartVars(I).NatBound;
      All_Charts(Current_Object).ChartVars(I) := This_Var;
    end loop;
    --
--   All_Vars := new Vars_Table'(All_Vars.all &
--                        All_Charts(Current_Object).ChartVars.all);
   --
   --  events can be shared
   --
   All_Charts(Current_Object).ChartEvents :=
        All_Classes(Current_Class).ChartEvents;
   --
   --  observations cannot be shared because they are selective
   --
--   All_Charts(Current_Object).ObservedEvents :=
--      new Bool_Table'
--          (1..All_Classes(Current_Class).ObservedEvents.all'Length => true);
   --
   -- States can  be shared, because their runtime_position is now local
   --
   All_Charts(Current_Object).ChartStates :=
        All_Classes(Current_Class).ChartStates;
   --
   --   transitions are shared with the parent
   --
   All_Charts(Current_Object).ChartTransitions :=
       All_Classes(Current_Class).ChartTransitions;
   --
   All_Charts(Current_Object).ChartInterferences :=
       All_Classes(Current_Class).ChartInterferences;
   --
   -- Active_Charts is expanded each time an active  Chart or Object
   --  declaration is found N.B:, only if object isi active.
   --
   All_Charts(Current_Object).ChartStates_Base := 0;
   if All_Charts(Current_Object).Top_State_Num > 0 and  then
        Active_Charts.all'Length > 1 and then
       Current_Object = Active_Charts(Active_Charts.all'length) then
     --
     All_Charts(Current_Object).ChartStates_Base :=
       All_Charts(Active_Charts(Active_Charts.all'length-1)).ChartStates_Base +
       All_Charts(Active_Charts(Active_Charts.all'length-1)
                ).ChartStates(1).LastRuntimePosition;
   end if;

   --
   --  parse the object attribute initializations ...
   --
   if Current_Item  = "(" then
     Skip_Token;
     loop
       declare
	 This_Item: String := Parse_Id.all;
	 This_Var: Natural := Find_Var(This_Item);
	 This_Expr: SimpleIntExpr_Ref;
	 This_SVar: SystemVar_Ref;
       begin
         if This_Var = 0 then
            Give_Error ("2385 Error: Undefined attribute name """ &This_Item & """");
            raise Parsing_Error;
         end if;
	 if Current_Item  = "=>" or
             Current_Item  = "="  or
              Current_Item  = "->"  then
    	    Skip_Token;
         else
           Give_Error ("2393 ""=>"" expected");
           raise Parsing_Error;
         end if;
         --  at this point, event var initialization can contain Global Object names!!!
         -- we should not create new implicit vars...
	 This_Expr := Parse_SimpleExpr(No_EventVars);
         if Current_Item = "." then
           Give_Error("2400 Attribute selection not allowed.");
           raise Parsing_Error;
         end if;
	 This_SVar := All_Charts(Current_Object).ChartVars(This_Var);
	 This_SVar.Initial := This_Expr;
--         if This_SVar.Kind = Undefined then
--            This_SVar.Kind := This_Expr.Kind;
--         end if;
         -- if Kind = Object maybe we should set the var.TypeInfo
         This_UML_Object.Bindings :=
           new Bindings_Table'(This_UML_Object.Bindings.all &
                 Binding'(This_SVar.Name, This_SVar.Initial.Image) );
       end;
       --
       if Current_Item = ")" then
	 Skip_Token;
         if Current_Item = ";" then
	   Skip_Token;
         end if;
	 exit;
       elsif Current_Item = ";" then
        Skip_Token;
       end if;
       if Current_Item /= "," then
          Give_Error("2424 ERROR: Expecting a "","" or a "")"" to continue or end the parameters list.");
          raise Parsing_Error;
       end if;
       Skip_Token (",");
     end loop;
    end if;
    UML_Configuration := new Objects_Table'(UML_Configuration.all & This_UML_Object);
    Flags.Lazy_Parsing := Saved_Lazy_Flag;
  end Create_Object_Instance;

  function Parse_Observations(MyObservations: Observations_Table)
                      return Observations_Table;


  procedure Parse_Object_Declarations is
    This_Object_Name: String_Ref;
    This_Class_Name: String_Ref;
    These_Objects: String_Table_Ref := new String_Table(1..0);
    Saved_Token: Natural :=0;
  begin
    loop
      This_Object_Name :=  Parse_Id;
      These_Objects := new String_Table'(These_Objects.all & This_Object_Name);
      if Current_Item = "," then
        Skip_Token; -- ,
      else
        -- now we have all objects names in These_Objects
        Skip_Token(":");
        exit;
      end if;
    end loop;
    --
    This_Class_Name :=  Parse_Id;
    Saved_Token := Current_Token;
    for K in These_Objects.all'Range loop
      -- adjust Current_Token - to be recycled for all instances
      Current_Token := Saved_Token;
      Create_Object_Instance (These_Objects(K), This_Class_Name);
    end loop;
    if Current_Item = ";" then
      Skip_Token;
    end if;
    --
  exception
    when others =>
      Parsing_Failed := True;
      if Parsing_Errors > 5 then
        raise;
      else
        while Current_Item /= "" and then
            Current_Item /= "class" and then
            Current_Item /= "Class" and then
            Current_Item /= "Objects" and then
            Current_Item /= "objects" and then
            Current_Item /= "abstractions" and then
            Current_Item /= "Abstractions" and then
            Next_Item /= ":" loop
          Skip_Token;
        end loop;
      end if;
  end Parse_Object_Declarations;

  procedure ParseIncluded (F: File_Type);

  -------------------------------------------------------------------------
  --  Elaborates the list of States definitions,
  -- uploads all of them in the "All_States" tables,
  -- uploads all the transitions if the "ChartTransitions" table,
  -- uploads all the events (Triggers/Actins) in the "ChartEvents" table,
  -- initializes the "This_UML_Object"  variable
  --  (which might become a table in the case of multiple machine)
  -------------------------------------------------------------------------
  procedure Parse (Uml_File_Name: String) is
  begin
    Parsing_Failed := False;
    Parsing_Errors :=0;
    Main_File_Name := new String'(Uml_File_Name);
    ---
    Previous := '^';
    Current_File_Name := new String'(Uml_File_Name);
    Tokens := new Tokens_Table(1..0);
    --
    -- check existence and readability of file, otherwise exits
    --
    begin
      Open(F, In_File, Uml_File_Name);
      Read_Tokens(F);
      Close(F);
      if Current_Item = "" then
        Give_Error ("2513 The UML file is EMPTY ...");
        raise Parsing_Error;
      end if;
    exception
      when others =>
         Give_Error ("2518 The UML file is not readable ...");
         if Is_Open(F) then Close(F); end if;
         raise Parsing_Error;
    end;
    --
    ParseIncluded(F);
    --
    if New_Observations.all'Length=0 then
        All_Observations := new Observations_Table'(Default_Rules & Error_Rules);
    else
        All_Observations := new Observations_Table'(Error_Rules & New_Observations.all);
    end if;
    --
    Check_Missing_Definitions;
    --
    if Active_Charts.all'Length < 1 then
--      Give_Error (" Error: No object declaration found !!!! ");
      Put_line(Current_Error,"2535  Error: No object declaration found !!!! ");
      raise Parsing_Error;
    end if;
    --
    --  copy class OUT /ERR  events to chart instances
    --
    All_Charts(1).ChartEvents := All_Classes(1).ChartEvents;
    All_Charts(2).ChartEvents := All_Classes(2).ChartEvents;
    --
--
--    if Active_Charts.all'Length >= 1 then
--      UML_Types.This_UML_Object := All_Charts(Active_Charts(1)).ChartStates(1);
--    end if;
   --
   if Parsing_Failed or Parsing_Errors >0 then
      raise Parsing_Error;
   end if;
   --
   exception
    when Parsing_Error =>
         Put_Line (Current_Error, "Runtime Error during Parsing!");
        if Is_Open(F) then Close(F); end if;
        raise;
    when Event: others =>
         Put_Line (Current_Error,  "Unexpected Runtime Error in UML_parser!");
         Put_Line (Current_Error, Exception_Name(Event));
         Put_Line (Current_Error, Exception_Message(Event));
        Close(F);
        raise;
    end Parse;
  -----------------------------------------------------------------


  -----------------------------------------------------------------
  -----------------------------------------------------------------
  procedure ParseIncluded (F:File_Type) is
    This_Object_Name: String_Ref;
    This_Class_Name: String_Ref;
    Line: Natural :=0;
    comms: String_Table_Ref;
  begin
      --  until EOF
    while Current_Item /= "" loop
     declare
     begin
      --
      if Current_Item = "Chart" then
      ---------------------------------------
      --   Chart  OO is
      --     ...
      --   end OO;
      ---------------------------------------
         --- DEPRECATED
        comms := Tokens(Current_Token).PrecedingBlockComment;
        Skip_Token;
        --
        -- in general, a chart id may already exist if a signal
        --  addressed to it has already been eleborated
        -- (if not already existing, create a default Chart object)
        -- THIS IS NOW FALSE:  CHARTS EXIST ONLU AFTER DECLARATION
        --  AND CANNOT BE MENTIONED BEFORE DECLARATION AS TARGET OF SIGNALS.
        --  CHARTS MAY PERHAPS BE REFINED ???
        --  CHARTS CAN BE NON ACTIVE  (e.g. OUT, ERR)
        --
        This_Class_Name :=  Parse_Id;
        Parse_Class_Body (This_Class_Name);
        This_Object_Name := This_Class_Name;
        Create_Object_Instance (This_Object_Name, This_Class_Name);
        --
      elsif Current_Item = "Class" or else
            Current_Item = "class" then
        -----------------------------------
        --   Class  MyClass is
        --     ....
        --   end MyClass;
        ------------------------------------
        comms := Tokens(Current_Token).PrecedingBlockComment;
        Skip_Token;
        This_Class_Name :=  Parse_Id;
        Parse_Class_Body(This_Class_Name,comms);
        --
     elsif  Current_Item = "Objects" or
            Current_Item = "objects" then
        ---------------------------------
        --   Objects:
        ---------------------------------
        Skip_Token;  -- Objects
        if Current_Item = ":" then
           Skip_Token;  -- ;
        end if;
        --
      elsif Current_Item = "Object" then
        -----------------------------------
        --    Object OO: MyClass;
        -----------------------------------
        -- DEPRECATED  !!!!
        Skip_Token;
        Parse_Object_Declarations;
        --
     elsif Next_Item=":" or Next_Item="," then
        --------------------------------------
        --    OO: MyClass;
        --------------------------------------
        Parse_Object_Declarations;
        --
      elsif  Current_Token /= Tokens.all'Length and then
          (Current_Item = "Abstractions" or else
            Current_Item = "abstractions") then
        ----------------------------------------
        --  Abstractions {
        --     ...
        --  };
        ------------------------------------------
        Skip_Token;
        Skip_Token ("{");
        New_Observations :=
           new Observations_Table'(Parse_Observations(New_Observations.all));
        Skip_Token("}");
      elsif Current_Item = "#" and then Next_Item = "include" then
        ------------------------------------------
        Skip_Token("#");
        Skip_Token("include");
        if Included_File_Name /= null then
           Give_Error("2651 #include directive can only appear in main system file");
           Parsing_Errors := Parsing_Errors+1;
           raise Parsing_Error;
        end if;
        Included_File_Name := Parse_Id;
        while Current_Item = "." loop
          Skip_Token(".");
          Included_File_Name :=
            new String'(Included_File_Name.all & "." & Parse_Id.all);
        end loop;
        --  #include included.txt
        --
        --  BACKUP MAIN PARSING DATA
        --
        MainTokens := Tokens;
        MainCurrent_Token := Current_Token;
        MainCurrent_Position := Current_Position;
        MainLine_Number := Line_Number;
        MainLast_Line := Last_Line;
        MainInput_line := Input_line;
        MainPrevious := Previous;
        MainLine_Length := Line_Length;
        --
        --  INITIAL SETUP FOR INCLUDED FILE DATA
        --
        Current_File_Name := Included_File_Name;
        Tokens := new Tokens_Table(1..0);
        Line_Number :=0;
        Current_Token :=0;
        Previous := '^';
        Line_Length :=0;
        --
        begin
          Open(Fincluded, In_File, Included_File_Name.all);
          Read_Tokens(Fincluded);
              Close(Fincluded);
          if Current_Item = "" then
            Give_Error ("2688 The UML file is EMPTY ...");
            raise Parsing_Error;
          end if;
          -------
          ParseIncluded(Fincluded);
          -------
        exception
          when others =>
             Give_Error ("2696 The UML file is not readable ...");
             if Is_Open(Fincluded) then Close(Fincluded); end if;
             raise Parsing_Error;
        end;
        --
        --  RESTORE MAIN PARSING DATA
        --
        Tokens := MainTokens;
        Current_Token := MainCurrent_Token;
        Current_Position := MainCurrent_Position;
        Line_Number := MainLine_Number;
        Last_Line := MainLast_Line;
        Input_line := MainInput_line;
        Previous := MainPrevious;
        Line_Length := MainLine_Length;
        Current_File_Name := Main_File_Name;
        Included_File_Name := null;
        ------------------------------------------
      --
      else
        Give_Error( "2716 Class  or Object  declaration expected");
        Parsing_Failed := True;
        if Parsing_Errors > 5 then
          raise Parsing_Error;
        else
          Parsing_Failed := True;
          Parsing_Errors := Parsing_Errors+1;
          while Current_Item /= "" and then
               Current_Item /= "Class" and then
               Current_Item /= "class" and then
               Current_Item /= "Abstractions" and then
               Current_Item /= "abstractions" loop
            Skip_Token;
          end loop;
        end if;
      end if;
     end;
    end loop;
    --
    --  end main loop
  end ParseIncluded;
  -----------------------------------------------------------------


  ---------------------------------------------------------------
  --  ids=  obj.attr,  literal, special_token, globalobj
  ---------------------------------------------------------------
  procedure Check_Term (Ids: String_Table) is
    Result: Natural := 0;
    TheseVars: Vars_Table_Ref;
  begin
    if Ids'Length =2 then
      for I in 1..All_Charts.all'Length loop
         if All_Charts(I).Name.all = Ids(1).all then
           Result := I;
           exit;
         end if;
      end loop;
      if Result = 0 then
         Give_Error ("2755 Object name expected ...  (obj.attr)" );
         raise Parsing_Error;
      end if;
      if Ids(2).all = "queuesize" then return; end if;
      TheseVars :=  All_Charts(Result).ChartVars;
      for I in TheseVars.all'Range loop
        if TheseVars(I).all.Name.all = Ids(2).all then
          return;
        end if;
      end loop;
     Give_Error ("2765 Attribute name expected ...  (obj.attr)" );
     raise Parsing_Error;
     --
    elsif Ids'Length =1 then
      if Is_Number(Ids(1).all) or else
         Ids(1).all = "null"  or else
         Ids(1).all = "true"  or else
         Ids(1).all = "True"  or else
         Ids(1).all = "TRUE"  or else
         Ids(1).all = "false"  or else
         Ids(1).all = "False"  or else
         Ids(1).all = "FALSE"  or else
         Ids(1).all = "maxqueuesize"  then
         return;
      else
        for I in 1..All_Charts.all'Length loop
           if All_Charts(I).Name.all = Ids(1).all then
             return;
           end if;
        end loop;
        Give_Error ("2785 Literal or object name expected .. " );
        raise Parsing_Error;
      end if;
    end if;
    --
  end Check_Term;


  procedure Check_Unused(This: Rule_Left; Varname: String) is
  begin
    for J in This'Range loop
      --
      if  This(J).LTerm/= null and then
        This(J).LTerm.all = Varname then
        Give_Error("2799 Illegal multiple use  of variable in observation rule");
        raise Parsing_Error;
      end if;
      if This(J).LPartner /= null and then
        This(J).LPartner.all = Varname then
        Give_Error("2804 Illegal multiple use of variable in observation rule");
        raise Parsing_Error;
      end if;
      if This(J).LOp /= null and then
        This(J).LOp.all = Varname then
        Give_Error("2809 Illegal multiple use of variable in observation rule");
        raise Parsing_Error;
      end if;
      if This(J).LArgs /= null then
        for A in This(J).LArgs.all'Range loop
          if This(J).LArgs(A).all = Varname then
            Give_Error("2815 Illegal multiple use of variable in observation rule");
            raise Parsing_Error;
          end if;
        end loop;
      end if;
      --
      if This(J).IdsR /= null then
        for I in This(J).IdsR.all'Range loop
          if This(J).IdsR(I).all = Varname then
            Give_Error("2824 Illegal multiple use  use of variable in observation rule");
            raise Parsing_Error;
          end if;
        end loop;
      end if;
    end loop;
  end Check_Unused;


  procedure Check_Used(This: Rule_Left; Varname: String) is
  begin
    for J in This'Range loop
      --
      if  This(J).LTerm/= null and then
        This(J).LTerm.all = Varname then
        return;
      end if;
      if This(J).LPartner /= null and then
        This(J).LPartner.all = Varname then
        return;
      end if;
      if This(J).LOp /= null and then
        This(J).LOp.all = Varname then
        return;
      end if;
      if This(J).LArgs /= null then
        for A in This(J).LArgs.all'Range loop
          if This(J).LArgs(A).all = Varname then
             return;
          end if;
        end loop;
      end if;
      --
      if This(J).IdsR /= null then
        for I in This(J).IdsR.all'Range loop
          if This(J).IdsR(I).all = Varname then
             return;
          end if;
        end loop;
      end if;
    end loop;
    --
    Give_Error ("2866 Abstraction Rule contains undefined variables ...");
    raise Parsing_Error;
    --
  end Check_Used;

  ------------------------------------------------------
  -- First check:  $v are NOT decalred twice
  -- Second check  $v used in RLabels ARE declared
  --  TO BE ADJUSTED     Largs NOT checked ...
  --
  ------------------------------------------------------
  procedure Check_Observation(OP: Observation_Rule) is
     OK: Boolean := False;
     Declared: String_Table_Ref := Empty_String_Table_Ref;
  begin
    -- restricted check for Action rules to allow
    --    foo($1,$2)  and $1 = $2  -> bb
    --
    --  Left_Rule_Element = [ LTerm, LPartner, Lop, LArgs, / IdsL , LeftOp, IdsR ]
    --                    =    obj:   tgt.     sig  v1,v2     1,2     EQ    $1,$2
    --
    --  GOAL:  allow multiple $ defining 'foo($1,$2)'  'bar($3,$2)'
    --  GOAL   $ defining realtions  $1[1][2] = $3  and  $1[$3] = $4 and ...
    --
    --  CHECKS TO BE EXTENDED ....
    --
    if Op.Kind= ActionKind then
       if OP.Left(1).LTerm /= null and then
          OP.Left(1).LPartner /= null and then
          OP.Left(1).LPartner(1) = '$' and then
          OP.Left(1).LPartner.all = OP.Left(1).LTerm.all then
         Give_Error("2897 Illegal multiple use  use of variable in observation rule");
         raise Parsing_Error;
       end if;
       if OP.Left(1).LTerm /= null and then
          OP.Left(1).LOp /= null and then
          OP.Left(1).LOp(1) = '$' and then
          OP.Left(1).LOp.all = OP.Left(1).LTerm.all then
         Give_Error("2904 Illegal multiple use  use of variable in observation rule");
       end if;
       if OP.Left(1).LPartner /= null and then
          OP.Left(1).LOp /= null and then
          OP.Left(1).LOp(1) = '$' and then
          OP.Left(1).LOp.all = OP.Left(1).LPartner.all then
         Give_Error("2910 Illegal multiple use  use of variable in observation rule");
         raise Parsing_Error;
       end if;
       --
       --
       for I in OP.Rlabels.all'Range loop
          if OP.Rlabels(I)(1)= '$' then
            Check_Used(OP.Left.all, OP.Rlabels(I).all);
          end if;
       end loop;
    end if;
    --
    -- CHECK FOR STATE OBSERVATIONS:
    --  1)  First occurrence of a var in the LHS is inside a valid var declaration (obj.attr[u] = $id)
    --  2)  All vars in the  RHS have been declared in the LHS
    --
    if Op.Kind /= ActionKind then  -- i.e. StateKind
      for I in OP.Left.all'Range loop
        --
        -- InState(Obj, Top.S1.s2)
        -- no variables allowed in this context
        --
        if OP.Left(I).Largs /= null then
          for J in OP.Left(I).Largs.all'Range loop
            if OP.Left(I).Largs(J)(1) = '$' then
              Give_Error("2935 Error: no $ variables allowed in this context");
              raise Parsing_Error;
            end if;
          end loop;
        end if;
        --
        --  obj.var.ind1ind2 op  RHS
        -- A) No undlared Vars in LHS
        -- B) LeftOp is "=" and LHS'Length=1 and LHS(1)="$" --> declare LHS(1)
        -- C) No undlared Vars in RHS
        --
        if OP.Left(I).IdsL /= null then
          -- A) No undlared Vars in LHS
          for J in OP.Left(I).IdsL.all'Range loop
            if OP.Left(I).IdsL(J)(1) = '$' then
               -- check variable is declared
               OK := False;
               for K in Declared'Range loop
                 if Declared(K).all = OP.Left(I).IdsL(J).all then
                   OK := True;
                   exit;
                 end if;
               end loop;
               if not OK then
                 Give_Error("2959 Error: no $ variables allowed in this context");
                 raise Parsing_Error;
               end if;
            end if;
          end loop;
          --
          if OP.Left(I).LeftOp = EQ and then
             OP.Left(I).IdsR.all'Length = 1 and then
             OP.Left(I).IdsR(1)(1) = '$' then
            -- B) LeftOp is "=" and LHS'Length=1 and LHS(1)="$" --> declare LHS(1)
            -- if not declared yet, declare it
            OK := False;
            for K in Declared'Range loop
              if Declared(K).all = OP.Left(I).IdsR(1).all then
                OK := True;
                exit;
              end if;
            end loop;
            if not OK then
               Declared := new String_Table'(Declared.all & OP.Left(I).IdsR(1));
            end if;
          else
            -- C) No undlared Vars in RHS
            for J in OP.Left(I).IdsR.all'Range loop
              if OP.Left(I).IdsR(J)(1) = '$' then
                 -- check variable is declared
                 OK := False;
                 for K in Declared'Range loop
                   if Declared(K).all = OP.Left(I).IdsR(J).all then
                     OK := True;
                     exit;
                   end if;
                 end loop;
                 if not OK then
                   Give_Error("2993 Error: no $ variables allowed in this context");
                   raise Parsing_Error;
                 end if;
              end if;
            end loop;  -- check inside IdsR
          end if;  -- IdsR not single var
        end if;  -- IdsL /= null
      end loop;  -- check inside all Left side compponents of the rule
      --
      -- check inside Rlabels
      for RL in OP.Rlabels.all'Range loop
        if OP.Rlabels(RL)(1)= '$' then
          -- check variable is declared
          OK := False;
          for K in Declared'Range loop
            if Declared(K).all = OP.Rlabels(RL).all then
              OK := True;
              exit;
            end if;
          end loop;
          if not OK then
            Give_Error("3014 Error: $ variable not defined  ");
            raise Parsing_Error;
          end if;
        end if;
     end loop;
    end if;   -- state / Action rule
    --
  end Check_Observation;

  procedure MarK_Observed_Var (Name: String_Ref) is
  begin
    for O in All_Charts.all'Range loop
      if All_Charts(O).ChartVars /= null then
          for V in All_Charts(O).ChartVars.all'Range loop
            if All_Charts(O).ChartVars(V).Name.all = Name.all then
                 All_Charts(O).ChartVars(V).Observed := True;
            end if;
          end loop;
      end if;
    end loop;
    null;
  end MarK_Observed_Var;


  function Has_Been_Defined (TheVar: String; Left_Side: Rule_Left) return Boolean is
  begin
     if Left_Side'Length = 0 then return False; end if;
      if Left_Side(1).LTerm /= null and then TheVar = Left_Side(1).LTerm.all then return True; end if;
      if Left_Side(1).LPartner /= null and then TheVar = Left_Side(1).LPartner.all then return True; end if;
      if Left_Side(1).LOp /= null and then TheVar = Left_Side(1).LOp.all then return True; end if;
      if Left_Side(1).LArgs /= null then
         for J in Left_Side(1).LArgs.all'Range loop
            if Left_Side(1).LArgs(J) /= null and then Left_Side(1).LArgs(J).all = TheVar then return True; end if;
         end loop;
      end if;
      return False;
  end Has_Been_Defined;


  ------------------------------------------------------------------------
  -- Parse_Observations =
  --    Parse_Left_Side (Kind, Empty_Left_Side)  ->  ..... ;
  --    Parse_observations;
  --
  -- Parse_Left_Side (Kind, Previous) =
  --      " ( This )   and  ... "
  --     Parse_Left_Side (Kind, Previous & This);
  --
  --
  -- type Rule_Left_Elem is record
  --   LTerm: String_Ref;                                  -- src
  --   LPartner: String_Ref;                               -- target
  --   LOp: String_Ref;                                    -- event /obj (inState clause)
  --   LMode: String_Ref;
  --   LArgs: String_Table_Ref;                            -- [arg1,arg2]/ (Top.S1.s2)
  --   ----
  --   IdsL: String_Table_Ref := Empty_String_Table_Ref;   -- [obj1,var]/$v/literal/
  --   LeftOp: BinOp :=NOOP;                               --  EQ/NE/LT/GT/LE/GE
  --   IdsR: String_Table_Ref :=  Empty_String_Table_Ref;  --  [obj2,var]/$v/literal
  -- end record;
  --
    -- restricted check for Action rules to allow
    --    foo($1,$2)  and $1 = $2  -> bb
    --
    --  Rule_Left_Elem = [ LTerm, LPartner, Lop, LArgs, / IdsL , LeftOp, IdsR ]
    --                    =    obj:   tgt.     sig  v1,v2     1,2     EQ    $1,$2
    --
    --  GOAL:  allow multiple $ defining 'foo($1,$2)'  'bar($3,$2)'
    -------------------------------------------------------------------
    -- N.B  Rule_Left  is a vector of Rule_Left_Elem;
    --
    -------------------------------------------------------------------
  function Parse_Left_Side (Kind: AbstractionKind;
                             Previous: Rule_Left) return Rule_Left is
    This: Rule_Left_Elem;
    OK: Boolean;
    chartindex: Natural;  -- used for the obj index  in   State obj.v = ...
    Tmp: Natural;
  begin
    --  Tutte le  Abstrction Rules hanno la forma:
    --
    --       leftside {and leftsize} -> rightside
    --
    if Kind = ActionKind then
      ----------------------------   ACTION ---------------------------------
      --
      --   First Rule_Left_Item
      --
      --  Assignments are observed at low level by
      --  $obj:assign(var,$value)  -> assign
      --  $obj:assign(var,$index,$value)  -> assign
      --  $obj:assign(var,$index,$index2,$value)  -> assign
      --
      --  $obj:assign($var,$value)  -> assign   #####  SHOULD BE AN ERROR!!!!
      --
      --  obj:target.foo(arg1)  ->  changed(foo,x)
      --  obj:accept(event,args) -> executed(evenet)
      --  obj:lostevent(event,args) -> discarded(event)
      --  target.foo(*,$1,$2,$*)      ->  afoo($1,$2,$*)
      --  foo(*,$1,$2,$*)      ->  afoo($1,$2,$*)
      --
      --  Secondary Rule_Left_Items
      --
      --   $1 releop  $2
      --   $1  relop literal
      --   literal relop $2
      --   literal relop literal
      --       (relop is   =, ==, /=, != )   -- MISSING  ">" e "<"
      --
      --    leftsideprefix   and
      --      leftside  ->
      --
      -- Parse term identifier or executing object
      --
      --  NON POSSIAMO PERMETTERE multiple src:target.obj rules  perche' la valutazione
      --  delle abstract labels (AbstractView) sarebbe molto piu' complessa e andrebbe
      --  riscritta ???????????
      --   I.e.   Action    obj1:tgt1.foo and obj1:tgt2.bar  ->  foobar
      --    both tgt1  and tgt2  should go into the unique  rule_elem.LPartner field.
      --
      if  Previous'Length =0  then
        --
        if   Next_Item =":" then
          This.LTerm := Tokens(Current_Token).Item;
          if  Current_Item = "$*" then
            Give_Error("3139  ""$*"" not allowed in this context.");
            raise Parsing_error;
          end if;
          Skip_Token;  -- obj:
          Skip_Token (":");
        end if;
        --
        --  parse event target
        if Next_Item ="." then
          This.LPartner := Tokens(Current_Token).Item;
          if  Current_Item = "$*" then
            Give_Error("3150  ""$*"" not allowed in this context.");
            raise Parsing_error;
          end if;
          Skip_Token;   -- target.
          Skip_Token (".");
        end if;
        --
        -- parse eventname and params
        if Next_Item = "(" or else
           Next_Item = "->" or else
           Next_Item =  "and" then
          This.LOp := Tokens(Current_Token).Item;
          if  Current_Item = "$*" then
            Give_Error("3163  ""$*"" not allowed in this context.");
            raise Parsing_error;
          end if;
          --  We want to allow   Action $1($2,$*) -> $1($2)
          --  but we must later check that $1 is actually associated to action event name!
--        if  Current_Item(1) not in 'a'..'z' and then Current_Item(1) not in 'Z'..'Z'  then
--          Give_Error("Error: signal identifier expected");
--          raise Parsing_error;
--        end if;
          Skip_Token;   -- foo (
          --
          --
          if This.LOp.all =  "assign"  and then Current_Item /= "(" then
            Give_Error("3176  Incorrect structure of assign rule");
            raise Parsing_error;
          end if;
          --
          -- parse event parameters
          if Current_Item ="(" then
            Skip_Token ("(");
            if (This.LOp.all = "discarded" or
                This.LOp.all =  "accept" or
                This.LOp.all =  "assign") and then
                Current_Item = "$*" then
              Give_Error("3187  ""$*"" not allowed in this context.");
              raise Parsing_error;
            end if;
            if ( This.LOp.all =  "assign") and then
                Current_Item(1) = '$' then
              Give_Error("3192  ""$vars"" not allowed in this context.");
              raise Parsing_error;
            end if;
            This.LArgs := new String_table'(Empty_String_Table);
            while Current_Item /= ")" loop
              if Current_Item(1) ='$' or else
                  Current_Item(1) in '0'..'9' or else
                  Current_Item(1) in 'a'..'z' or else
                  Current_Item(1) in 'A'..'Z' or else
                  Current_Item(1) ='*' then
                This.LArgs := new String_Table'(This.LArgs.all & Tokens(Current_Token).Item);
              else
                if Current_Item(1) = '[' then
                   Give_Error("3205 Error: vector literals not allowed in this context");
                   raise Parsing_Error;
                else
                   Give_Error("3208 Error: expecting '*' or '$var' or varname or simple literal");
                   raise Parsing_Error;
                end if;
              end if;
              Skip_Token;
            --   while Current_Item ="," or Current_Item ="[" or Current_Item ="]" loop
            --    Skip_Token;
              if Current_Item = "," and then Next_Item /= ")" then
                Skip_Token;
              elsif Current_Item /= ")" then
                 Give_Error("3218 Error: ',' or ')' expected");
                 raise Parsing_Error;
              end if;
            end loop;
            Skip_Token (")");
            if ( This.LOp.all =  "assign") then
              if This.LArgs.all'Length <2 then
                Give_Error("3225  Incorrect structure of assign rule");
                raise Parsing_error;
              else
                 MarK_Observed_Var(This.LArgs(1));
              end if;
            end if;
          end if;
        end if;  -- parse eventname and params
        --
        if This.LOp= null and This.LPartner = null and This.LTerm =null then
           Give_Error("3235 Error: Incorrect structure of abstraction rule: expecting '[src:][tgt.]event(args) [and $var relop expr]* ->  ...' ");
           raise Parsing_error;
        end if;
        --
        if Current_Item = "->" then
           return Previous & This;
           --
        elsif Current_Item = "and" then
          Skip_Token ("and");
          return Parse_Left_Side (Kind, Previous & This);
        else
           Give_Error("3246 Error: expectiong '->' or 'and' ");
           raise Parsing_error;
        end if;
        --
      end if; -- Previous.Length=0
      --
      -------------------------------------------------------------------
      --   NOW the parsing for the rule left following the first one
      --     (preceeded by "and" )
      --   All the variable names appearing here must be previously defined in Rule_Left(1)
      -------------------------------------------------------------------
      --  NOW: $var1 = 123  and  $var2 = $var3  (all vars defined)
      --  GOAL   $ defining realtions  $1[1][2] = $3  and  $1[$3] = $4 and ...
      -------------------------------------------------------------------
      --
      -- PARSE LEFT SIDE OF RELATION:  $1,  $1[1].length, $1[2].tail.[3].head
      --
      -------------------------------------------------------------------
      if Current_item(1) ='$' and then  not Has_Been_Defined(Current_item, Previous) then
        Give_Error("3265  """& Current_item &""" not defined");
        raise Parsing_error;
      elsif Current_item(1) /='$' and then Current_item(1) not in '0'..'9' and then
             Current_item(1) not in 'a'..'z' and then Current_item(1) not in 'a'..'z' then
        Give_Error("3269 Error:  expecting '$var' or 'basic literal'");
        raise Parsing_error;
      elsif (Current_item(1) in '0'..'9' or else
             Current_item(1) in 'a'..'z' or else Current_item(1) in 'a'..'z') and then
            (Next_item ="[" or else Next_item = "." or else
                    Next_item = "+"  or else Next_item = "-" ) then
        Give_Error("3275 Error:  only basic literals are allowed in this context ('literal relop expr')");
        raise Parsing_error;
      end if;
      This.IdsL := new String_Table'(1..1 => Tokens(Current_Token).Item);
      Skip_Token;  -- $var
      --
      -- parse optional indexings:  $1[1][2] =   $1[$3] =
    loop
      if Current_Item = "[" then
         Skip_Token; --'['
         if Current_Item(1) = '$' then
           -- check $var defined
           if not Has_Been_Defined(Current_Item, Previous) then
             Give_Error("3288  """& Current_Item & """ not defined");
             raise Parsing_error;
           else
             This.IdsL := new String_Table'(This.IdsL.all & Tokens(Current_Token).Item);
             Skip_Token;
           end if;
         elsif Current_Item(1) in '0'..'9' then
            --ok intger literal
            This.IdsL := new String_Table'(This.IdsL.all & Tokens(Current_Token).Item);
            Skip_Token;
         else
           Give_Error("3299 ERROR: expecting '$var' or numeric literal");
           raise Parsing_error;
         end if;
         Skip_Token("]");
        --
      elsif Current_Item = "." then
        Skip_Token;
        if Current_Item="head" or Current_Item="tail" or Current_Item="length" then
          This.IdsL := new String_Table'(This.IdsL.all & Tokens(Current_Token).Item);
          Skip_Token;
        else
          Give_Error("3310 Error:  .head .tail .length .min .max expected");
          raise Parsing_Error;
        end if;
      else
        exit;
      end if; -- "[" or "."
    end loop;
      --
      if Current_Item = "="  or else
         Current_Item = "==" then
           This.LeftOp := EQ;
           Skip_Token;
      elsif Current_Item = "!="  or else
         Current_Item = "/=" then
           This.LeftOp := NE;
           Skip_Token;
      elsif Current_Item = "<" then
           This.LeftOp := LT;
           Skip_Token;
      elsif Current_Item = ">"  then
           This.LeftOp := GT;
           Skip_Token;
      elsif Current_Item = "<=" then
           This.LeftOp := LE;
           Skip_Token;
      elsif Current_Item = ">=" then
           This.LeftOp := GE;
           Skip_Token;
      elsif Current_Item = "in" then
           This.LeftOp := ISIN;
           Skip_Token;
      else
         Give_Error("3342 Error: Unexpected binary operator " & Current_Item );
         raise Parsing_Error;
      end if;
      --
      --  ...=   $1[1][$2]  (with $1, $2 old)
      --  ...=   obj  null, [] , 123, -1, true false
      --  ...=   $var  (with $var new!!)
      --
      -------------------------------------------------------------------
      --
      -- PARSE RIGHT SIDE OF RELATION:  $1,  $1[1], $1[2][3], undefined
      --
      -------------------------------------------------------------------
      --
      if Current_Item(1)='$' and then Next_Item(1)='['  then
        --
        --  ...=   $1[1][$2]  (with $1, $2 old)
        --
        if Has_Been_Defined(Current_Item, Previous) then
          -- parse expression:  $1[...
          This.IdsR := new String_Table'(1..1 => Tokens(Current_Token).Item);
          Skip_Token;
          -- parse optional indexings:  $1[1][2]
          loop
            if Current_Item = "[" then
            Skip_Token; --'['
            if Current_Item(1) = '$' then
              -- check $var defined
              if not Has_Been_Defined(Current_Item, Previous) then
                Give_Error("  """& Current_Item & """ not defined");
                raise Parsing_error;
              else
                This.IdsR := new String_Table'(This.IdsR.all & Tokens(Current_Token).Item);
                Skip_Token;
              end if;
              --
            elsif Current_Item(1) in '0'..'9' then
              --ok integer literal
              This.IdsR := new String_Table'(This.IdsR.all & Tokens(Current_Token).Item);
              Skip_Token;
            else
              Give_Error("3383 ERROR: expecting '$var' or numeric literal");
              raise Parsing_error;
            end if;
            Skip_Token("]");
            --
              elsif Current_Item = "." then
              Skip_Token;
              if Current_Item="head" or Current_Item="tail" or Current_Item="length" then
                This.IdsL := new String_Table'(This.IdsL.all & Tokens(Current_Token).Item);
                Skip_Token;
              else
                Give_Error("3394 Error:  .head .tail .length .min .max expected");
                raise Parsing_Error;
              end if;
            else
              exit;
            end if; -- "[" or "."
          end loop;
          --
        else
          Give_Error("  """ & Current_Item & """ not defined");
          raise Parsing_error;
        end if;
        --  ...=   -123
      elsif Current_Item = "-" and then Next_Item(1) in '0'..'9' then
        Skip_Token;
        This.IdsR := new String_Table'
                (1..1 => new String'("-" & Tokens(Current_Token).Item.all));
        Skip_Token;
        --
      elsif Current_Item = "null" or
             Current_Item = "true" or
              Current_Item = "false" or
              Current_Item = "undefined" or
               Current_Item(1) in '0'..'9'  then
        This.IdsR := new String_Table'(1..1 => Tokens(Current_Token).Item);
        Skip_Token;
        --
      elsif Current_Item = "[" and then Next_Item="]" then
        This.IdsR := new String_Table'(1..1 => Tokens(Current_Token).Item);
        Skip_Token;
        This.IdsR := new String_Table'(This.IdsR.all & Tokens(Current_Token).Item);
        Skip_Token;
        --
      elsif Current_Item(1) = '$' then
        --  now $var  can be either new or old.
        This.IdsR := new String_Table'(1..1 => Tokens(Current_Token).Item);
        Skip_Token;
        --
      elsif Current_Item(1) in 'a'..'z' or else Current_Item(1) in 'A'..'Z' then
        -- check the item is a ChartName
        This.IdsR := new String_Table'(1..1 => Tokens(Current_Token).Item);
        Tmp :=0;
        for K in All_Charts.all'Range loop
          if This.IdsR(1).all = All_Charts(K).Name.all then
            Tmp :=K;
            exit;
          end if;
        end loop;
        if Tmp=0 then
          for K in All_Classes.all'Range loop
            for EE in All_Classes(K).ChartEvents.all'Range loop
              if This.IdsR(1).all = All_Classes(K).ChartEvents(EE).Name.all then
                Tmp :=K;
                exit;
              end if;
            end loop;
          end loop;
          if Tmp=0 then
            Give_Error("3452 ERROR:  object or token name (or event name) expected ...");
            raise Parsing_Error;
          end if;
        end if;
        Skip_Token;
      end if;
      --
      --
      if Current_Item = "->" then
        return Previous & This;
        --
      elsif Current_Item = "and" then
        Skip_Token ("and");
        return Parse_Left_Side (Kind, Previous & This);
        --
      else
        Give_Error("3468 ""and""  or ""->"" expected (action rules can at most be conjunctions)");
        raise Parsing_Error;
      end if;
      --
    end if; -- actionKind
    ---------------------------  END ACTION -----------------------------------
    --
    ----------------------------  STATE -----------------------------------
    --
    --  inState(obj.s1)  ->  ok($1)
    --
    --  obj.x = $1   and
    --  maxqueuesize=$1    obj.queuesize=$1
    --  $1 /= $2
    --  $1 <= $2
    --------  to be added ----------
    --  obj.y[0] > 10   and
    --  obj.y[$1][0] > obj2.y
    --  $1[$2][1] = $3
    --  $1.head = 123  and
    --  $1[3].length=3
    ----------
    --
    --  LEFT_RULE_HEAD = final || isState() || (Obj.svar || svar || $var) LEFT_RULE_TAIL
    --  LEFT_RULE_TAIL = ([..] ||  .length  || .head) LEFT_RULE_TAIL
    --
    if Current_Item = "final" then
      --
      --  LEFT_RULE_HEAD = final || ...
      --
      Skip_Token;
      This.IdsL := new String_Table'(1=> new String'("final"));
      --
      if Current_Item = "->" then
        return Previous & This;
      else
        Skip_Token ("and");
        return Parse_Left_Side (Kind, Previous & This);
      end if;
    end if;

    if Current_Item = "inState" or
       Current_Item = "InState" then
      --
      --  LEFT_RULE_HEAD = ... inState(obj,s1)/inState(s1)/inState(obj,s1) ...
      --
      Skip_Token;
      Skip_Token("(");
      This.LOp := Tokens(Current_Token).Item;   -- obj (or s1 if obj is implicit)
      --  check obj explicit  or implicit or error
      OK := False;
      for I in UML_Types.Active_Charts.all'Range loop
        if UML_Types.All_Charts(UML_Types.Active_Charts(I)).Name.all = This.LOp.all then
          OK := True;
          Skip_Token;  --obj
          if Current_Item = "." or else
            Current_Item = "," then
            Skip_Token;
          else
            Give_Error("3527 '.' or ',' expected");
            raise Parsing_Error;
          end if;
          exit;
        end if;
      end loop;
      if not OK then
      -- if only 1 active chart allow the omission of the chart name prefix
        if UML_Types.Active_Charts.all'Length=1 then
          OK := True;
          This.LOp := UML_Types.All_Charts(UML_Types.Active_Charts(1)).Name;
        else
          Give_Error("3539 Error in Abstraction expression: missing object prefix");
          raise Parsing_Error;
        end if;
      end if;
      --
      while Current_Item /=")" loop           --  top.S1.s2
        if This.LArgs =null then
          This.LArgs := new String_Table'(1..1 => Tokens(Current_Token).Item);
        else
          This.LArgs := new String_Table'(This.LArgs.all & Tokens(Current_Token).Item);
        end if;
        Skip_Token;
        if Current_Item ="." then
          Skip_Token;
        elsif Current_Item /=")"  then
          Give_error("3554  '.' or ')' expected)");
          raise Parsing_Error;
        end if;
      end loop;
      if This.LArgs = null then
         Give_Error("3559 Expecting 'inState(obj,statename)'");
         raise Parsing_Error;
      end if;
      Skip_Token (")");
      --
      if Current_Item = "->" then
         return Previous & This;
      else
        Skip_Token ("and");
        return Parse_Left_Side (Kind, Previous & This);
      end if;
    end if; -- inState()
    --
    -------------- RELATION --------------
    --  123 < obj.v
    --  obj.x = $1   and
    --  obj.y[0] > 10   and
    --  obj.y[$1].head[0] > obj2.y   and
    --  x, x[    when 1 implicit active object
    --  $1.head = 123  and
    --  $1.length=3
    --  obj.queuesize=$1
    --  //  removed maxqueuesize=$1
    --  $1 /= $2
    --  $1 <= $2
    --
    --  LEFT_RULE_HEAD =    ... (Obj.svar || svar || $var) LEFT_RULE_TAIL
    --
    if Current_Item="["  then   -- "["   emptyvector literal
--      if Next_Item = "]" then
--         This.IdsL := new String_Table'(This.IdsL.all & Tokens(Current_Token).Item);
--         Skip_Token;
--         This.IdsL := new String_Table'(This.IdsL.all & Tokens(Current_Token).Item);
--         Skip_Token;
--      else
        Give_Error("3594 Error:  vector literals not allowed in this context");
        raise Parsing_Error;
--      end if;
      --
    elsif Current_Item(1) = '$' then
      -- $var  as beginning  of left_side
      -- check that the $variable has been previous declared!!
      OK := False;
      for Index in Previous'Range loop
        if Previous(Index).LeftOp = EQ and then
           Previous(Index).IdsR.all'Length =1 and then
           Previous(Index).IdsR(1).all = Current_Item then
          OK := True;
          exit;
        end if;
      end loop;
      if not OK then
          Give_Error("3611 Found use of undefined $variable " & Current_Item);
          raise Parsing_Error;
      end if;
      This.IdsL := new String_Table'(This.IdsL.all & Tokens(Current_Token).Item);
      Skip_Token;
      --
    elsif Current_Item= "true" or Current_Item= "false" or Current_Item= "True" or Current_Item= "False" then
       -- this is just a boolean literal
       This.IdsL := new String_Table'(This.IdsL.all & Tokens(Current_Token).Item);
       Skip_Token;
       --
    elsif Current_Item(1) in '0'..'9' or else
          (Current_Item'Last >1 and then
           Current_Item(1)='-' and then
          Current_Item(2) in '1'..'9') then
      -- this is just a numeric literal
      This.IdsL := new String_Table'(This.IdsL.all & Tokens(Current_Token).Item);
      Skip_Token;
      --
    else
      -- check Current_Item is an active object name
      --   obj = ...
      --   obj.var = ...
      --   var =  ...  (1 object, implicit)
      declare
        isobjectname:Boolean := False;
      begin
        if Current_Item = "null" then
            isobjectname := True;
            chartindex :=0;
            This.IdsL := new String_Table'(This.IdsL.all & Tokens(Current_Token).Item);
            Skip_Token;
            --
        elsif Current_Item = "maxqueuesize" then
           This.IdsL := new String_Table'(1 => Tokens(Current_Token).Item);
           Skip_Token;
           chartindex :=0;
        else
          for Z in Active_Charts.all'Range loop
            if All_Charts(Active_Charts(Z)).Name.all = Current_Item then
              isobjectname := True;
              chartindex := Active_Charts(Z);
              This.IdsL := new String_Table'(This.IdsL.all & Tokens(Current_Token).Item);
              Skip_Token;  -- object name
              if Current_Item = "." then
                Skip_Token(".");
              end if;  -- Current_Item = "."
              exit;
            end if;
          end loop;
           --
          if not isobjectname then
            if Active_Charts.all'Length >1 then
              -- give_error
              Give_Error("3665 Error: Missing Object Name in class attribute selection.");
              raise Parsing_Error;
            elsif Active_Charts.all'Length =0 then
              -- give_error
              Give_Error("3669 Error: No active object declaration found !!!! ");
              raise Parsing_Error;
            else
              --  MISSING THE CHECK THAT  The var name actually denotes an existing class attribute!!
              --
              -- add implicit object name
              This.IdsL := new String_Table'(This.IdsL.all & All_Charts(Active_Charts(1)).Name);
              chartindex := Active_Charts(1);
            end if;
          end if;
        end if;
      end;
      --
      --  check  not obj[] null.  null[]
      if chartindex >0 and then
          (Current_Item(1) in 'a'..'z' or Current_Item(1) in 'A'..'Z') then
        --
        --  CHECK THAT  The var name actually denotes an existing class attribute!!
        --
        if Current_Item /= "queuesize" then
          OK := False;
          for K in All_Charts(chartindex).ChartVars.all'Range loop
             if Current_Item = All_Charts(chartindex).ChartVars(K).Name.all  then
               OK := True;
               exit;
             end if;
          end loop;
          if not OK then
             Give_Error("3697 Error: variable " & Current_Item & " not declared.");
             raise Parsing_Error;
          end if;
        end if;
        This.IdsL := new String_Table'(This.IdsL.all & Tokens(Current_Token).Item);
        Skip_Token; -- the  var name          --
      end if; -- not relational operator
      --
    end if;  -- $var or obj or literal
    --
    --  LEFT_RULE_TAIL = ([..] || .length || .head) LEFT_RULE_TAIL
    --
    loop
      if Current_Item = "[" then
        Skip_Token;
        if Current_Item(1) = '$'  then
          --  $index
          -- check that the $variable has been previous declared!!
          OK := False;
          for Index in Previous'Range loop
            if Previous(Index).LeftOp = EQ and then
               Previous(Index).IdsR.all'Length =1 and then
               Previous(Index).IdsR(1).all = Current_Item then
              OK := True;
              exit;
            end if;
          end loop;
          if not OK then
            Give_Error("3725 Found use of undefined variable " & Current_Item);
            raise Parsing_Error;
          end if;
          This.IdsL := new String_Table'(This.IdsL.all & Tokens(Current_Token).Item);
          Skip_Token;
        elsif Current_Item(1) in '0'..'9'  then
          This.IdsL := new String_Table'(This.IdsL.all & Tokens(Current_Token).Item);
          Skip_Token;  -- numerical index
        end if;  -- $ or number
        Skip_Token("]");
        --
      elsif Current_Item = "." then
        Skip_Token;
        if Current_Item="head" or Current_Item="tail" or Current_Item="length" 
          or Current_Item="min" or Current_Item="max" then
          This.IdsL := new String_Table'(This.IdsL.all & Tokens(Current_Token).Item);
          Skip_Token;
        else
          Give_Error("3743 Error:  '.head' '.tail' '.length' '.min' '.max' expected");
          raise Parsing_Error;
        end if;
      else
        exit;
      end if; -- "[" or "."
    end loop;
    -- RELATIONAL OP and RIGHT SIDE
    if Current_Item = "<=" then
       Skip_Token ("<=");
       This.LeftOp := LE;
    elsif Current_Item =  "!=" then
       Skip_Token ("!=");
       This.LeftOp := NE;
    elsif Current_Item = "/=" then
       Skip_Token ("/=");
       This.LeftOp := NE;
    elsif Current_Item = "==" then
       Skip_Token ("==");
       This.LeftOp := EQ;
    elsif Current_Item = ">=" then
       Skip_Token (">=");
       This.LeftOp := GE;
    elsif Current_Item = "=" then
       Skip_Token ("=");
       This.LeftOp := EQ;
    elsif Current_Item  = "<" then
       Skip_Token ("<");
       This.LeftOp := LT;
    elsif Current_Item  = ">" then
       Skip_Token (">");
       This.LeftOp := GT;
    elsif Current_Item  = "in" then
       Skip_Token ("in");
       This.LeftOp := ISIN;
    else
       Give_Error ("3783 Relational operator expected");
       raise Parsing_Error;
    end if;
    --
    ----------  PARSE RIGHT SIDE OF RELATION
    --  "[]"  at rigth side
    if Current_Item="["  then
      if Next_Item = "]" then
         This.IdsR := new String_Table'(This.IdsR.all & Tokens(Current_Token).Item);
         Skip_Token;
         This.IdsR := new String_Table'(This.IdsR.all & Tokens(Current_Token).Item);
         Skip_Token;
      else
        Give_Error("3792 Error:  vector literals not allowed in this context");
        raise Parsing_Error;
      end if;
    --
    --  "undefined" at right side
    elsif Current_Item = "undefined"  then
      This.IdsR := new String_Table'(This.IdsR.all & Tokens(Current_Token).Item);
      Skip_Token;
      --
    elsif Current_Item(1) = '$' then
      OK := False;
       for Index in Previous'Range loop
         if Previous(Index).LeftOp = EQ and then
             Previous(Index).IdsR.all'Length =1 and then
             Previous(Index).IdsR(1).all = Current_Item then
            OK := True;
            exit;
         end if;
       end loop;
       if not OK then
            if Next_Item(1)='[' or else Next_Item(1)='.' then
              Give_Error("3813 Found use of undefined $variable " & Current_Item);
              raise Parsing_Error;
            else
              -- this is a new dollarvar definition
              This.IdsR := new String_Table'(This.IdsR.all & Tokens(Current_Token).Item);
              Skip_Token;
            end if;
       else
         -- this is the HeadRight
         This.IdsR := new String_Table'(This.IdsR.all & Tokens(Current_Token).Item);
         Skip_Token;
       end if;
       --
    elsif Current_Item= "true" or Current_Item= "false" or  Current_Item= "True" or Current_Item= "False" then
       -- this is just a boolean literal
       This.IdsR := new String_Table'(This.IdsR.all & Tokens(Current_Token).Item);
       Skip_Token;
       --
    elsif Current_Item(1) in '0'..'9' or else
          (Current_Item'Last >1 and then
             Current_Item(1)='-' and then
               Current_Item(2) in '1'..'9') then
       -- this is just a numeric literal
       This.IdsR := new String_Table'(This.IdsR.all & Tokens(Current_Token).Item);
       Skip_Token;
       --
    else
       -- check Current_Item is an object name (active, Token , ...)
       --   obj = ...
       --   obj.var = ...
       --   var =  ...  (1 object, implicit)
       declare
         isactiveobjectname:Boolean := False;
       begin
         if Current_Item="null" then
             isactiveobjectname := True;
             chartindex :=0;
             This.IdsR := new String_Table'(This.IdsR.all & Tokens(Current_Token).Item);
             Skip_Token;
         else
           for Z in Active_Charts.all'Range loop
             if All_Charts(Active_Charts(Z)).Name.all = Current_Item then
               isactiveobjectname := True;
               chartindex := Active_Charts(Z);
               This.IdsR := new String_Table'(This.IdsR.all & Tokens(Current_Token).Item);
               Skip_Token;  -- object name
--               if Current_Item = "." then
--                 Skip_Token(".");
--               end if;  -- Current_Item = "."
               exit;
             end if;
           end loop;
         end if;
         if not isactiveobjectname and Current_Item = "." then
           if Active_Charts.all'Length >1 then
             -- give_error
             Give_Error("3869 Error: Missing Object Name in class attribute selection.");
             raise Parsing_Error;
           elsif Active_Charts.all'Length =0 then
             -- give_error
             Give_Error("3873 Error: No active object declaration found !!!! ");
             raise Parsing_Error;
           else
             --  MISSING THE CHECK THAT  The var name actually denotes an existing class attribute!!
             --
             -- add implicit object name
--             Skip_Token(".");
             This.IdsR := new String_Table'(This.IdsR.all & All_Charts(Active_Charts(1)).Name);
             chartindex := Active_Charts(1);
           end if;
         end if;
       end;
--       if Current_Item ="." then
--          Skip_Token(".");
--       end if;
       --
       if Current_Item  /= "->" and then
            Current_Item  /= "and"  and then
            chartindex >0 and then
            (Current_Item(1) in 'a'..'z' or 
             Current_Item(1) in 'A'..'Z' or
             Current_Item(1) = '.' ) then
         --
         --  CHECK THAT  The var name actually denotes an existing class attribute!!
         --
         if Current_Item ="." then --new
           Skip_Token(".");        --new
           OK := False;
           for K in All_Charts(chartindex).ChartVars.all'Range loop
            if Current_Item = All_Charts(chartindex).ChartVars(K).Name.all  then
              OK := True;
              exit;
            end if;
           end loop;
           if not OK then
            Give_Error("3908 Error: variable " & Current_Item & " not declared.");
            raise Parsing_Error;
           end if;
         end if;
         This.IdsR := new String_Table'(This.IdsR.all & Tokens(Current_Token).Item);
         Skip_Token; -- the  var name          --
       end if; -- not relational operator
       --
    end if;  -- $var or obj or literal
    --
    --  RIGHT_RULE_TAIL = ([..] || .length || .head) RIGHT_RULE_TAIL
    --
    loop
       if Current_Item = "[" then
         Skip_Token;
         if Current_Item(1) = '$'  then
           --  $index
           -- check that the $variable has been previous declared!!
           OK := False;
           for Index in Previous'Range loop
             if Previous(Index).LeftOp = EQ and then
                Previous(Index).IdsR.all'Length =1 and then
                Previous(Index).IdsR(1).all = Current_Item then
               OK := True;
               exit;
             end if;
           end loop;
           if not OK then
             Give_Error("3936 Found use of undefined variable " & Current_Item);
             raise Parsing_Error;
           end if;
           This.IdsR := new String_Table'(This.IdsR.all & Tokens(Current_Token).Item);
           Skip_Token;
         elsif Current_Item(1) in '0'..'9'  then
           This.IdsR := new String_Table'(This.IdsR.all & Tokens(Current_Token).Item);
           Skip_Token;  -- numerical index
         end if;  -- $ or number
         Skip_Token("]");
         --
       elsif Current_Item = "." then
         Skip_Token;
         if Current_Item="head" or Current_Item="tail" or Current_Item="length" 
            or Current_Item="min" or Current_Item="max" then  -- ADDED APRIL 1 2019
           This.IdsR := new String_Table'(This.IdsR.all & Tokens(Current_Token).Item);
           Skip_Token;
         else
           Give_Error("3954 Error: '.head' '.tail' '.length' '.max' '.min' expected");
           raise Parsing_Error;
         end if;
       else
         exit;
       end if; -- "[" or "."
    end loop;
    --
    if Current_Item = "->" then
      return Previous & This;
    else
       Skip_Token ("and");
       return Parse_Left_Side (Kind, Previous & This);
    end if;
    -----------------------------   END STATE --------------------------------
    --
  end Parse_Left_Side;



  procedure Check_Dollar (OP: Observation_Rule; D: String) is
    Found: Boolean;
  begin
         Found := False;
         for J in OP.Left.all'Range loop
           if OP.Left(J).LTerm /= null and then
               OP.Left(J).Lterm.all = D then
                 Found := true;
                 exit;
           end if;
           if OP.Left(J).LPartner /= null and then
               OP.Left(J).LPartner.all = D then
                 Found := true;
                 exit;
           end if;
           if OP.Left(J).LOp /= null and then
               OP.Left(J).LOp.all = D then
                 Found := true;
                 exit;
           end if;
           if OP.Left(J).LArgs /= null then
             for K in OP.Left(J).Largs.all'Range loop
               if OP.Left(J).Largs(K) /= null and then
                 OP.Left(J).Largs(K).all = D then
                   Found := true;
                   exit;
               end if;
             end loop;
           end if;
           if OP.Left(J).LeftOp /= NOOP and then
              OP.Left(J).IdsR /= null and then
              OP.Left(J).IdsR.all'Length=1 and then
              OP.Left(J).IdsR(1).all = D then
               Found := True;
           end if;
         end loop;
         if not Found then
           Give_Error("4011 Undefined variable " & D);
           raise Parsing_Error;
         end if;
  end Check_Dollar;

  ------------------------------------------------------------------------------------
   -- Observations {
   -- State:   is_active(obj,state) and obj.var=3  ->  label(op,op,1)
   -- State:   inState(obj.state) and obj.var=3  ->  label(op,op,1)
   -- State:   obj.var1 > obj.var2  ->  label(op,op,1)
   -- Action:  term:part.op!<$1,$2,*,a>   ->  label(op,$2,$1)
   -- $1:$2.$3!<>   ->  label(op,$2,$1)
   -- Action   foo($*)   ->  afoo($*)   -- all parameters are observed!!!
   -- Action    $1 -> $1    sould be alloweed!!!
   ------------------------------------------------------------------------------------
   -- MISSING CHECKS:   no duplicates  $v,   $* as last event arg
   ------------------------------------------------------------------------------------
-- Durante il parsing vengono generate 3 rules per  x=1 and y=2  and z=3  ->  fooo
-- State:   x=1  and  ...  con EMPTY_RIGHTSIDE verra' considerata una and-prefix-rule
-- State:   y=2  and ...   con EMPTY_RIGHTSIDE verra' considerata una and-prefix-rule
-- State:   z=3  -> foo    conclude la rule.
--
-- Durante la AbstractView, quando le rules vengono naviagate,
-- i dollarnames/dollarcount/dollarvectors  vengono resettati solo alla fine di una concluding rule
-- (opopure all'inizio di una rule che non sia stata precedura da una continuation rule).

   ------------------------------------------------------------------------------------
  function Parse_Observations(MyObservations: Observations_Table)
                      return Observations_Table  is

    OP: Observation_Rule;
    Empty_Left_Side: Rule_Left(1..0);
    Nesting: Natural;
  begin
    if Current_Item = "}" or  Current_Item = "" then
      return MyObservations;     ----  end of Observations { } section
    end if;
    --
    --  handle TRANSITION LABELS
    --
    if Current_Item ="TLABELS" then
        Observe_Transition_Labels := true;
        Skip_Token;
    end if;
    --
    --  Parse State or Action  rule qualifier
    --
    if Current_Item ="State" or
       Current_Item ="state" then
      OP.Kind := StateKind;
      Skip_Token;
    elsif Current_Item ="Action" or
          Current_Item ="action" then
      OP.Kind := ActionKind;
      Skip_Token;
       -- return MyObservations;-- ?????
    else
      Give_Error("4060 State or Action keyword expected");
      raise Parsing_Error;
    end if;
    if Current_Item = ":" then
      Skip_Token(":");
    end if;
    --
    --
    OP.Left := new Rule_Left'(Parse_Left_Side(OP.Kind, Empty_Left_Side));
    --
    Skip_Token ("->");
    --
    --
    --  removed because              Action $1:* -> $1   should be allowed
    --   at least until  the worse:  State O2.v= $1 -> $1  is allowed!!!
    --if Tokens(Current_Token).Item(1) ='$' then
    --    if Op.Kind=ActionKind and then
    --      Op.Left(1).LOp.all /= Tokens(Current_Token).Item.all then
    --      Give_Error("ERROR; only signal names or stringliterals can appear as main edge labels");
    --      raise Parsing_Error;
    --    end if;
    -- end if;
    OP.RLabels :=                    -- initial main label
      new String_Table'(OP.RLabels.all & Tokens(Current_Token).Item);
 -- REMOVE BECAUSE USELESS
--if Op.Kind= StateKind then
--     Abstract_Predicates :=
--       new String_Table'(Abstract_Predicates.all & Tokens(Current_Token).Item);
--  end if;
    Skip_Token;
    --
    if Current_Item = "(" then
      Skip_Token;
      Nesting :=0;
      while Current_Item /= ")" loop
        -- WE must disallow    $1[1], [1,2,3][2], $1.tail
        -- WE must allow  'name)' 'name,'   ' name]' '[name',
        -- I.E  '['    CANNOT FOLLOW a ']' or a name
        if Tokens(Current_Token).Item(1) ='$' then
            Check_Dollar(Op,Tokens(Current_Token).Item.all);
        end if;
        if Current_Item="." then
           --APRIL 1 2019
           Give_Error("4103 ERROR:   '.head' '.tail' '.length' '.max' '.min' not allowed in right side of rules");
           raise Parsing_Error;
        end if;
        if Current_Item ="[" then
            Nesting := Nesting+1;
          elsif Current_Item ="[" then
            if Nesting > 0 then
               Nesting := Nesting-1;
            else
              Give_Error("4112 ERROR:  unbalanced '[' ']' ???");
              raise Parsing_Error;
            end if;
        end if;
--        elsif Current_Item /= "$" or else
--            Next_Item /= "*"  then
        OP.RLabels := new String_Table'(OP.RLabels.all & Tokens(Current_Token).Item);
        --
        -- Items can be ']' '[' or 'names'  (',' alrady been eaten)
        --
        if Current_Item /= "[" and then Next_Item=  "[" then
        --  '['   CAN ONLY FOLLOW the initial '('  or ',' or '['
        --   ']['  ie error,  'id['  is error
        --
          Give_Error ("4126 ERROR:  indexing not allowed in right side of rules");
          raise Parsing_Error;
        end if;
        --
        --  can we check tht ',' is presente between two items?
        -- i.e. disallow   foo(aa bb [oo] [[]] [aa nn])
        -- We can force ',' or ')' or ']' to be present after a 'name'
        if Current_Item /= "[" and then
            Current_Item /= "]" and then
            Next_Item /= ")" and then
            Next_Item /= "]" and then
            Next_Item /= "," then
          Give_Error("4138 ERROR:  expecting ',' or ')' after '" & Current_Item & "'");
          raise Parsing_Error;
        end if;
        Skip_Token;   --  '['  ']'  'name'
        if Current_Item = "," then
          --  literal  .. number .. name .. token  ')' ']'
          Skip_Token;
        end if;
      end loop;
      --
      Skip_Token(")");
    end if;
    --
    Check_Observation(OP);
    --
    return Parse_Observations(MyObservations & OP);
  exception
   when Parsing_Error =>
     Parsing_Failed := True;
     if Parsing_Errors > 5 then
        raise;
     else
       while  Current_Item /= "" and then
          Current_Item /= "}"  and then
          Current_Item /= "State"  and then
          Current_Item /= "state"  and then
          Current_Item /= "Action" and then
          Current_Item /= "action" loop
         Skip_Token;
       end loop;
       if Current_Item /= "" and then Current_Item /=  "}" then
         return Parse_Observations(MyObservations & OP);
       else
         return MyObservations;
       end if;
     end if;
  end Parse_Observations;


 -----------------------------------------------------------
 -- This procedure recursively assigns to each state
 -- its position in the RunTimeState vector.
 -- The size of the RunTimeState is hence defined as the
 -- used highest position of a simple state, and corresponds
 -- to un upper bound of the degree of parallelism of the model
 --
 -- In the case of Composite or parallel states the FirstRuntimePosition
 --  indicates the runtimeposition of the first subleaf of the state
 -- In the case of Composite or parallel states the LastRuntimePosition
 --  indicates the maximum runtimeposition for any  subleaf of the state
 -- For Simple states FirstRuntimePosition = LastRuntimePosition.
 --
 -- (this allows to find the "Active Substate) of a generic state
 -- of depth N in th following way:
 --  Leaf: State_Ref := States_Table_Ref(This.FirstRuntimePosition);
 --  ActiveSubstate  :=  Leaf.Ancestors(N-1);
 -----------------------------------------------------------
 function Eval_Max_Parallelism_and_SetPositions (Current_Position: Positive;
			  Current_State: State_Ref) return Positive is
   Result : Positive := 1;
   Tmp: Positive := 1;
 begin
   case Current_State.Kind is
     when Simple =>
       Current_State.FirstRuntimePosition := Current_Position;
       Current_State.LastRuntimePosition := Current_Position;
     when Composite =>
       for I in Current_State.Substates.all'Range loop
	 Tmp :=
	  Eval_Max_Parallelism_and_SetPositions (
            Current_Position, Current_State.Substates(I));
	 if Tmp > Result then
	    Result := Tmp;
	 end if;
       end loop;
       Current_State.FirstRuntimePosition := Current_Position;
       Current_State.LastRuntimePosition := Current_Position+Result-1;
     when Parallel =>
       Tmp := Eval_Max_Parallelism_and_SetPositions(
           Current_Position, Current_State.Substates(1));
       for I in 2..Current_State.Substates.all'Length loop
	 Tmp := Tmp + Eval_Max_Parallelism_and_SetPositions(
                       Current_Position+Tmp, Current_State.Substates(I));
       end loop;
       Result := Tmp;
       Current_State.FirstRuntimePosition := Current_Position;
       Current_State.LastRuntimePosition := Current_Position+Result-1;
     end case;
   return Result;
 end Eval_Max_Parallelism_and_SetPositions;

 -- Given the pointer "This_RState", and the state "Current_State",
 -- updates the table pointed by This_RState by setting the reference
 --  to the Current_State in the correct position in the table.
 -- If the Current State is a composite state, navigates all its substates
 --  setting the reference to currently active substates in the appropriate
 --  positions of the table.
 --
 --  Compute_Mask.
 --
 procedure Local_Assign (Current_State: State_Ref;
			This_RState: States_Table_Ref) is
--    Region: State_Ref;
 begin
   case Current_State.Kind is
     when Simple =>
       This_RState(Current_State.FirstRuntimePosition) := Current_State;
     when Composite =>
       Local_Assign(Current_State.Substates(1),This_RState);
     when Parallel =>
       for I in Current_State.SubStates.all'Range loop
	 Local_Assign(Current_State.Substates(I),This_RState);
       end loop;
   end case;
 end Local_Assign;

  ------------------------------------------------------------------
  -- Give a transition, returns a runtime state in which the
  --  positions included in the range of the target REGION
  --  are properly defined in agreement with the target of the
  --  transition.
  --
  -- The target of a transitions is in general a tuple [s1, s2, ..]
  --
  -- For each state si in the target tuple:
  -- 1) the state 'si' is assigned to the result
  -- 2) for all the ancestors of 'si',
  --      which are descendents of the 'owner' of the transition
  --      which are parallel states,
  --      for all regions R of these ancestors which do NOT include
  --          any of target states sj of [s1, s2, ..]
  --        The region R is assigned to the result.
  ------------------------------------------------------------------
  function Compute_Mask (This_Transition: Transition_Ref)
	  return States_Table_Ref is
    Chart_Parallelism: Natural :=
	All_Classes(Current_Class).ChartStates(1).LastRunTimePosition;
    Result : States_Table_Ref := new States_Table(1..Chart_Parallelism);
    These_Target_States: States_Table := This_Transition.Target.all;
    Tmp: State_Ref;
    To_Be_Assigned : Boolean;
  begin
    for I in These_Target_States'Range loop
      Tmp :=  These_Target_States(I);
      Local_Assign(Tmp, Result);
      while Tmp /= This_Transition.Owner loop
	Tmp := Tmp.Parent;
	if Tmp.Kind = Parallel then
	 for J in Tmp.Substates.all'Range loop   -- for all regions
	   To_Be_Assigned := True;
	   for K in These_Target_States'Range loop
	     if IsNested (These_Target_States(K).all, Tmp.Substates(J).all) then
	       To_Be_Assigned := False;
	       exit;
	     end if;
	   end loop; -- for all taget states
	   if To_Be_Assigned then
	     Local_Assign (Tmp.Substates(J), Result);
	   end if;
	 end loop;  -- for all regions
	end if;
      end loop;  -- for all ancestrors
    end loop;  -- for all target states
    return Result;
  end Compute_Mask;


  procedure Check_States_Structure is
  begin
    for I in All_Classes(Current_Class).ChartStates.all'Range loop
      if All_Classes(Current_Class).ChartStates(I).FirstRuntimePosition =
	0 then
	 Put_Line (Current_Error,
	   "Syntax Error: State " &
	     All_Classes(Current_Class).ChartStates(I).fullname.all &
	      " not appearing as direct or indirect substate of " &
	    All_Classes(Current_Class).ChartStates(1).fullname.all);
	    raise Parsing_Error;
      end if;
    end loop;
  end Check_States_Structure;

  procedure Set_Interferences is
  begin
    null;
    All_Classes(Current_Class).ChartInterferences :=
       new BoolMat(1..All_Classes(Current_Class).ChartTransitions.all'length,
                      1..All_Classes(Current_Class).ChartTransitions.all'length);
  end Set_Interferences;


  procedure Compute_All_Masks is
    These_Transitions: Transitions_Table_Ref;
  begin
    Check_States_Structure;
    These_Transitions := All_Classes(Current_Class).ChartTransitions;
   for I in These_Transitions.all'Range loop
     These_Transitions(I).Mask := Compute_Mask(These_Transitions(I));
   end loop;
  end Compute_All_Masks;

  procedure Parse_Deferred_Declarations (Current_State: State_Ref) is
     This_Event: Event_Ref;
  begin
    if Current_item = "Defers" or else
       Current_item = "defers" then
      Skip_Token;   -- "Defers"
       if Current_Item  = ":" then
         Skip_Token;
       end if;
      loop
        This_Event := new Event;
        This_Event.Name := Parse_Id;
        if Current_Item ="(" then
          Skip_Token;
          This_Event.Params :=
            new EventVars_Table'(Parse_EventVars(No_EventVars));
          Skip_Token(")");
        else
          This_Event.Params := new EventVars_Table'(No_EventVars);
        end if;
        --
        Current_State.Deferred :=
           new Events_Table'(Current_State.Deferred.all & Find_Event(This_Event));
        --
        if Current_Item = ","  -- or Current_Item = ";"
        then
          Skip_Token;
        else
          exit;
        end if;
        if Current_Item = ";" then
          Skip_Token;
        end if;
      end loop;
    end if;
      -- all composite state inherit deferred states from the ancestors.
  end Parse_Deferred_Declarations;

  ------------------------------------
  --  State    Top.X.Y =  aa ,bb, ccc  Defers  hhh
  --  State    Top.X.Y =  aa(bb, cc) ,bb, ccc    -- new
  --  State    Top.X.Y =  R1[aa,bb], R2[aa,bb]   -- new
  --  State    Top.X.Y   Defers  hhh
  ------------------------------------
  procedure Parse_States is
    This_State_Name : String_Ref;
    First_Name: String_Ref;
    Current_State: State_Ref;
    Parent_State: State_Ref;
  begin
    if Current_Item = "Behavior" or else
       Current_Item = "behavior" or else
       Current_Item = "Behaviour" or else
       Current_Item = "behaviour" or else
       Current_Item = "Transitions" or else
       Current_Item = "transitions" then
       return;
       --Skip_Token;
       --if Current_Item = ":" then Skip_Token; end if;
    end if;
    while Current_Item = "State" or
          Current_Item = "state"  loop
      Skip_Token;
      This_State_Name := Parse_Composite_Name;
      --
      -- if it is just a deferred addition to an existing name hadle it.
      --
    if Current_Item = "Defers" or else
       Current_Item = "defers" then
      --
      Current_State := Lazy_Find_State(This_State_Name.all);
      Parse_Deferred_Declarations(Current_State);
      --
    else
      --
      All_Classes(Current_Class).Top_State_Num := 1;
      Skip_Token ("=");
      --  Check: Parent = null  =>  full_name without '.'
      --  TO BE DONE AT THE END FOR ALL_STATES
      --
      --  CREATE  a new unique State univoquely identified by the name "This_State_Name"
      --
      Current_State := Find_State(This_State_Name.all);
      if Current_State.Kind /= Simple then
        Give_Error("4423 Error: state " & This_State_Name.all & "  already defined.");
        raise Parsing_error;
      end if;
      --
      --  This_State is a GLOBAL variable so that further TRANSITION implicitly refers
      --   to substates of this_state
      --
      --  Now we start parsing the state structure.
      --
      if Next_Item = "," or Next_Item = "(" then
        Current_State.Kind := Composite;
        Parse_Substates_List(Current_State);
        --
      elsif Next_Item = "/" or Next_Item = "[" then
        Current_State.Kind := Parallel;
        Parse_Regions_List(Current_State);
         --
      else
        -- this is a composite state with just one nested stste
        --
        First_Name := Parse_Id;
        Current_State.Kind := Composite;
        Parent_State := Current_State;
        Current_State :=  Find_State(Parent_State.FullName.all & '.' & First_Name.all);
        Current_State.Parent := Parent_State;
        Current_State.Depth := Parent_State.Depth + 1;
        if Parent_State.Kind = Composite then
          Current_State.Priority := Parent_State.Priority + 1;
        elsif Parent_State.Kind = Parallel then
          Current_State.Priority := Parent_State.Priority;
        end if;
        Parent_State.SubStates := new States_table'(Parent_State.SubStates.all & Current_State);
        --
      end if;
      -- Finally, if present, we parse any deferred declarations ..
      --
      Parse_Deferred_Declarations(Current_State);
      --
     end if;
    end loop;
    --
  exception
     when others =>
      Parsing_Failed := True;
      if Parsing_Errors > 5 then
         raise;
      else
        while  Current_Item /= "" or else
             Current_Item /= "end" or else
             Current_Item /= "Behavior" or else
             Current_Item /= "behavior" or else
             Current_Item /= "Behaviour" or else
             Current_Item /= "behaviour" or else
             Current_Item /= "Transitions" or else
             Current_Item /= "transitions" or else
             Current_Item /= "Class" or else
             Current_Item /= "class" or else
             Current_Item /= "Objects" or else
             Current_Item /= "objects" loop
           Skip_Token;
        end loop;
     end if;
  end Parse_States;


  ---------------------------------------------------------------
  -- Called when Lazy_parsing flag is set after all transizions have been elaborated
  -- Identifies the concurrent structured of substates markign as concurrent those states which
  -- a) have no simple or pseudo substates
  -- b) have more than one composite substate
  -- c) are not owners of transitions UNLESS THEY ARE FORK OR JOIN
  ------------------------------------------------------
  procedure Recognize_Concurrency(TheState: State_Ref) is
    Is_Parallel: Boolean := True;
  begin
    if TheState.Kind = Simple then
       return;
    end if;
    if TheState.SubStates.all'Length > 1 then
       for I in TheState.SubStates.all'Range loop
         if TheState.SubStates(I).Kind = Simple then
           Is_Parallel := False;
           exit;
         end if;
       end loop;
    else
      Is_Parallel := False;
    end if;
    for J in All_Classes(Current_Class).ChartTransitions.all' Range loop
       if All_Classes(Current_Class).ChartTransitions(J).Owner = TheState  then
          -- WE DO NOT ALLOW INTER REGION TRANSITIOINS OF ANY KIND
          -- All_Classes(Current_Class).ChartTransitions(J).Source.all'Length =1 and then
          -- All_Classes(Current_Class).ChartTransitions(J).Target.all'Length=1 then
         Is_Parallel := False;
         exit;
       end if;
    end loop;
    if Is_Parallel then
      TheState.Kind := Parallel;
    end if;
    for I in TheState.SubStates.all'Range loop
       Recognize_Concurrency(TheState.SubStates(I));
    end loop;
    --  added since we allow fork lazy parsing with forks.
    --
    -- BUG BUG  local transitions of a parallel state
    --    are moved to the parent Composite state
    --  In this way we lose their parallel composition.
    -- We should keep then where they are and handle
    --   their parallel composition with
    --
    --if Is_Parallel and then TheState.Kind = Composite then
    --  TheState.Kind := Parallel;
    --  if TheState.parent.localtransitions.all'Length =0 and then
    --     TheState.localtransitions.all'Length >0 then
    --      Tmp:= TheState.parent.localtransitions;
    --      TheState.parent.localtransitions := TheState.localtransitions;
    --      TheState.localtransitions := Tmp;
    --  elsif TheState.parent.localtransitions.all'Length >0 and then
    --     TheState.localtransitions.all'Length >0 then
    --      Tmp:= TheState.parent.localtransitions;
     --     TheState.parent.localtransitions :=
     --        new Transitions_Table'(Tmp.all & TheState.localtransitions.all);
     --     TheState.localtransitions := new Transitions_Table(1..0);
     -- end if;
    -- end if;
    --
    -- CHECK THAT REGIONS DO NOT APPEAR AS SOURCE OR TARGET OF TRANSITIONS.
    -- CHECK THAT FORKS TARGET DIFFERENT REGION OF THE SAME PARALLEL STATE
    -- CHECK THAT JOIN ORIGINATE FROM DIFFERENR SOURCES OF THE SAME PARALLEL STATE
   end Recognize_Concurrency;

  --------------------------------------
  --
  --  Parse the local declarations of the Current Class or Chart
  --
  --------------------------------------
  procedure Parse_Class_Body (This_Class_Name:String_Ref; 
                              Prev_Comments: String_Table_Ref := Empty_String_Table_Ref) is
    Max_Parallelism: Natural := 0;
    This_Class: Chart;
    Progress: Natural :=0; -- signals, operations, vars, state transitions end class
    isnice: Boolean := False;
    israndom: Boolean := False;
  begin
    if Current_Item = "with" then
      Skip_Token;
      while To_Lower(Current_Item) /= "is" loop
        if To_Lower(Current_Item) = "niceparallelism" then
          isnice := True;
          Skip_Token;
          if Current_Item="," then Skip_Token; end if;
        elsif To_Lower(Current_Item) = "randomqueue" then
          israndom := True;
          Skip_Token;
          if Current_Item="," then Skip_Token; end if;
        else 
          Give_Error("4579  ""niceparallelism""or ""randomqueue"" expected");
          raise PArsing_Error;
        end if;
      end loop;
    end if;
    if Current_Item = "is" then
      Skip_Token;
    end if;
    --
    -- check this is not a duplicate
    --
    Current_Class:= Find_Class(This_Class_Name.all);
    if Current_Class = 0 then
      Current_Class := All_Classes.all'Length +1;
      All_Classes := new Chart_Table'(All_Classes.all & This_Class);
      All_Classes(Current_Class).Name := This_Class_Name;
      All_Classes(Current_Class).Comms := Prev_Comments;
    elsif All_Classes(Current_Class).Top_State_Num > 0 then
      Give_Error ("4596 Error: Chart " & This_Class_Name.all &
		    " already defined!");
      Parsing_Failed := True;
      if Parsing_Errors > 5 then
         raise Parsing_Error;
      else
        Parsing_Failed := True;
        Parsing_Errors := Parsing_Errors+1;
        while Current_Item /= "" or else
             Current_Item /= "Class" or else
             Current_Item /= "class" or else
             Current_Item /= "Objects" or else
             Current_Item /= "objects" loop
          Skip_Token;
          -- continue the parsing from the next Class or obejct Decl
        end loop;
     end if;
    end if;
    -- Top_State_Num=-1  indice un class place_holder
    All_Classes(Current_Class).Top_State_Num := 0;
    All_Classes(Current_Class).NiceParallelism := isnice;
    All_Classes(Current_Class).IsRandom := israndom;
      --
      --  Top_State_Num=0 indica una classe passiva (senza transizioni),
      --  eventualmente una classe con solo attributi pubblicamente accessibili,
      --  che e' eventualmente possibile estendere in un tempo successivo con un body.
      --  (che puo aggiungere nuovi attributi e nuovo behavior)
      -- Top_State_Num=1 indica una classe di cui e' stato definito il body
      --   e quindi la cui definizione e' congelata.
    --
    -------  START THE MAIN TOP_DECL PARSING SEQUENCE --------
    ----  after the loop we perfomrm some final checking & update
    --
    -- Parse the event Declarations (if any)
    --    Signals;
    if Current_Item = "Signals" or else
       Current_Item = "signals"  then
        Progress :=1;
        Parse_Signals;
    end if;
    --
    if Current_Item = ""  or else
       Current_Item = "Chart" or else
       Current_Item = "chart" or else
       Current_Item = "Class" or else
       Current_Item = "class" then
       return;
    elsif Current_Item = "end" then
      Skip_Token;
      if Current_Item = ";" then
         Skip_Token;
      elsif Current_Item = All_Classes(Current_Class).Name.all  then
        Skip_Token;
        if Current_Item = ";" then
          Skip_Token;
        end if;
      else
        Give_Error ("4653 Class Name mismatch in ""end"" clause");
        raise Parsing_Error;
      end if;
      return;
    end if;
    --
    if Current_Item = "Operations" or
       Current_Item = "operations" then
      Progress := 2;
      Parse_Operations;
    end if;
    --
    if Current_Item = "Vars" or
       Current_Item = "vars" then
       Progress := 3;
      Parse_Vars;
    end if;
    if Current_Item = "Signals" or
       Current_Item = "signals" or
       Current_Item = "Operations" or
       Current_Item = "operations" or
       Current_Item = "Vars" or
       Current_Item = "vars" then
      Give_Error("4676 Error: misplaced Vars section?");
      Parsing_Failed := True;
        if Parsing_Errors > 5 then
           raise Parsing_Error;
        else
          Parsing_Failed := True;
          Parsing_Errors := Parsing_Errors+1;
          while Current_Item /= "" and then
            Current_Item /= "Class" and then
             Current_Item /= "class" and then
             Current_Item /= "Objects" and then
             Current_Item /= "objects" loop
            Skip_Token;
          end loop;
        end if;
    end if;
    --
    -- parse the states
    --
    Parse_States;
    --
    Parse_Transitions;
    --
    if Flags.Lazy_Parsing or Flags.Almost_Lazy_Parsing then
       -- Recognize COncurrent States as those with only multiple composite
       -- substates and not owning any transitions.
       --Recognize_Concurrency(TheStare: State_Ref);
       if All_Classes(Current_Class).ChartStates.all'length >0 then
         Recognize_Concurrency(All_Classes(Current_Class).ChartStates(1));
       else
          Give_Error("4706 Error:  Active class without transitions ??? ");
          raise Parsing_Error;
       end if;
    end if;
    --
    if All_Classes(Current_Class).Top_State_Num = 0 then
        if Progress = 2 then
          Give_Error("4713 Error: ""Vars"" or ""State"" expected here");
        elsif Progress =3 then
         Give_Error("4715 Error: ""State"" or ""Transitions"" expected here");
        end if;
        Parsing_Failed := True;
        if Parsing_Errors > 5 then
           raise Parsing_Error;
        else
          Parsing_Failed := True;
          Parsing_Errors := Parsing_Errors+1;
          while Current_Item /= "" and then
            Current_Item /= "Class" and then
             Current_Item /= "class" and then
             Current_Item /= "Objects" and then
             Current_Item /= "objects" loop
            Skip_Token;
          end loop;
        end if;
    end if;


    for I in All_Classes(Current_Class).ChartStates.all'Range loop
       Load_Outgoing_Catalogues (All_Classes(Current_Class).ChartStates(I));
    end loop;

    for I in All_Classes(Current_Class).ChartStates.all'Range loop
      if All_Classes(Current_Class).ChartStates(I).fullname.all'last > 8 and then
          All_Classes(Current_Class).ChartStates(I).fullname(
            All_Classes(Current_Class).ChartStates(I).fullname.all'last - 7  ..
            All_Classes(Current_Class).ChartStates(I).fullname.all'last) = ".initial" and then
         (All_Classes(Current_Class).ChartStates(I).OutgoingTransitions = null or else
           All_Classes(Current_Class).ChartStates(I).OutgoingTransitions.all'Length = 0) then
         Give_Error ("4745 Missing transition for default initial state");
         raise parsing_error;
      end if;
    end loop;
    --
    Set_Ancestors;
    Set_Finals;
    Max_Parallelism :=
      Eval_Max_Parallelism_and_SetPositions  (
         1,All_Classes(Current_Class).ChartStates(1) );
    Compute_All_Masks;
    Set_Interferences;
     --
     if Parsing_Errors > 0 then
        raise Parsing_Error;
     end if;
  exception
   when others =>
     Parsing_Failed := True;
     if Parsing_Errors > 5 then
        raise Parsing_Error;
     else
       while  Current_Item /= "" and then
          Current_Item /= "Class"  and then
          Current_Item /= "class"  and then
          Current_Item /= "Objects" and then
          Current_Item /= "objects" loop
        Skip_Token;
        end loop;
     end if;
  end Parse_Class_Body;

  procedure Set_Finals is
    Tmp: State_Ref;
    Tmp_Finals: States_Table_Ref;
    Tmp_States: States_Table_Ref;
    C: Natural := Current_Class;
  begin
    Tmp_States := All_Classes(C).ChartStates;
    for I in Tmp_States.all'Range loop
       Tmp:= Tmp_States(I);
       if Tmp.Kind = Composite then
	  for J in Tmp.SubStates.all'Range loop
	     if Is_Final(Tmp.SubStates(J)) then
	       Tmp.Finals := new States_Table'(1..1 => Tmp.SubStates(J));
	       exit;
	     end if;
	  end loop;
       end if;
       --
       if Tmp.Kind = Parallel then
	 Tmp_Finals := new States_Table(1..Tmp.SubStates.all'Length);
	 -- for all regions
	 for J in Tmp.SubStates.all'Range loop
	    for K in Tmp.Substates(J).Substates.all'Range loop
	       if Is_Final(Tmp.Substates(J).Substates(K)) then
		  Tmp_Finals(J) := Tmp.Substates(J).Substates(K);
		  exit;
	       end if;
	    end loop;
	    if Tmp_Finals(J) = null then
		Tmp_Finals := null;
		exit;
	    end if;
	 end loop;
	 Tmp.Finals := Tmp_Finals;
       end if;
    end loop;
  end Set_Finals;


  procedure Set_Ancestors is
    Depth: Positive;
    These_Ancestors: States_Table_Ref;
    Tmp: State_Ref;
    C: Natural;
    Tmp_States : States_Table_Ref;
  begin
     C := Current_Class;
     Tmp_States := All_Classes(C).ChartStates;
     for I in Tmp_States.all'Range  loop
       Depth := Tmp_States(I).Depth;
       These_Ancestors := new States_Table(1..Depth);
       These_Ancestors(Depth) := Tmp_States(I);
       Tmp:= Tmp_States(I);
       for J in reverse 1..Depth-1 loop
	  Tmp := Tmp.Parent;
	  These_Ancestors(J):= Tmp;
       end loop;
       Tmp_States(I).Ancestors := These_Ancestors;
     end loop;
  end Set_Ancestors;
  ---

  procedure Check_Missing_Definitions is
    Tmp_States: States_Table_Ref;
  begin
   --
   for C in All_Charts.all'Range loop
     if All_Charts(C).ChartParent = 0 THen
       Put_Line(Current_Error,
          "#### Error: at line " & Integer'Image(-All_Charts(C).Top_State_Num) & ": " &
          " Missing declaration for entity: """ & All_Charts(C).Name.all & """");
       Parsing_Failed := True;
       if Parsing_Errors > 5 then
         raise Parsing_Error;
       end if;
     end if;
      --
      --  instead of giving an error, we might consider these as implicit Token Objects.
      -- notice however, that in this way if there is really a missing active object declalation
      -- we will generate loss of events or deadlocks at runtime.
      -- We should give the error if the prefetched object is supposed to be active
      --  i.e.  is target of signals or calls.  But this is hard to be statically checked
      -- problem:  { - / obj1.sendsignal(undefined)}  ...   {sendsignal(x) / y :=x;   y.foo}
      --  we might request:
      --      for any signal/call action   x.foo, the class of x should be DEFINED explicitly
      --      but this is not sufficient ...
      --      a second pass check of all actions is needed to check the consstency of all used of undefined names
      --  All_Charts(C).ChartParent := TokensChart.ChartParent; -- 3 index in all_classes
      -- for all uses of implicit tokens, their names should not appear
      --    in assign not to token vars
      --    in target of events
      --    in not simple uml expressions (apart relations aa=bb) ,
      --    in int bool or obj expressions
   end loop;
   --
   for C in All_Classes.all'Range loop
     if All_Classes(C).Top_State_Num  <0 then
       Put_Line(Current_Error,
                  "Error: Missing class definition for type """ & All_Classes(C).name.all & """");
       Parsing_Failed := True;
       if Parsing_Errors > 5 then
         raise Parsing_Error;
       end if;
     end if;
   end loop;
   --
   for C in All_Classes.all'Range loop
     Tmp_States := All_Classes(C).ChartStates;
    for I in  Tmp_States.all'Range loop
      if Tmp_States(I).Parent = null then
         for J in Tmp_States(I).FullName.all'Range loop
            if Tmp_States(I).FullName(J) = '.' then
               Put_Line(Current_Error,
                 "Error: Missing or incomplete definition of the " &
                 "parent of state: " & Tmp_States(I).FullName.all);
              Parsing_Failed := True;
              if Parsing_Errors > 5 then
                raise Parsing_Error;
              end if;
            end if;
         end loop;
      end if;
    end loop;
   end loop;
   --
   -- we should check if we send a signal to an object which does
   --  not declare it. !!!!!
   -- This should be a runtime-check?????? (since the target is dynamic!?!?!)
   -- The check should be done based on the target-type. !!!!
   -- this means a lot of changes ...

  -- We check that, for all events declared and used inside signal actions, they
  --  are actually declared by some class (this does not mean that it is declared in the
  --   correct target class ..)
  --
  for C in All_Events.all'Range loop
    if All_Events(C).Kind = Undefined then
       Put_Line(Current_Error, "Error: Missing declaration for event """ &
         All_Events(C).Name.all & """ ");
       Parsing_Failed := True;
       if Parsing_Errors > 5 then
         raise Parsing_Error;
       end if;
    end if;
  end loop;

  --
  --  if priorities are enabled, check if an active object has "priority" as
  --   first or second attribute.
  --
  if Priorities_Enabled then
      Priorities_Defined := False;
      for I in Active_Charts.all'Range loop
        if All_Charts(Active_Charts(I)).ChartVars.all'Length >0 and then
           All_Charts(Active_Charts(I)).ChartVars(1).Name.all = "Priority"  then
           Priorities_Defined := True;
           exit;
        elsif All_Charts(Active_Charts(I)).ChartVars.all'Length >1 and then
           All_Charts(Active_Charts(I)).ChartVars(2).Name.all = "Priority"  then
           Priorities_Defined := True;
           exit;
        end if;
      end loop;
  end if;

  end Check_Missing_Definitions;


  procedure Load_Outgoing_Catalogues (This_State: State_Ref) is
     These_Outgoing: Transitions_Table
          (1..This_State.LocalTransitions.all'Length) :=
                          This_State.LocalTransitions.all;
     OutGoing_Count: Natural;
     This_Substate: State_Ref;
     This_Transition: Transition_Ref;
  begin
     if This_State.SubStates= null then
       return;
     end if;
     for I in This_State.SubStates.all'Range loop
       This_Substate := This_State.Substates(I);
       OutGoing_Count :=0;
       --
       -- Select outgoing transitions for the substate.
       -- The transitions to be selected are those whose
       --  first source is (o is nested inside) This_Substate;
       --
       for J in This_State.LocalTransitions.all'Range loop
         This_Transition := This_State.LocalTransitions(J);
         if This_Transition.Source(1) = This_Substate or else
            IsNested (This_Transition.Source(1).all, This_Substate.all) then
            OutGoing_Count := OutGoing_Count +1;
            These_Outgoing(OutGoing_Count) := This_Transition;
         end if;
       end loop;
       --
       -- build its catalogue;
     This_Substate.OutgoingTransitions :=
            Build_Outgoing_Catalogue(These_Outgoing(1..OutGoing_Count));
     end loop;
  end Load_Outgoing_Catalogues;

  ---------------------------------------------------------
  -- allowed Event names are:
  --   123, aaa, bbBB, a_b_c, _abc
  ---------------------------------------------------------
  function Parse_Id return String_Ref is
    TheId: String_Ref;
  begin
    if Tokens(Current_Token).Kind = Id then
      TheId := Tokens(Current_Token).Item;
      Skip_Token;
      return TheId;
    else
      Give_Error ("4991 Identifier Expected");
      raise Parsing_Error;
    end if;
  end Parse_Id;


  -- Called by Create_Object_Instance, Parse_SimpleExpr
  function Find_Var(Prefix:String) return Natural is
    Result: Natural := 0;
    TheseVars: Vars_Table_Ref := All_Classes(Current_Class).ChartVars;
    This_Var: SystemVar_Ref;
  begin
    for I in TheseVars.all'Range loop
      if TheseVars(I).all.Name.all = Prefix then
         Result := I;
         exit;
      end if;
    end loop;
    if Result = 0 and then
       Flags.Lazy_Parsing and then
       Prefix(Prefix'First) not in 'A'..'Z' then
      --
      --  in LAZY_PARSING mode when we find an undeclared use of "x" we declare it
      --  if we find a use of "X" we do not declare it since it is supposed to be an object
      --
      This_Var := new SystemVar;
      This_Var.Chart := Current_Class;
      This_Var.Name := new String'(Prefix);
      This_Var.Local_Num_Key := TheseVars.all'Length+1;
      All_Classes(Current_Class).ChartVars := new Vars_Table'(TheseVars.all & This_Var);
      --
      -- when called by Create_object_Instance  "Obj: Class (x -> 3)" if x in Undeclared
      -- we should add the vars also to all the already created objects
      -- the var is introduced in the current_object by Create_Object_Instance
      --
      if Current_object /= 0 then
        for I in All_Charts.all'Range loop
           if All_Charts(I).ChartParent = Current_Class and then
                All_Charts(I).ChartVars.all'Length = This_Var.Local_Num_Key-1 then
             This_Var := new SystemVar'(This_Var.all);
             This_Var.Chart := I;
             All_Charts(I).ChartVars :=
               new Vars_Table'(All_Charts(I).ChartVars.all & This_Var );
           end if;
        end loop;
      end if;
      Result := This_Var.Local_Num_Key;
    end if;
    return Result;
  end Find_Var;

  function Find_SystemVar(Prefix:String) return Natural is
    Result: Natural := 0;
    TheseVars: Vars_Table_Ref := All_Classes(Current_Class).ChartVars;
    This_Var: SystemVar_Ref;
  begin
    for I in TheseVars.all'Range loop
      if TheseVars(I).all.Name.all = Prefix then
         Result := I;
         return Result;
      end if;
    end loop;
    if Flags.Lazy_Parsing then
      This_Var := new SystemVar;
      This_Var.Chart := Current_Class;
      This_Var.Name := new String'(Prefix);
      This_Var.Local_Num_Key := TheseVars.all'Length+1;
      All_Classes(Current_Class).ChartVars := new Vars_Table'(TheseVars.all & This_Var);
      Result := This_Var.Local_Num_Key;
    end if;
    return Result;
  end Find_SystemVar;

  function Find_TVar (Prefix: String; TEnv: EventVars_Table_Ref) return Integer is
    Result: Natural := 0;
  begin
    for I in TEnv.all'Range loop
      if TEnv(I).all.Name.all = Prefix then
         Result := I;
         exit;
      end if;
    end loop;
    return Result;
  end Find_TVar;

  function Parse_Int_Token return String is
    Is_Negative_Literal: Boolean := False;
  begin
    if Tokens(Current_Token).Kind = Num then
      Current_Token := Current_Token +1;
      return Tokens(Current_Token-1).Item.all;
    end if;
    if Current_Item = "-" and then
       Tokens(Current_Token+1).Kind = Num then
      Current_Token := Current_Token +2;
      return "-" & Tokens(Current_Token-1).Item.all;
    end if;
     Give_Error ("5088 Parsing Error while looking for a int literal");
     raise Parsing_Error;
  end Parse_Int_Token;


  function Is_Number (Token: String) return Boolean is
  begin
    if Token(Token'First) /= '-' then
      for I in Token'Range loop
        if Token(I) not in '0'..'9' then
           return False;
        end if;
      end loop;
      return True;
    elsif Token'Length >1 then
      for I in Token'First+1 .. Token'Last loop
        if Token(I) not in '0'..'9' then
         return False;
        end if;
      end loop;
      return True;
    else
      return False;
    end if;
  end Is_Number;

  ---------------------------------------------------------------------
  --  SimpleIntExpr is
  --       Literal_Value: Integer :=0;
  --       Image: String_Ref;
  --       Local_Variable: Natural :=0 ;   -- ChartVars(E.Local_variable) = V
  --       Target_Object: Natural :=0;     ---   targerobj.remoreattr
  --       Event_Variable: EventVar_Ref;
  --       Remote_Variable: Natural :=0;     ---  localvar.remotevar  ,  eventvar.remotevar
  --       Special_Token: String_Ref;
  --       Kind: Value_Kind := Number;    -- Number, Composite, ...???
  --       Is_Vector: SimpleIntExpr_Table_Ref;
  --       Is_Indexing: IntExpr_Table_Ref;          -- indexing
  --       Head_Tail_Data : SimpleIntExpr_Ref;   --- added 30-06-2016
  ---------------------------------------------------------------------
  function Parse_SimpleExpr(Env: EventVars_Table; In_FunctCall: Boolean := False) 
        return SimpleIntExpr_Ref is
     This_Simple: SimpleIntExpr_Ref := new SimpleIntExpr;
     Tmp: SimpleIntExpr_Ref;
     Tmpv: Int_Table_Ref;
     This_Item: String := Current_Item;
     This_Index:IntExpr_Ref;
  begin
    Skip_Token;   --(This_Item=Curent_Item)
    --
    --   [x,y,z]    VECTOR LITERAL
    --
    --       since v := [[1,2], [3,4]]  is OK  (nested vectors)
    --        WHAT ABOUT v[2][1]   (nested indexing)
    if This_Item = "["  then
     This_Simple.Kind := Composite;  -- for now  we will see later the kind of vector
     This_Simple.Is_Vector := new SimpleIntExpr_Table(1..0);
     This_Simple.Image := new String'("[");
     while Current_Item /= "]" loop
       Tmp := Parse_SimpleExpr(Env);
       if Tmp.Kind = Number then
           This_Simple.Kind:= Numvector;
       elsif Tmp.Kind = Object then
           This_Simple.Kind:= Objvector;
       elsif Tmp.Kind = Bool then
           This_Simple.Kind:= Boolvector;
       elsif Tmp.Kind = Numvector then
           This_Simple.Kind:= Nummatrix;
       elsif Tmp.Kind = Objvector then
           This_Simple.Kind:= Objmatrix;
       elsif Tmp.Kind = Boolvector then
           This_Simple.Kind:= Boolmatrix;
       elsif Tmp.Kind = Nummatrix then
           This_Simple.Kind:= Numcube;
       elsif Tmp.Kind = Objmatrix then
           This_Simple.Kind:= Objcube;
       elsif Tmp.Kind = Boolmatrix then
           This_Simple.Kind:= Boolcube;
       end if;
       This_Simple.Is_Vector := new SimpleIntExpr_Table'(This_Simple.Is_Vector.all & Tmp);
       This_Simple.Image := new String'(This_Simple.Image.all & Tmp.Image.all);
       if Current_Item = "," then
           Skip_Token;
           This_Simple.Image := new String'(This_Simple.Image.all & ",");
       elsif Current_Item /= "]" then
           Give_Error("5173 Error:   ',' or ']' expected");
           raise Parsing_Error;
       end if;
     end loop;
      Tmpv := new Int_Table(This_Simple.Is_Vector.all'Range);
      for I in This_Simple.Is_Vector.all'Range loop
        Tmpv(I) := This_Simple.Is_Vector(I).Literal_Value;
      end loop;
      This_Simple.Literal_Value := StructBase - Vectors_DB.NickNum(Tmpv.all);
      Skip_Token; -- "]"
      This_Simple.Image := new String'(This_Simple.Image.all & "]");
      if Current_Item = "[" then
        Give_Error("5185 Indexing not allowed in this context.");
        raise Parsing_Error;
      end if;
      if Current_Item = "." then
        Give_Error("5189 function calls not allowed in this context.");
        raise Parsing_Error;
      end if;
      return This_Simple;
      -- do not allow   [1,2,3].tail or [1,2,3][1]
    end if;
    --
    --  "0"  "1"  "2" ..     NUMBER LITERAL
    --
    if Is_Number(This_Item) then
      This_Simple.Literal_Value := Integer'Value(This_Item);
      This_Simple.Image := new String'(This_Item);
      This_Simple.Kind := Number;
      if Current_Item = "[" then
        Give_Error("5203 Indexing not allowed in this context.");
        raise Parsing_Error;
      end if;
      if Current_Item = "." then
        Give_Error("5207 function calls not allowed in this context.");
        raise Parsing_Error;
      end if;
      return This_Simple;
    end if;

    if This_Item= "-" and then
       Is_Number(Current_Item) then
      This_Simple.Literal_Value := -Integer'Value(Current_Item);
      This_Simple.Image := new String'("-" & Current_Item);
      This_Simple.Kind := Number;
      Skip_Token;
      if Current_Item = "[" then
        Give_Error("5220 Indexing not allowed in this context.");
        raise Parsing_Error;
      end if;
      if Current_Item = "." then
        Give_Error("5224 function calls not allowed in this context.");
        raise Parsing_Error;
      end if;
      return This_Simple;

    end if;
    --
    --  "null"       NULL OBJECT
    --
     if This_Item = "null"  or This_Item = "Null" or This_Item = "NULL" then
        This_Simple.Special_Token := new String'("null");
        This_Simple.Image := new String'(This_Item);
        This_Simple.Kind := Object;
        This_Simple.Literal_Value := NullObject.Simple.Literal_Value;
        return This_Simple;
     end if;
    --
    -- "self"      SELF OBJECT
    --
     if This_Item = "self"  or This_Item = "Self" or This_Item = "SELF" then
        This_Simple.Special_Token := new String'("self");
        This_Simple.Image := new String'(This_Item);
        This_Simple.Kind := Object;
        This_Simple.Literal_Value := -1;   --NEW for correct ActionImage 
      if Current_Item = "[" then
        Give_Error("5249 Indexing not allowed in this context.");
        raise Parsing_Error;
      end if;
--      if Current_Item = "." then
--        self.mysignal  is OK
--        Give_Error(".selection not allowed in this context.");
--        raise Parsing_Error;
--      end if;
         return This_Simple;
      end if;
    --
    -- "this"      THIS OBJECT
    --
     if This_Item = "this"  or This_Item = "This" or This_Item = "THIS" then
        This_Simple.Special_Token := new String'("this");
        This_Simple.Image := new String'(This_Item);
        This_Simple.Kind := Object;
        This_Simple.Literal_Value := -1;   --NEW for correct ActionImage 
         return This_Simple;
      end if;
    --
    --  "true"  "false"    BOOLEAN LITERAL
    --
     if This_Item = "true"  or This_Item = "True" or This_Item = "TRUE" then
        This_Simple.Special_Token := new String'("true");
        This_Simple.Image := new String'(This_Item);
        This_Simple.Kind := Bool;
        This_Simple.Literal_Value := IntTrue;
        return This_Simple;
     end if;
     if This_Item = "false" or This_Item = "False" or This_Item = "FALSE" then
        This_Simple.Special_Token := new String'("false");
        This_Simple.Image := new String'(This_Item);
        This_Simple.Kind := Bool;
        This_Simple.Literal_Value := IntFalse;
        return This_Simple;
     end if;
     --
     --  "emptyqueue"    "queuesize"       EMPTYQUEUE  BOOLEAN   TOKEN ??
     --
     if This_Item = "emptyqueue" then
        This_Simple.Special_Token := new String'("emptyqueue");
        This_Simple.Image := new String'(This_Item);
        This_Simple.Kind := SpecialToken;
        return This_Simple;
     end if;
     if This_Item = "queuesize" then
        This_Simple.Special_Token := new String'("queuesize");
        This_Simple.Image := new String'(This_Item);
        This_Simple.Kind := SpecialToken;
        return This_Simple;
     end if;
     --
     --   event_variable                TRANSITION VARIABLE   TVAR
     --
     --  Come distinguiamo "ss" come "self.ss" da "ss" come variabile???
     --  Se ss non e' una TVAR o una CLASSVAR allora deve essere un signal o operation
     --
     --  Come distinguiamo vv.length come espressione intera da vv.lll come signal o call?
     --  Durante la Parse_Action, riconosciamo <token><"."><"Length"> come caso speciale
     --  (Il problema si pone nel caso dell'asegnamento  v := foo.length)
     --
     for I in reverse Env'Range loop
        if Env(I).Name.all = This_Item then
          This_Simple.Event_Variable :=  Env(I);
          This_Simple.Kind := Env(I).Kind;
          This_Simple.Image := new String'(This_Item);
        end if;
      end loop;
     --
     --   local_variable     CLASS VARIABLE    CVAR
     --
     if This_Simple.Event_Variable = null then
       This_Simple.Local_Variable := Find_Var(This_Item);
       if This_Simple.Local_Variable /= 0 then
         This_Simple.Kind :=
            All_Classes(Current_Class).
               ChartVars(This_Simple.Local_Variable).Kind;
          This_Simple.Image := new String'(This_Item);
       else
         null;  -- can still be the name of a global object
       end if;
     end if;
     --
     -- some kind of var or OBJECTNAME!!
     --
     if This_Simple.Event_Variable /= null or else This_Simple.Local_Variable /= 0 then
        while Current_Item = "." or Current_Item = "[" loop
          if Current_Item = "." and then
             ( Tokens(Current_Token+1).Item.all = "length" or
                Tokens(Current_Token+1).Item.all = "Length")  then
            Skip_Token;   -- "."
            --- new 30-06
            Tmp := This_Simple;
            This_Simple := new SimpleIntExpr;
            This_Simple.Head_Tail_Data := Tmp;
            This_Simple.Kind := Number;
            This_Simple.Special_Token := new String'("Length");
            This_Simple.Image := new String '(This_Simple.Head_Tail_Data.Image.all & ".Length");
            Skip_Token; -- "length"
            return This_Simple;
          --
          --  if followed by "max" ... evaluate it
          --
          elsif Current_Item = "." and then
             ( Tokens(Current_Token+1).Item.all = "max" or
                Tokens(Current_Token+1).Item.all = "Max")  then
            Skip_Token;   -- "."
            --  new 30-06
            Tmp := This_Simple;
            This_Simple := new SimpleIntExpr;
            This_Simple.Head_Tail_Data := Tmp;
            This_Simple.Special_Token := new String'("max");
            This_Simple.Image := new String '(This_Simple.Head_Tail_Data.Image.all & ".Max");
            This_Simple.Kind := Number;
            Skip_Token; -- "max"
          --
          --  if followed by "min" ... evaluate it
          --
          elsif Current_Item = "." and then
             ( Tokens(Current_Token+1).Item.all = "min" or
                Tokens(Current_Token+1).Item.all = "Min")  then
            Skip_Token;   -- "."
            --  new 30-06
            Tmp := This_Simple;
            This_Simple := new SimpleIntExpr;
            This_Simple.Head_Tail_Data := Tmp;
            This_Simple.Special_Token := new String'("Min");
            This_Simple.Image := new String '(This_Simple.Head_Tail_Data.Image.all & ".Min");
            This_Simple.Kind := Number;
            Skip_Token; -- "min"
          --
          --  if followed by "toset" ... evaluate it
          --
          elsif Current_Item = "." and then
             ( Tokens(Current_Token+1).Item.all = "toset" or
                Tokens(Current_Token+1).Item.all = "Toset")  then
            Skip_Token;   -- "."
            --  new 30-06
            Tmp := This_Simple;
            This_Simple := new SimpleIntExpr;
            This_Simple.Head_Tail_Data := Tmp;
            This_Simple.Special_Token := new String'("Toset");
            This_Simple.Image := new String '(This_Simple.Head_Tail_Data.Image.all & ".Toset");
            --
            This_Simple.Kind := This_Simple.Head_Tail_Data.Kind;
            Skip_Token; -- "toset"
          --
          --  if followed by "head" ... evaluate it
          --
          elsif Current_Item = "." and then
             ( Tokens(Current_Token+1).Item.all = "head" or
                Tokens(Current_Token+1).Item.all = "Head")  then
            Skip_Token;   -- "."
            --  new 30-06
            Tmp := This_Simple;
            This_Simple := new SimpleIntExpr;
            This_Simple.Head_Tail_Data := Tmp;
            This_Simple.Special_Token := new String'("Head");
            This_Simple.Image := new String '(This_Simple.Head_Tail_Data.Image.all & ".Head");
            --
            if This_Simple.Head_Tail_Data.Kind= Numvector then
                        This_Simple.Kind := Number;
            elsif This_Simple.Head_Tail_Data.Kind= Boolvector then
                      This_Simple.Kind := Bool;
            elsif This_Simple.Head_Tail_Data.Kind= Objvector then
                        This_Simple.Kind := Object;
            elsif This_Simple.Head_Tail_Data.Kind= Nummatrix then
                        This_Simple.Kind := Numvector;
            elsif This_Simple.Head_Tail_Data.Kind= Boolmatrix then
                      This_Simple.Kind := Boolvector;
            elsif This_Simple.Head_Tail_Data.Kind= Objmatrix then
                        This_Simple.Kind := Objvector;
            elsif This_Simple.Head_Tail_Data.Kind= Numcube then
                        This_Simple.Kind := Nummatrix;
            elsif This_Simple.Head_Tail_Data.Kind= Boolcube then
                      This_Simple.Kind := Boolmatrix;
            elsif This_Simple.Head_Tail_Data.Kind= Objcube then
                        This_Simple.Kind := Objmatrix;
            end if;
            Skip_Token; -- "head"
            -- do allow  var.head.head , var.head.tail, ...
            --  return This_Simple;
          --
          --  if followed by "tail" ... evaluate it
          --
          elsif Current_Item = "." and then
             ( Tokens(Current_Token+1).Item.all = "tail" or
                Tokens(Current_Token+1).Item.all = "Tail")  then
            Skip_Token;   -- "."
            --  new 30-06
            Tmp := This_Simple;
            This_Simple := new SimpleIntExpr;
            This_Simple.Head_Tail_Data := Tmp;
            This_Simple.Special_Token := new String'("Tail");
            This_Simple.Image := new String '(This_Simple.Head_Tail_Data.Image.all & ".Tail");
            This_Simple.Kind := This_Simple.Head_Tail_Data.Kind;
            Skip_Token; -- "tail"
          --
          --  FIXEDBUG 01-08-2016
          --
          --  CASE:    object.signal  return  expr for "object" only
         --  ISSUE    v :=  10 + obj.functcall;  should be forbidden
         --            obj.signal  should be allowed.
          elsif Current_Item = "." then 
--            if In_FunctCall then 
                 exit;
--            else
--              Give_Error("5455 function calls not allowed inside expression");
--             raise Parsing_Error;
--           end if;
          --
          --
          -- if followed by indexing, evaluate it.
          --
          elsif Current_Item = "[" then
            if This_Simple.Special_Token /= null and then
               This_Simple.Special_Token.all = "Tail" then
              Give_Error("5467 Indexing not allowed after tail.");
              raise Parsing_Error;
              --
            else
            Tmp := This_Simple;
            This_Simple := new SimpleIntExpr;
            This_Simple.Head_Tail_Data := Tmp;
           This_Simple.Is_Indexing := Empty_IntExpr_Table_Ref;
            This_Simple.Image := This_Simple.Head_Tail_Data.Image;
            while Current_Item = "[" loop
              Skip_Token;   -- "["
              if This_Simple.Head_Tail_Data.Kind= Numvector then
                        This_Simple.Kind := Number;
              elsif This_Simple.Head_Tail_Data.Kind= Boolvector then
                      This_Simple.Kind := Bool;
              elsif This_Simple.Head_Tail_Data.Kind= Objvector then
                        This_Simple.Kind := Object;
              elsif This_Simple.Head_Tail_Data.Kind= Nummatrix then
                        This_Simple.Kind := Numvector;
              elsif This_Simple.Head_Tail_Data.Kind= Boolmatrix then
                      This_Simple.Kind := Boolvector;
              elsif This_Simple.Head_Tail_Data.Kind= Objmatrix then
                        This_Simple.Kind := Objvector;
              elsif This_Simple.Head_Tail_Data.Kind= Numcube then
                        This_Simple.Kind := Nummatrix;
              elsif This_Simple.Head_Tail_Data.Kind= Boolcube then
                      This_Simple.Kind := Boolmatrix;
              elsif This_Simple.Head_Tail_Data.Kind= Objcube then
                        This_Simple.Kind := Objmatrix;
              end if;
              This_Index := Parse_IntExpr(Env);
              This_Simple.Is_Indexing :=
                  new IntExpr_Table'(This_Simple.Is_Indexing.all & This_Index);
              This_Simple.Image :=
              --   new String'(This_Simple.Head_Tail_Data.Image.all & "[" &
              --       IntExpr_Image(This_Index.all)  & "]");
                 new String'(This_Simple.Image.all & "[" &
                     IntExpr_Image(This_Index.all)  & "]");
              Skip_Token("]");   -- "]"
            end loop;
            end if; -- not tail
          end if;  -- Current_Item =  = "." or Current_Item = "["
       end loop;  -- while Current_Item = "." or Current_Item = "["
       --
       return This_Simple;
    end if; --- some kinf of var
    --
    --  global_object
    --
    -- Object Values are in the Range below 2_000_000_000 (ObjectBase)
    This_Simple.Literal_Value := ObjectBase - Check_Object(This_Item);
      --  se ci fosse un parametro typeInfo potremmo aggiustare il classtype.
    This_Simple.Kind := Object;
    This_Simple.Image := new String'(This_Item); 
    --
    -- ISSUE  BUG when  obj.opcall 
--      if Current_Item = "." then 
--         if In_FunctCall then 
--            null;
--         else
 --          Give_Error("5523 function calls not allowed inside expression");
 --          raise Parsing_Error;
 --        end if;
 --     end if;
    return This_Simple;
    --
    --  if Current_Item = "."  or "+"  or "*"  or "&"  or "|"  or "and " or "or" or "~" or "!"
    --   then give error .....
    --
  end Parse_SimpleExpr;

  function Parse_IntBoolExpr (Env: EventVars_Table) return IntBoolExpr is
     Result: IntBoolExpr;
     Is_Inside: Boolean := False;
  begin
     if Current_Item = "(" then
       Skip_Token;
       Is_Inside := True;
     end if;
     Result.Left := Parse_IntExpr(Env);
     if  Current_Item = ">=" then
         Skip_Token;
         Result.Op := GE;
         Result.Right := Parse_IntExpr(Env);
           --
    elsif Current_Item = "<=" then
           Skip_Token;
           Result.Op := LE;
           Result.Right := Parse_IntExpr(Env);
           --
    elsif Current_Item = "/=" then
           Skip_Token;
           Result.Op := NE;
           Result.Right := Parse_IntExpr(Env);
           --
    elsif Current_Item = "!=" then
           Skip_Token;
           Result.Op := NE;
           Result.Right := Parse_IntExpr(Env);
           --
    elsif Current_Item = "<" then
           Skip_Token;
           Result.Op := LT;
           Result.Right := Parse_IntExpr(Env);
           --
    elsif Current_Item = ">" then
           Skip_Token;
           Result.Op := GT;
           Result.Right := Parse_IntExpr(Env);
           --
    elsif Current_Item = "==" then
           Skip_Token;
           Result.Op := EQ;
           Result.Right := Parse_IntExpr(Env);
           --
    elsif Current_Item = "=" then
           Skip_Token;
           Result.Op := EQ;
           Result.Right := Parse_IntExpr(Env);
           --
    elsif Current_Item = "in" then
           Skip_Token;
           Result.Op := ISIN;
           Result.Right := Parse_IntExpr(Env);
           --
    else
           Result.Op := NE;
           Result.Right :=  BoolFalse;
           --  [x]   means   [x != 0]   and evals to Number(x)  NE 0=false
    end if;
     if Is_Inside and then Current_Item = ")" then
       Skip_Token;
       Is_Inside := True;
     end if;
    return Result;
  end Parse_IntBoolExpr;


  function Parse_Guard_Body (Env: EventVars_Table) return Guard_Ref;

  ---------------------------------------------------
  --   when called on "  (a=1) & (b=2)  returns ONLY a ref to (a=1)
  --  used when found a negation  (which binds more strictly than  & |)
  --------------------------------------------------
  function Parse_One_BoolBoolExpr (Env: EventVars_Table) return Guard_Ref is
    Compare: IntBoolExpr;
    First: Guard_Ref;
  begin
    if Current_Item = "(" then
      Skip_Token;
      First := Parse_Guard_Body (Env);
      Skip_Token ( ")"  );
      return First;
    else
      Compare := Parse_IntBoolExpr(Env);
      return new BoolBoolExpr'(NoOp, Compare);
    end if;
  end Parse_One_BoolBoolExpr;

  ---------------------------------------------------
  -- sample guards are:
  --  [   va[vb[0]] = xx ]
  --  [ x mod 2=0  & z+y>0 & x<4] x=y] [x=1 | x=2]  [x>=1 | y /= 0]
  --  [ ((aa = 0)  & bb )  || (cc & dd=1 & ee=1)]
  --     (aa) = 12    -- not allowed
  --  [ x = y ] ??????  ALLOWED?
  --  [  (x mod 2) = 0 ]   NOT ALLOWED   [ x mod 2 = 0 ]  is OK
  --------------------------------------------------
  function Parse_Guard_Body (Env: EventVars_Table) return Guard_Ref is
    Compare: IntBoolExpr;
    First: Guard_Ref;
    Result: Guard_Ref;
    OpKind: BoolBoolOp := Noop;
  begin
    if Current_Item = "!" then
       Skip_Token;
       OpKind := NotOp;
       First := new BoolBoolExpr(NotOp);
       First.Left := Parse_One_BoolBoolExpr (Env);
    elsif Current_Item = "not" then
       Skip_Token;
       OpKind := NotOp;
       First := new BoolBoolExpr(NotOp);
       First.left := Parse_One_BoolBoolExpr (Env);
    elsif Current_Item = "(" then
      Skip_Token;
      First := Parse_Guard_Body (Env);
      Skip_Token(")");
    else
      Compare := Parse_IntBoolExpr(Env);
      First :=  new BoolBoolExpr'(NoOp, Compare);
      OpKind := Noop;
    end if;
    --
    if Current_Item = "]" or else
        Current_Item = ")" then
        -- do not skip the token because it is of higher level
        return First;
    end if;
    if Current_Item = "&&" or else
        Current_Item = "&"  or else
         Current_Item = "and" then
       Skip_Token;
       OpKind := AndOp;
    end if;
    if Current_Item = "||" or else
       Current_Item = "|" or else
       Current_Item = "or" then
       Skip_Token;
       OpKind := OrOp;
    end if;
    if OpKind = Noop or OpKind = NotOp then
      Result := First;
    else
      Result := new BoolBoolExpr(OpKind);
      Result.Left := First;
      Result.Right :=  Parse_Guard_Body (Env);
    end if;
    return Result;
  end  Parse_Guard_Body;

  --------------------------------------------------
  function Parse_umlExpr (Env: EventVars_Table) return umlExpr_Ref is
    First_IE: IntExpr_Ref;
    First_BB: BoolBoolExpr_Ref;
    First: umlExpr_Ref;
    Result: umlExpr_Ref;
  begin
    First := new umlExpr;
    if Current_Item = "!" or else Current_Item = "not" then
       Skip_Token;
       First_BB := new BoolBoolExpr(NotOp);
       First_BB.Left := Parse_One_BoolBoolExpr (Env);
       First.umlBool := First_BB;
    else
      First_IE := Parse_IntExpr(Env);
      if Current_Item = ">=" then
         Skip_Token;
         First_BB := new BoolBoolExpr(NoOP);
         First_BB.Compare.Left :=   First_IE;
         First_BB.Compare.Op := GE;
         First_BB.Compare.Right := Parse_IntExpr(Env);
         First.umlBool := First_BB;
      elsif Current_Item = ">" then
         Skip_Token;
         First_BB := new BoolBoolExpr(NoOP);
         First_BB.Compare.Left :=   First_IE;
         First_BB.Compare.Op := GT;
         First_BB.Compare.Right := Parse_IntExpr(Env);
         First.umlBool := First_BB;
      elsif Current_Item = "<" then
         Skip_Token;
         First_BB := new BoolBoolExpr(NoOP);
         First_BB.Compare.Left :=   First_IE;
         First_BB.Compare.Op := LT;
         First_BB.Compare.Right := Parse_IntExpr(Env);
         First.umlBool := First_BB;
      elsif Current_Item = "<=" then
         Skip_Token;
         First_BB := new BoolBoolExpr(NoOP);
         First_BB.Compare.Left :=   First_IE;
         First_BB.Compare.Op := LE;
         First_BB.Compare.Right := Parse_IntExpr(Env);
         First.umlBool := First_BB;
      elsif Current_Item = "/=" or else
             Current_Item = "!=" then
         Skip_Token;
         First_BB := new BoolBoolExpr(NoOP);
         First_BB.Compare.Left :=   First_IE;
         First_BB.Compare.Op := NE;
         First_BB.Compare.Right := Parse_IntExpr(Env);
         First.umlBool := First_BB;
      elsif Current_Item = "==" or else
             Current_Item = "="  then
         Skip_Token;
         First_BB := new BoolBoolExpr(NoOP);
         First_BB.Compare.Left :=   First_IE;
         First_BB.Compare.Op := EQ;
         First_BB.Compare.Right := Parse_IntExpr(Env);
         First.umlBool := First_BB;
      elsif Current_Item = "in" then
         Skip_Token;
         First_BB := new BoolBoolExpr(NoOP);
         First_BB.Compare.Left :=   First_IE;
         First_BB.Compare.Op := ISIN;
         First_BB.Compare.Right := Parse_IntExpr(Env);
         First.umlBool := First_BB;
      else
        First.umlInt := First_IE;
      end if;
    end if;
    --   now in First we have the initial part of the expression
    --  so far  (x)  is considered an integer expr, but if we later
    --    find  (x) &&  ...   we should change x to  x /=0
    --    or to x = True if x is a boolean var (boolbool_expr cannot
    --    plain bool vars or values ?!?!?!?!?!
    --
    if Current_Item = "&&" or else
        Current_Item = "&"  or else
         Current_Item = "and" then
       Skip_Token;
       Result := new umlExpr;
       Result.umlBool := new BoolBoolExpr(AndOp);
       if First.umlBool=null and then
          First.umlInt.Op = No_Op and then
          First.umlInt.Simple.Local_Variable /= 0 and then
          All_Classes(Current_Class).ChartVars
            (First.umlInt.Simple.Local_Variable).Kind = Bool then
          First.umlBool := new BoolBoolExpr(NoOp);
          First.umlBool.Compare.Left := First.umlInt;
          First.umlBool.Compare.Op := EQ;
          First.umlBool.Compare.Right := BoolTrue;
          First.umlInt := null;
       elsif First.umlBool=null then
          First.umlBool := new BoolBoolExpr(NoOp);
          First.umlBool.Compare.Left := First.umlInt;
          First.umlBool.Compare.Op := NE;
          First.umlBool.Compare.Right := BoolFalse;
          First.umlInt := null;
       end if;
       Result.umlBool.Left := First.umlBool;
       Result.umlBool.Right :=  Parse_Guard_Body (Env);
       return Result;
    end if;
    if Current_Item = "||" or else
       Current_Item = "|" or else
       Current_Item = "or" then
       Skip_Token;
       Result := new umlExpr;
       Result.umlBool := new BoolBoolExpr(OrOp);
       if First.umlBool =null then
          First.umlBool := new BoolBoolExpr(NoOp);
          First.umlBool.Compare.Left := First.umlInt;
          First.umlBool.Compare.Op := NE;
          First.umlBool.Compare.Right := BoolFalse;
          First.umlInt := null;
       end if;
       Result.umlBool.Left := First.umlBool;
       Result.umlBool.Right :=  Parse_Guard_Body (Env);
       return Result;
    end if;
    Result := First;
    Return Result;
  end  Parse_umlExpr;

  function Is_Vector(The_Expr: IntExpr) return Boolean is
  begin
     -- The_Expr.Simple.Is_vector is never null;
     if The_Expr.Left = null then
         return (The_Expr.Simple.Kind = Objvector or else
                 The_Expr.Simple.Kind = Boolvector or else
                 The_Expr.Simple.Kind = Numvector or else
                 The_Expr.Simple.Kind = Objmatrix or else
                 The_Expr.Simple.Kind = Boolmatrix or else
                 The_Expr.Simple.Kind = Nummatrix or else
                 The_Expr.Simple.Kind = Objcube or else
                 The_Expr.Simple.Kind = Boolcube or else
                 The_Expr.Simple.Kind = Numcube or else
                 The_Expr.Simple.Kind = Composite);
     else
        return Is_Vector(The_Expr.Left.all);
     end if;
  end Is_Vector;


  function Parse_Factors (Env: EventVars_Table) return IntExpr_Ref is
    This_Expr: IntExpr_Ref;
    Tmp: IntExpr_Ref;
  begin
    if Current_Item = "(" then
      Skip_Token;
      This_Expr := Parse_IntExpr(Env);
      Skip_Token(")");
    else
      This_Expr := new IntExpr;
      This_Expr.Op := No_Op;
      This_Expr.Simple :=  Parse_SimpleExpr(Env);
    end if;
    while Current_Item = "*" or else Current_Item = "/" or else Current_Item = "mod" loop
       -- abbiamo altri termini del prodotto
       Tmp := new IntExpr;
       Tmp.Left := This_Expr;
       if Current_Item = "*" then
         Tmp.Op := Times;
       elsif Current_Item = "/" then
         Tmp.Op := Div;
       elsif Current_Item = "mod" then
         Tmp.Op := Modulus;
       end if;
       Skip_Token;
       Tmp.Right := new IntExpr;
       Tmp.Right.Simple :=  Parse_SimpleExpr(Env);
       This_Expr := Tmp;
    end loop;
    return This_Expr;
  end Parse_Factors;

  function Parse_Sum (Env: EventVars_Table) return IntExpr_Ref is
    This_Expr: IntExpr_Ref;
    Tmp: IntExpr_Ref;
  begin
    if Current_Item = "(" then
      Skip_Token;
      This_Expr := Parse_IntExpr(Env);
      Skip_Token(")");
      --
    elsif Current_Item = "-" then
         -- UNARY minus (can olnly appear as the beginning of an intexpr)
         This_Expr := new IntExpr;
         This_Expr.Op := No_Op;
         Skip_Token;
         This_Expr.Left := new IntExpr;
         This_Expr.Left.Simple :=
              new SimpleIntExpr'(0, new String'("0"),0,null,0,null,Number,null,null,null);
         This_Expr.Op := Minus;
         This_Expr.Right := Parse_Factors(Env);
    else
        if Current_Item = "+" then Skip_Token; end if;
        This_Expr :=  Parse_Factors(Env);
    end if;
    --  Abbiamo la prima expr binaria
    while Current_Item = "+" or else Current_Item = "-" loop
       -- abbiamo altri termini della somma
       Tmp := new IntExpr;
       Tmp.Left := This_Expr;
       Tmp.Op := Plus;
       if Current_Item = "-" then Tmp.Op := Minus; end if;
       Skip_Token;
       Tmp.Right := Parse_Factors(Env);
       This_Expr := Tmp;
    end loop;
    return This_Expr;
  end Parse_Sum;
  -------------------------------------------------------------------
  --
  --  IntExpr is  (Left:SimpleIntExpr, Op:IntOp, Right:SimpleIntExpr)
  --
  -- IntExpr appear as part of Actions,
  --     in the Right side of an Assignment
  --  or as argument of a signalled event
  ---------------------------------------------------------------------
  --  called  by  function  Add_Action
  ---------------------------------------------------------------------
  function Parse_IntExpr (Env: EventVars_Table) return IntExpr_Ref is
     This_Expr: IntExpr_Ref := new IntExpr;
  begin
     if Current_Item = "(" then
       Skip_Token;
       This_Expr.Left := Parse_IntExpr(Env);
       Skip_Token(")");
    else
      return Parse_Sum(Env);
    end if;
    --  here MAY continue with:  +,-,*,/ , mod
    if Current_Item = "+" then
      Skip_Token;
      This_Expr.Op := Plus;

      if Current_Item = "(" then
        Skip_Token;
        This_Expr.Right := Parse_IntExpr(Env);
        Skip_Token(")");
      else
        This_Expr.Right := new IntExpr;
        This_Expr.Right.Simple :=  Parse_SimpleExpr(Env);
      end if;

    elsif Current_Item = "-" then
      Skip_Token;
      This_Expr.Op := Minus;
      if Current_Item = "(" then
        Skip_Token;
        This_Expr.Right := Parse_IntExpr(Env);
        Skip_Token(")");
      else
        This_Expr.Right := new IntExpr;
        This_Expr.Right.Simple :=  Parse_SimpleExpr(Env);
      end if;
   elsif Current_Item = "*" then
      Skip_Token;
      This_Expr.Op := Times;
      if Current_Item = "(" then
        Skip_Token;
        This_Expr.Right := Parse_IntExpr(Env);
        Skip_Token(")");
      else
        This_Expr.Right := new IntExpr;
        This_Expr.Right.Simple :=  Parse_SimpleExpr(Env);
      end if;
   elsif Current_Item = "/" then
      Skip_Token;
      This_Expr.Op := Div;
      if Current_Item = "(" then
        Skip_Token;
        This_Expr.Right := Parse_IntExpr(Env);
        Skip_Token(")");
      else
        This_Expr.Right := new IntExpr;
        This_Expr.Right.Simple :=  Parse_SimpleExpr(Env);
      end if;
   elsif Current_Item = "mod" then
     Skip_Token;
     This_Expr.Op := Modulus;
      if Current_Item = "(" then
        Skip_Token;
        This_Expr.Right := Parse_IntExpr(Env);
        Skip_Token(")");
      else
        This_Expr.Right := new IntExpr;
        This_Expr.Right.Simple :=  Parse_SimpleExpr(Env);
      end if;
   else
       This_Expr.Op := No_Op;
   end if;
   return This_Expr;
  end Parse_IntExpr;


  ---------------------------------------------------------------
  -- When called,  Current_Item is an identifier.
  --   var := ...    OK
  --   var[expr] := ..  OK
  --   var[[expr]][..] := ..  OK
  --   var[expr].event   KO not an assignment !
  ---------------------------------------------------------------
  function Is_Assignment return boolean is
     nesting: Natural :=0;
     Index: Natural := Current_Token+1;
  begin
    if Tokens(Index).Item.all  = ":=" or else   -- ASSIGNMENT
        Tokens(Index).Item.all = "=" then --  C-STYLE/JAVA-STYLE ASSIGNMEMT
      return True;
    end if;
    while Tokens(Index).Item.all = "["  loop
      nesting := nesting+1;
      Index := Index+1;
      while nesting /= 0 loop
        if Tokens(Index).Item.all = "["  then
          nesting := nesting+1;
          Index := Index+1;
        elsif Tokens(Index).Item.all = "]" then
          nesting := nesting-1;
          Index := Index+1;
        elsif Tokens(Index).Item.all = ";" or else
          Tokens(Index).Item.all = "}" or else
          Tokens(Index).Item.all = "{" then
          Give_Error ("6013 Errror: Found token " & Tokens(Index).Item.all &
                       " while looking for a ""]""" );
          raise Parsing_Error;
        else
          Index := Index+1;
        end if;
      end loop;
    end loop;
    if Tokens(Index).Item.all  = ":=" or else   -- ASSIGNMENT
        Tokens(Index).Item.all = "=" then --  C-STYLE/JAVA-STYLE ASSIGNMEMT
      return True;
    else return False;
    end if;
  end Is_Assignment;

  ----------------------------------
  --  called after a :=
  --  pok when "obj.fun(n)"   "var[n+1].fun(x)"
  ---------------------------------
  function Is_Function_Call return Boolean is
     nesting: Natural :=0;
     Index: Natural := Current_Token;  --obj or var
  begin
--   CANNOT UNDERSTAND WHY THIS CODE IS HERE !!!! BUGGED"""
--    if Tokens(Index).Item.all /= "(" then
--       return False;
--    end if;
    if Tokens(Index+1).Item.all = "["  then  -- just after var
    while Tokens(Index).Item.all /= "."  and
          Tokens(Index).Item.all /= ";"  and
          Tokens(Index).Item.all /= "}"  and
          Tokens(Index).Item.all /= "{"  loop
     -- skip all inside [] and the rest until ";" or "}"
     if Tokens(Index).Item.all = "["  then
       nesting := nesting+1;
       Index := Index+1;
       while nesting /= 0 loop
         if Tokens(Index).Item.all = "["  then
           nesting := nesting+1;
           Index := Index+1;
         elsif Tokens(Index).Item.all = "]" then
           nesting := nesting-1;
           Index := Index+1;
         elsif Tokens(Index).Item.all = ";" or else
           Tokens(Index).Item.all = "}" or else
           Tokens(Index).Item.all = "{" then
           Give_Error ("6059 Errror: Found token " & Tokens(Index).Item.all &
                        " while looking for a ""]""" );
           raise Parsing_Error;
         else
           Index := Index+1;
         end if;
       end loop;
     else
      Index := Index+1;
     end if;
    end loop;
    else
     Index := Index+1;
    end if;
    if Tokens(Index).Item.all  = "."  and then
            (Tokens(Index+1).Item.all /= "Length" and then
             Tokens(Index+1).Item.all /= "length" and then
             Tokens(Index+1).Item.all /= "head" and then
             Tokens(Index+1).Item.all /= "Head" and then
             Tokens(Index+1).Item.all /= "min" and then
             Tokens(Index+1).Item.all /= "Min" and then
             Tokens(Index+1).Item.all /= "max" and then
             Tokens(Index+1).Item.all /= "Max" and then -- APRIL 1
             Tokens(Index+1).Item.all /= "tail" and then
             Tokens(Index+1).Item.all /= "Tail" ) then
      return True;
    else
      return False;
    end if;
  end Is_Function_Call;

  ---------------------------------------------------------------
  --  data una Actions Table corrispondente alle azioni della
  --    transizione gia parsate, aggiunge alla tabella la sucessiva
  --    azione da considerare
  --              actions are
  --
  --   var := obj.funcall(args);
  --   var = obj.funcall(args);
  --   var[intexp] := obj.funcall(args);
  --   var[intexp] = obj.funcall(args);
  --   var[intexp][..][..] := obj.funcall(args);
  --   var[intexp][..][..]= obj.funcall(args);
  --   var := expr;
  --   var = expr;
  --   var[intexp] := expr;
  --   var[intexp] = expr;
  --   var++
  --   var--
  --   event(args)
  --   obj.event(args)
  --   objvar.event(args)  event = signal or operation
  --   objvar[index].event(args)
  --   return (v);
  --   return;     --- in the context of call triggered transitions
  --   exit   -- from cycle
  --   if cond then {thenpart} else {elsepart}
  --   if (cond) then thenpart  endif
  --   if (cond) then {thenpart}
  --   if (cond) then thenpart else elsepart endif
  --   while (cond) {loopbody}
  --   while cond {loopbody}
  --   while (cond) loopbody endloop
  --   for V in min .. max {loopbody}
  --   for V in min .. max loopbody endloop
  --   Var : Tyope;
  --   Var : Type := Value;
  --   Var : Type = Value;
  ---------------------------------------------------------------
  function Parse_Action (AddTo: Actions_Table;
                       TEnv: EventVars_Table_Ref) return Actions_Table is
    This_Action: Action_Ref := new Action;
    This_Var: Systemvar_Ref;
    My_Args: umlExpr_Table_Ref;
    My_Expr: umlExpr_Ref;
    Prefix: String_Ref;
    This_Kind: String_Ref;
    The_Target: SimpleIntExpr_Ref;
    Event_Name: String_Ref;
    Next_TEnv: EventVars_Table_Ref := TEnv;
    VK: Value_Kind;
  begin
    This_Action.Env_Depth := TEnv.all'Length;
    --
    --  EMPTY LIST OF ACTIONS
    --
    if Current_Item = "}" or else
        Current_Item = "else" or else
        Current_Item = "endif" or else
        Current_Item = "endloop" then
       return AddTo;
    end if;
    --
    --
    if Current_item="exit" then
      Skip_Token;   -- exit
      This_Action.Kind := Exitloop;
    --
    elsif Current_item="if" then
      --
      --   this is an  IF STATEMENT
      --   if <cond> { <thenpart> } else { <elsepart> }
      --
      Skip_Token;   -- "if"
      This_Action.Kind := Conditional;
      if Current_item = "(" then
         Skip_Token;
      end if;
      This_Action.IfCond := Parse_Guard_Body(TEnv.all);
      if Current_item = ")" then
         Skip_Token;
      end if;
      if Current_item = "then" then
         Skip_Token;
      end if;
        Skip_Token ("{");
      This_Action.ThenBody :=
         new Actions_Table'(Parse_Action(No_Actions, TEnv));
      if Current_Item = "}" or else
         Current_Item = "endif"  then
         Skip_Token;
      end if;
      if Current_item="else" then
        Skip_Token("else");
        if Current_Item = "{" then
          Skip_Token ("{");
        end if;
          This_Action.ElseBody :=
             new Actions_Table'(Parse_Action(No_Actions, TEnv));
        if Current_Item = "}" or else
           Current_Item = "endif"  then
           Skip_Token;
        end if;
      else
          This_Action.ElseBody := new Actions_Table(1..0);
      end if;
      --
      --
    elsif Current_item="while" then
      --
      --   this is a WHILELOOP construct
      --
      Skip_Token;   -- "while"
      This_Action.Kind := Whileloop;
      -- parse the lopo var
      if Current_item = "(" then
         Skip_Token;
      end if;
      This_Action.LoopCOnd := Parse_Guard_Body(TEnv.all);
      if Current_item = ")" then
         Skip_Token;
      end if;
      if Current_Item = "{" then
        Skip_Token ("{");
      end if;
      This_Action.LoopBody :=
           new Actions_Table'(Parse_Action(No_Actions, TEnv));
        if Current_Item = "}" or else
           Current_Item = "endloop"  then
           Skip_Token;
        end if;
      --
      --
    elsif Current_item="for" then
      --
      --   this is a FORLOOP construct
      --
      Skip_Token;   -- "for"
      This_Action.Kind := Forloop;
      -- parse the lopo var
      This_Action.For_Var := new EventVar;
      This_Action.For_Var.Name := new String'(Current_Item);
      This_Action.For_Var.Num_Key := TEnv'Length+1;
      This_Action.For_Var.Kind := Number;
      This_Action.For_Var.TypeInfo := 0;
      This_Action.For_VarMin := new EventVar;
      This_Action.For_VarMin.Name := new String'(Current_Item & "_Min");
      This_Action.For_VarMin.Num_Key := TEnv'Length+2;
      This_Action.For_VarMin.Kind := Number;
      This_Action.For_VarMin.TypeInfo := 0;
      This_Action.For_VarMax := new EventVar;
      This_Action.For_VarMax.Name := new String'(Current_Item & "_Max");
      This_Action.For_VarMax.Num_Key := TEnv'Length+3;
      This_Action.For_VarMax.Kind := Number;
      This_Action.For_VarMax.TypeInfo := 0;
      Skip_Token;  -- varid
      --
      Skip_Token ("in");
      This_Action.For_Min := Parse_IntExpr(TEnv.all);
      Skip_Token ("..");
      This_Action.For_Max := Parse_IntExpr(TEnv.all);
      Skip_Token ("{");
      This_Action.LoopBody :=
           new Actions_Table'(Parse_Action(No_Actions,
                   new EventVars_Table'(TEnv.all & (This_Action.For_Var,
                                                  This_Action.For_VarMin,
                                                  This_Action.For_VarMax))));
      if Current_Item = "{" then
        Skip_Token ("{");
      end if;
        if Current_Item = "}" or else
           Current_Item = "endloop"  then
           Skip_Token;
        end if;
      --
      --
    elsif Current_Item = "return" then   --  return  <expr>
      --
      -- this is a RETURN ACTION
      --
      -- remember this to allow some sanity check inside Parse_Transition_Structure
      Return_or_Caller_Found := True;
      --
      Skip_Token;
      This_Action.Kind := OpReturn ;
      My_Args := new umlExpr_Table(1..1);
      if Current_Item /= ";"  and then Current_Item /= "}" and then
           Current_Item /= ")" and then Current_Item /= ")->" then
         My_Expr := Parse_umlExpr(TEnv.all);
         My_Args(1) := My_Expr;
      end if;
      --
      --  get the Value_Kind VK of the return param
      --  (from the trigger profile or from the exression kind?)
      --  FROM the expression KIND
      if My_Args(1) = null then
          VK := Undefined;
      elsif My_Args(1).umlBool /= null then
          VK := Bool;
      else
           VK := IntExpr_Kind(My_Args(1).umlInt.all);
      end if;
      --
      if VK = Number then
         This_Action.Signalled_Event.The_Event := OpReturnInt_Event;
      elsif VK = Object then
         This_Action.Signalled_Event.The_Event := OpReturnObj_Event;
      elsif VK = Bool then
         This_Action.Signalled_Event.The_Event := OpReturnBool_Event;
      elsif VK = Numvector then
         This_Action.Signalled_Event.The_Event := OpReturnIntV_Event;
      elsif VK = Objvector then
         This_Action.Signalled_Event.The_Event := OpReturnObjV_Event;
      elsif VK = Boolvector then
         This_Action.Signalled_Event.The_Event := OpReturnBoolV_Event;
      elsif VK = Nummatrix then
         This_Action.Signalled_Event.The_Event := OpReturnIntM_Event;
      elsif VK = Objmatrix then
         This_Action.Signalled_Event.The_Event := OpReturnObjM_Event;
      elsif VK = Boolmatrix then
         This_Action.Signalled_Event.The_Event := OpReturnBoolM_Event;
      elsif VK = Numcube then
         This_Action.Signalled_Event.The_Event := OpReturnIntC_Event;
      elsif VK = Objcube then
         This_Action.Signalled_Event.The_Event := OpReturnObjC_Event;
      elsif VK = Boolcube then
         This_Action.Signalled_Event.The_Event := OpReturnBoolC_Event;
      else
         This_Action.Signalled_Event.The_Event := OpReturn_Event;
      end if;
      This_Action.Signalled_Event.The_Args := My_Args;
      ---  when return;   My_Args(1) = null !!!
      --
    elsif Tokens(Current_Token+1).Item.all  = ":" then  -- VARIABLE DECLARATION
      --
      --  thid is a Transition VARIABLE DECLARATION
      --
      This_Action.Kind := VarDecl;
      Prefix := Parse_Id;
      This_Action.TVar := new EventVar;
      This_Action.TVar.Name := Prefix;
      This_Action.TVar.Num_Key := TEnv'Length+1;
      This_Action.TVar.Kind := Undefined;
      This_Action.TVar.TypeInfo := 0;  ---  index in All_Classes
      --
      Skip_Token(":");
      This_Kind := Parse_Id;
      if This_kind.all = "obj" then
        This_Action.TVar.Kind := Object;
        if Current_Item = "[" then
          Skip_Token; -- "["
          Skip_Token("]"); 
          This_Action.TVar.Kind := Objvector;
        end if;
      elsif This_kind.all = "bool" then
        This_Action.TVar.Kind :=  Bool;
        if Current_Item = "[" then
          This_Action.TVar.Kind := Boolvector;
          Skip_Token ("["); 
          if Current_Item = "[" then
            -- var: obj[[]]; 
            This_Action.TVar.Kind := Boolmatrix;
            Skip_Token; -- "["
            if Current_Item = "[" then
              This_Action.TVar.Kind := Boolcube;
              Skip_Token("["); 
              Skip_Token("]");
            end if;
            Skip_Token("]");
          end if;
          Skip_Token ("]"); 
        end if;
      elsif This_kind.all = "int" then
        This_Action.TVar.Kind :=  Number;
        if Current_Item = "[" then
          This_Action.TVar.Kind := Numvector;
          Skip_Token ("["); 
          if Current_Item = "[" then
            -- var: obj[[]]; 
            This_Action.TVar.Kind := Nummatrix;
            Skip_Token; -- "["
            if Current_Item = "[" then
              This_Action.TVar.Kind := Numcube;
              Skip_Token("["); 
              Skip_Token("]");
            end if;
            Skip_Token("]");
          end if;
          Skip_Token ("]"); 
        end if;
      else  -- Kind = Class_Name
        This_Action.TVar.Kind := Object;
        This_Action.TVar.Typeinfo := Check_Class(This_kind.all);
        if Current_Item = "[" then
          This_Action.TVar.Kind := Objvector;
          Skip_Token ("["); 
          if Current_Item = "[" then
            -- var: obj[[]]; 
            This_Action.TVar.Kind := Objmatrix;
            Skip_Token; -- "["
            if Current_Item = "[" then
              This_Action.TVar.Kind := Objcube;
              Skip_Token("["); 
              Skip_Token("]");
            end if;
            Skip_Token("]");
          end if;
          Skip_Token ("]"); 
        end if;
      end if;
      --
      if Current_Item = ":=" or else Current_Item = "=" then
        Skip_Token;
        This_Action.TValue := Parse_umlExpr(TEnv.all);
        -- sanity check for opcall body -  used by Parse_Transition_Structure
        if This_Action.TValue.umlInt /= null and then
              This_Action.TValue.umlInt.Simple /= null and then
              This_Action.TValue.umlInt.Simple.Image /= null and then
              This_Action.TValue.umlInt.Simple.Image.all = "_caller" then
           Return_or_Caller_Found := True;
        end if;
        if Current_Item = "." then
          Give_Error("6414 Function calls cannot appear inside variable initializations or expressions");
          raise Parsing_Error;
        end if;
      else
         -- set default initial value
         if This_Action.TVar.Kind = Object then
            This_Action.TValue := new umlExpr'(NullObject,null);
         elsif This_Action.TVar.Kind = Bool then
            This_Action.TValue := new umlExpr'(BoolFalse,null);
         elsif This_Action.TVar.Kind = Number then
            This_Action.TValue := new umlExpr'(Zero,null);
         else  -- structure
            This_Action.TValue := new umlExpr'(NullStruct,null);
         end if;
      end if;
      --
      Next_Tenv :=  new EventVars_Table'(Tenv.all & This_Action.TVar);
      --
    elsif Is_Assignment then
      --  THIS IS AN ASSIGNMENT
      --  left side = "var" or  "var[index][..] :="
      --
      Prefix := Parse_Id;
      This_Action.Assignment_Left :=  - Find_TVar(Prefix.all, TEnv);
        -- the index is saved with negative value to distinguish Tvar from Attributes.
      if This_Action.Assignment_Left = 0 then
         This_Action.Assignment_Left := Find_SystemVar(Prefix.all);
      end if;
      This_Action.Assignment_Left_Image := new String'(Prefix.all);
      if This_Action.Assignment_Left = 0 then
         Give_Error ("6444 Error: Variable " & Prefix.all & " is not declared.");
         raise Parsing_Error;
      end if;
      while Current_Item = "[" loop
         --  ASSIGNMENT TO VECTOR COMPONENT    "var[index] :="
         Skip_Token;   -- "["
         This_Action.Assignment_Left_Indexes :=
            new umlExpr_Table'(
                  This_Action.Assignment_Left_Indexes.all & Parse_umlExpr(TEnv.all));
         Skip_Token("]");   -- "]"
         This_Action.Assignment_Left_Image :=
             new String'(Prefix.all &
               "[" &
                 intExpr_Image(This_Action.Assignment_Left_Indexes(
                    This_Action.Assignment_Left_Indexes.all'Last).umlInt.all) &
               "]");
      end loop;
      Skip_Token;    -- ":="   or "="
      --
      if Is_Function_Call then
        --
        -- this is an ASSIGNMENT with remote FUNCTION CALL
        --    "var := obj.ev(v)"  "var[expr] = obj.ev(v) "
        --
        This_Action.Kind := Function_Call;
        The_Target:= Parse_SimpleExpr(TEnv.all,In_FunctCall => True);  --  "obj"
        if Flags.Lazy_Parsing and then The_Target.Kind = Undefined then
             The_Target.Kind := Object;
        end if;
        Skip_Token(".");
        Event_Name := Tokens(Current_Token).Item;
        Skip_Token; -- "ev"
        --
        My_Args := new umlExpr_Table'(Empty_umlExpr_Table);
          --  parse the arguments, if any
        if Current_Item = "(" then    --  what about "()"????
          Skip_Token;
          if Current_Item /= ")" then
          -- this is a signal with parameters
          My_Expr := Parse_umlExpr(TEnv.all);
          -- sanity check for opcall body -  used by Parse_Transition_Structure
          if My_Expr.umlInt /= null and then
                My_Expr.umlInt.Simple /= null and then
                My_Expr.umlInt.Simple.Image /= null and then
                My_Expr.umlInt.Simple.Image.all = "_caller" then
             Return_or_Caller_Found := True;
          end if;
          My_Args := new umlExpr_Table'(My_Args.all & My_Expr);
            while Current_Item  = "," loop
              Skip_Token;
              My_Expr := Parse_umlExpr(TEnv.all);
              -- sanity check for opcall body -  used by Parse_Transition_Structure
              if My_Expr.umlInt /= null and then
                    My_Expr.umlInt.Simple /= null and then
                    My_Expr.umlInt.Simple.Image /= null and then
                    My_Expr.umlInt.Simple.Image.all = "_caller" then
                 Return_or_Caller_Found := True;
              end if;
              My_Args := new umlExpr_Table'(My_Args.all & My_Expr);
              if Current_Item = ")" then
                exit;
              end if;
            end loop;
            end if;
          Skip_Token (")");
        end if;
        if Current_Item  /= ";" and Current_Item  /= "}" then
           Give_Error("6511 function calls cannot appear inside other expressions");
           raise Parsing_Error;
        end if;
        This_Action.Signalled_Event.The_Args := My_Args;
        This_Action.Signalled_Event.The_Target := The_Target;
        This_Action.Signalled_Event.The_Event :=
            Check_Event(Event_Name.all, My_Args);
          --
      else
        --
        -- this is a PLAIN ASSIGNMENT action
        --  "SystemVar :=  umlExpr "  "Tvar := umlExpr"
        --  "SystemVar[expr] :=  umlExpr "  "Tvar[expr] := umlExpr"
        -- 
        This_Action.Kind := Assignment;
        This_Action.Assignment_Right := Parse_umlExpr(TEnv.all);
        -- sanity check for opcall body -  used by Parse_Transition_Structure
        if This_Action.Assignment_Right.umlInt /= null and then
           This_Action.Assignment_Right.umlInt.Simple /= null and then
           This_Action.Assignment_Right.umlInt.Simple.Image /= null and then
           This_Action.Assignment_Right.umlInt.Simple.Image.all = "_caller" then
           Return_or_Caller_Found := True;
        end if;
        --
        --   Propagation of type from right to left of assignment
        --  Supprressed becuase BUGGED (missing case of Tvar) ans unncessary (since dyntyping)
        --This_Var :=
        --  All_Classes(Current_Class).ChartVars(This_Action.Assignment_Left);
        --if This_Var.Kind = Undefined then
        --  if This_Action.Assignment_Right.umlInt /= null then
        --     This_Var.Kind := IntExpr_Kind(This_Action.Assignment_Right.umlInt.all);
        --  else
        --    This_Var.Kind := Bool;
        --  end if;
        --end if;
      end if;  -- ASSIGNMENT
      --
    elsif Next_Item = "++" then
      --
      --  This is an INCREMENT ASSIGNMENT
      --
      Prefix := Parse_Id;
      This_Action.Kind := Assignment;
      This_Action.Assignment_Left :=  - Find_TVar(Prefix.all, TEnv);
        -- the index is saved with negative value to distinguish Tvar from Attributes.
      if This_Action.Assignment_Left = 0 then
         This_Action.Assignment_Left := Find_SystemVar(Prefix.all);
      end if;
      This_Action.Assignment_Left_Image := new String'(Prefix.all);
      if This_Action.Assignment_Left = 0 then
         Give_Error ("6561 Error: Variable " & Prefix.all & " is not declared.");
         raise Parsing_Error;
      end if;
      Skip_Token;   -- ++
      This_Action.Assignment_Right := new umlExpr;
      This_Action.Assignment_Right.umlInt := new IntExpr;
      This_Action.Assignment_Right.umlInt.Left  := new IntExpr;
      --
      if This_Action.Assignment_Left > 0 then
         -- this is an increment of a Class Var
        This_Action.Assignment_Right.umlInt.Left.Simple :=
           new SimpleIntExpr'(0, new String'(Current_Item & "++"), This_Action.Assignment_Left,
             null, 0, null, Number,null,null,null);
        This_Var :=
          All_Classes(Current_Class).ChartVars(This_Action.Assignment_Left);
        if This_Var.Kind = Undefined then
          This_Var.Kind := Number;
        end if;
      else
         -- this is an increment of a Transition Var (negative index);
        This_Action.Assignment_Right.umlInt.Left.Simple :=
           new SimpleIntExpr'(0, new String'(Current_Item & "++"),  0,
             TEnv( - This_Action.Assignment_Left),0, null, Number,null,null,null);
      end if;
      This_Action.Assignment_Right.umlInt.Op := Plus;
      This_Action.Assignment_Right.umlInt.Right :=  Uno;
      --
    elsif Next_Item = "--" then
      --
      --   this is a DECREMENT ASSIGNMENT
      --
      Prefix := Parse_Id;
      This_Action.Kind := Assignment;
      This_Action.Assignment_Left :=  - Find_TVar(Prefix.all, TEnv);
        -- the index is saved with negative value to distinguish Tvar from Attributes.
      if This_Action.Assignment_Left = 0 then
         This_Action.Assignment_Left := Find_SystemVar(Prefix.all);
      end if;
      This_Action.Assignment_Left_Image := new String'(Prefix.all);
      if This_Action.Assignment_Left = 0 then
         Give_Error ("6601 Error: Variable " & Prefix.all & " is not declared.");
         raise Parsing_Error;
      end if;
      Skip_Token;    --
      This_Action.Assignment_Right := new umlExpr;
      This_Action.Assignment_Right.umlInt := new IntExpr;
      This_Action.Assignment_Right.umlInt.Left := new IntExpr;
      This_Action.Assignment_Right.umlInt.Left.Simple :=
         new SimpleIntExpr'(0, new String'(Current_Item & "--"), This_Action.Assignment_Left,
          null, 0,null, Number,null,null,null);
      This_Action.Assignment_Right.umlInt.Op := Minus;
      This_Action.Assignment_Right.umlInt.Right :=  Uno;
      This_Var :=
        All_Classes(Current_Class).ChartVars(This_Action.Assignment_Left);
      if This_Var.Kind = Undefined then
        This_Var.Kind := This_Action.Assignment_Right.umlInt.Simple.Kind;
      end if;
      --
    else
      --
      --   this is a SIGNAL or a CALL action
      --
      --   OUT.event(args)  CHART.event(args)   event(args)   var.event(args)
      --   var[expr].event(args)
      --
      -- Target e' in genere una Parse_SimpleExpr
      --
      This_Action.Kind := Signal;
      --       sign;  sign(..);   sign}  -- implicit OUT target object
      if Next_Item=";" or else Next_Item="(" or else Next_Item="}" then
        The_Target := UML_TYpes.OUTobject;
      else
        The_Target:= Parse_SimpleExpr(TEnv.all);  --  "obj"  "vect[i]" "var"
        Skip_Token(".");
      end if;
      Event_Name := Tokens(Current_Token).Item;
      if Event_Name.all = "tau" then
        Give_Error( "6638 ERROR:  'tau' is not allowed as event name,");
        raise Parsing_Error;
      end if;
      Skip_Token; -- "ev"
      --
      My_Args := new umlExpr_Table'(Empty_umlExpr_Table);
      --
      --  parse the arguments, if any
      --
      if Current_Item = "(" then
        Skip_Token;
        if Current_Item /= ")" then
          -- this is a signal or call  with parameters
          My_Expr := Parse_umlExpr(TEnv.all);
          -- sanity check for opcall body -  used by Parse_Transition_Structure
          if My_Expr.umlInt /= null and then
            My_Expr.umlInt.Simple /= null and then
            My_Expr.umlInt.Simple.Image /= null and then
            My_Expr.umlInt.Simple.Image.all = "_caller" then
            Return_or_Caller_Found := True;
          end if;
          My_Args := new umlExpr_Table'(My_Args.all & My_Expr);
          while Current_Item  = "," loop
            Skip_Token;
            My_Expr := Parse_umlExpr(TEnv.all);
            -- sanity check for opcall body -  used by Parse_Transition_Structure
            if My_Expr.umlInt /= null and then
              My_Expr.umlInt.Simple /= null and then
              My_Expr.umlInt.Simple.Image /= null and then
              My_Expr.umlInt.Simple.Image.all = "_caller" then
              Return_or_Caller_Found := True;
            end if;
            My_Args := new umlExpr_Table'(My_Args.all & My_Expr);
            if Current_Item = ")" then
              exit;
            end if;
          end loop;
        end if;
        Skip_Token (")");
      end if;
      --
      -- assign and check My_Args (possibly introducing a new event profile)
      --
      This_Action.Signalled_Event.The_Args := My_Args;
      This_Action.Signalled_Event.The_Target := The_Target;
      This_Action.Signalled_Event.The_Event := Check_Event(Event_Name.all, My_Args);
      if This_Action.Signalled_Event.The_Target.Image.all = "OUT" or else
         This_Action.Signalled_Event.The_Target.Image.all = "ERR" then
         This_Action.Signalled_Event.The_Event.Kind := Signal;
      end if;
      --
    end if;  --  assignment or signal
      --
      --   look if the action is composite
    if Current_Item  = ";" then
      Skip_Token;
      if Current_Item  = ")->" or else
          Current_Item = ")"  then
          -- it was just an final semicolon .  Do not Skip the token
          return (AddTo & This_Action);
      else
        -- it is a true composite action  CONTINUE THE PARSING
        return Parse_Action (AddTo & This_Action, Next_Tenv);
      end if;
    elsif Current_Item  = ")->" or else
          Current_Item = ")"  or else
          Current_Item = "}"  then
       return (AddTo & This_Action);
    else
      Give_Error ("6707 Unxepected stuff after action: missing ""}"" , ""("", "";"" ?");
      raise Parsing_Error;
    end if;
--  exception
--     when others =>
--        Parsing_Failed := True;
----        Give_Error("Failure during parsing of transition structure");
--        if Parsing_Errors > 5 then
--          raise Parsing_Error;
--        else
--          while  Current_Item /= "" and then
--              Current_Item /= "}" and then Next_Item /= ";" loop
--            Skip_Token;
--          end loop;
--        if Current_Item= ";" then Skip_Token; end if;
--       end if;
--       return AddTo;
  end Parse_Action ;

  -------------------------------------------------------------------------
  -- called by Parse_Transition_Body
  -- parses the sequence of actions after ther trigger-guard and
  --  returns the table of actions of the transition
  -- Action_Kind is (Signal, Assignment
  -- Env is the list of event variables of the transition trigger
  -------------------------------------------------------------------------
  function Parse_Actions (TEnv: EventVars_Table_Ref) return Actions_Table_Ref is
  begin
    if Current_Item = ")->" or else
       Current_Item = ")" then
      -- do not skip the token
      return new Actions_Table'(No_Actions);
    end if;
    -- some action IS present
    return new Actions_Table'(Parse_Action(No_Actions, Tenv));
  end Parse_Actions;

  function Add_To_Outgoing_Catalogue (This_Transition: Transition_Ref;
                                      This_Catalogue: TransitionsCatalogue_Ref)
                     return TransitionsCatalogue_Ref is
    New_Catalogue: TransitionsCatalogue_Ref := This_Catalogue;
    Found: Natural :=0;
  begin
     for I in This_Catalogue.all'Range loop
       if This_Catalogue(I).This_Event = This_Transition.Trigger then
          Found := I;
          exit;
       end if;
     end loop;
     if Found > 0 then
        New_Catalogue(Found).These_Transitions :=
           new Transitions_Table'(New_Catalogue(Found).These_Transitions.all &
                                This_Transition);
     else
       New_Catalogue :=
           new TransitionsCatalogue'(New_Catalogue.all &
                Triggered_Transitions'( This_Event => This_Transition.Trigger,
                  These_Transitions =>
                        new Transitions_Table'(1..1 => This_Transition)));
     end if;
     return New_Catalogue;
  end Add_To_Outgoing_Catalogue;

  -------------------------------------------------------------------------
  -- Given a table of transitions,
  --  returns a pointer to a table of triggered transitions;
  -- Interal Transitions (if any) are stored in the first position of
  --   the catalogue
  -------------------------------------------------------------------------
  function Build_Outgoing_Catalogue (These_Transitions: Transitions_Table)
                     return TransitionsCatalogue_Ref is
    --
    This_Catalogue: TransitionsCatalogue_Ref;
    TT_Count: Natural;
    TT_Ref: Transitions_Table_Ref;
    TT_Table: Transitions_Table(1..These_Transitions'Length);
    --
  begin
    This_Catalogue := new TransitionsCatalogue(1..0);
    --
    for J in All_Events.all'Range loop
      -- Load the set of triggered transitions
      TT_Count := 0;
      for I in These_Transitions'Range loop
         if These_Transitions(I).Trigger.Num_Key =
               All_Events(J).Num_Key then
            TT_Count := TT_Count +1;
            TT_Table(TT_Count) := These_Transitions(I);
         end if;
      end loop;
      if TT_Count > 0 then
        TT_Ref := new Transitions_Table'(TT_Table(1..TT_Count));
        This_Catalogue :=
          new TransitionsCatalogue'(This_Catalogue.all &
             Triggered_Transitions'(All_Events(J), TT_Ref) );
      end if;
    end loop;
    return This_Catalogue;
  end Build_Outgoing_Catalogue;


  function Parse_Composite_Name return String_Ref is
    Tmp: String_Ref;
  begin
    Tmp := Parse_Id;
    while Current_Item = "." loop
      Skip_Token;
      Tmp := new String'(Tmp.all & "." & Parse_Id.all);
      -- Free ?
    end loop;
    return Tmp;
  end Parse_Composite_Name;


  ----------------------------
  -- called by Parse_Transition
  -- parses the content inside {..} (trigger/actions)
  ----------------------------
  procedure Parse_Transition_Structure (This_Transition: Transition_Ref) is
    Transition_Env: EventVars_Table_Ref;
    previousPE: Natural := Parsing_Errors;
  begin
      Return_or_Caller_Found := False;
      Is_Operation_Body := False;
      --
      -- parse the transition trigger (and load the trigger ENV)
      --
      This_Transition.Trigger := new Event;
      if Current_Item = "-" then
        This_Transition.Trigger.Name := Tokens(Current_Token).Item;
        Skip_Token;
      elsif Current_Item = "[" or else
           Current_Item = "/" or else
           Current_Item = "}" then
         This_Transition.Trigger := new Event;
         This_Transition.Trigger.Name := new String'("-");
         -- was:
         --   Give_Error("Error: Transition trigger expected  (maybe ""-"" ?)");
         --   raise Parsing_Error;
         -- end if;
      else
        This_Transition.Trigger.Name := Parse_Id;
        if Current_Item  = "(" then
          Skip_Token;
            if  Current_Item  /= ")" then
              This_Transition.Trigger.Params :=
                new EventVars_Table'(Parse_EventVars(No_EventVars));
            end if;
          Skip_Token(")");
        else
          This_Transition.Trigger.Params := new EventVars_Table'(No_EventVars);
        end if;
      end if;
      This_Transition.Trigger := Find_Event(This_Transition.Trigger);
      if This_Transition.Trigger.Kind = Operation then
        Is_Operation_Body := True;
      end if;
      Transition_Env := This_Transition.Trigger.Params;
      --
      -- parse the transition guard, if any
      --
      if Current_Item = "[" then
        if  Next_Item /= "]"  then
          Skip_Token;
          This_Transition.Guard := Parse_Guard_Body(Transition_Env.all);
          Skip_Token ("]");
        else
          Skip_Token;
          Skip_Token;
        end if;
      end if;
      --
      -- parse the transitions Action list (if any)
      --
      if Current_Item = "/" then
        if Next_Item ="-" then
           Give_Error("6883 Error: unexpected ""-"" at beginning of statements list");
           raise Parsing_Error;
        end if;
        Skip_Token;
        This_Transition.Actions :=  Parse_Actions(This_Transition.Trigger.Params);
      elsif Current_Item = "}" then
        This_Transition.Actions := new Actions_Table'(No_Actions);
      elsif Current_Item = ";" then
        Give_Error("6891 Error: unexpected "";"" ");
        raise Parsing_Error;
      else
        Give_Error("6894 Error:  Transition syntax ::= ""{"" [trigger] [guard] [actions]""}"" ");
        Give_Error("        Where guard ::= ""["" bool expr ""]"" and actions ::= ""/""[action;]{action;}");
        raise Parsing_Error;
      end if;
      --
      if Flags.Lazy_Parsing and then
          Return_or_Caller_Found and then
          This_Transition.Trigger /= Null_Event then
          -- we have introduced a Signal (maybe)
          This_Transition.Trigger.Kind := Operation;
      end if;
      --
      if Is_Operation_Body and then not Return_or_Caller_Found then
        -- add implicit return statement when possible
        if This_Transition.Trigger.Return_Type = Undefined then
          declare
             Implicit: Action_Ref := new Action;
          begin
             Implicit.Kind := OpReturn;
             Implicit.Signalled_Event.The_Event := OpReturn_Event;
             Implicit.Signalled_Event.The_Args := new umlExpr_Table(1..1);
              --
            This_Transition.Actions :=
              new Actions_Table'(This_Transition.Actions.all & Implicit);
          end;
        else
          Give_Error ("6920 Missing ""return"" action");
          raise Parsing_Error;
        end if;
      end if;
      --
      Return_or_Caller_Found := False;
      Is_Operation_Body := False;
  exception
     when others =>
        if PreviousPE = Parsing_errors then
          Give_Error("6930 Failure during parsing of transition structure");
        end if;
        if Parsing_Errors > 5 then
          raise Parsing_Error;
        else
          while  Current_Item /= "" and then
              (Current_Item /= "}" or
               (Current_Item = "}" and Next_Item = ";")) loop
            Skip_Token;
          end loop;
       end if;
  end Parse_Transition_Structure;

  -------------------------------------------------------------------------
  -- A  Transition has the form:
  --  <label>:  <source> -( <trigger> / <actions> )-> <target>  or
  --  <label>:  <source> -> <target>
  --    (with some components potentially missing)
  --     path.initial  -> path.initialstate
  --  where
  --
  -- e.g.
  --   t1:  S1.R4.s6 -> s2
  --   t2:  (S1.R4.s6,S1.R5.s2) -> s2     join
  --   t3:  S1  -( - / x := x+1; obj.target(v) )->  s2
  --      (S1.R4.s6,S1.R5.s9) -( trigger  )-> s2     # join
  -------------------------------------------------------------------------
  procedure Parse_Transition is
    This_Transition: Transition_Ref;
    These_Names: String_Table_Ref;
    This_Name : String_Ref;
    DefInitial : State_Ref;
    Tmp_Owner: State_Ref;
    This_Label: String_Ref;
  begin
      This_Transition := new Transition;
      --
      --
      -- parse the src and label of the transition:
      --    ti(args):   (xxx.xxx, yyy.yyy)
      --    tn:   xxx.yyy
      --          yyyy.zzzz
      --          (aaaa.bbb, ccc.ddd)
      --
      -- Parse the label (if any)
      --
      This_Label := null;
      if Next_Item = ":" then
         This_Transition.Comms := Tokens(Current_Token).PrecedingBlockComment;
         This_Label := Parse_Id;
         This_Transition.Label := This_Label;
         Skip_Token;    -- next_item
      elsif Next_Item = "(" then
         This_Label := new String'("");
         This_Transition.Comms := Tokens(Current_Token).PrecedingBlockComment;
         while Current_Item /= ":" loop
           if Current_Item = "->" then
               Give_Error ("6999 expecting ':' at end of transition label");
               raise Parsing_error;
           end if;
           This_Label := new String'(This_Label.all & Current_Item);
           Skip_Token; 
         end loop;
         This_Transition.Label := This_Label;
         Skip_Token (":"); 
      end if;
      --
      --  parse the source
      --
      if Current_Item  = "(" then
        if Tokens(Current_Token).PrecedingBlockComment.all'Length >0 then
          This_Transition.Comms := Tokens(Current_Token).PrecedingBlockComment;
        end if;
        Skip_Token;
        These_Names:= Parse_Names_List;
        This_Transition.Source := new States_Table(These_Names.all'Range);
        for I in This_Transition.Source.all'Range loop
          This_Transition.Source(I) := Find_State (These_Names(I).all);
        end loop;
        Skip_Token (")");
      else
        if Tokens(Current_Token).PrecedingBlockComment.all'Length >0 then
          This_Transition.Comms := Tokens(Current_Token).PrecedingBlockComment;
        end if;
        This_Name := Parse_Composite_Name;
        --
        This_Transition.Source :=
           new States_Table'( 1..1 => Lazy_Find_State (This_Name.all) );
        --
        if This_Name /= null and then
            (This_Name.all = "initial" or else
             (This_Name.all'Length > 8 and then
               This_Name(This_Name'Last-7 .. This_Name'Last) = ".initial")) then
           DefInitial := This_Transition.Source(1);
           if (Current_Item /= "->") then
             Give_Error ("7003 no trigger / actions allowed for default initial transitions");
             raise Parsing_Error;
           end if;
        else
          DefInitial :=null;
        end if;
      end if;
      --
      --   parse the trigger/guard/actions  structure
      --
      if Current_item = "-(" or else
         Current_item = "(" then
        Skip_Token;
        Parse_Transition_Structure(This_Transition);
        -- this sets Return_or_Caller_Found
      end if;
      --

      if Current_Item = ")->"  or else
          Current_Item = "->"  then
        Skip_Token;
      else
        Give_Error  ("7026 --> Transition target expected (found """& Current_Item & """, maybe missing "";""?) ");
        raise Parsing_Error;
      end if;
      --
      --  parse the transition target:  (xxx.xxx, yyy.yy, ..)
      --
      if Current_Item = "(" then
        Skip_Token;
        These_Names:= Parse_Names_List;
        This_Transition.Target := new States_Table(These_Names.all'Range);
        for I in This_Transition.Target.all'Range loop
         This_Transition.Target(I) :=
           Lazy_Find_State (These_Names(I).all); -- WAS BUG??
        end loop;
        Skip_Token (")");
      else
        This_Name := Parse_Composite_Name;
        This_Transition.Target :=
           new States_Table'( 1..1 =>
               Lazy_Find_State (This_Name.all) );
        if DefInitial /= null then
           if (Current_Item = "{") then
             Give_Error ("7048 no trigger / actions allowed for default initial transitions");
             raise Parsing_Error;
           elsif This_Transition.Target(1).parent /= DefInitial.parent then
             Give_Error ("7051 target state must be have the same parent state of the source state");
             raise Parsing_Error;
           end if;
           -- just make sure target is first state of the parent and return
           -- the defauklt ìintial node has not been linked to the parent by Lazy_Find_State
           -- remove explicit "initial" node
           declare
             parent: State_ref := This_Transition.Target(1).parent;
             target: State_ref := This_Transition.Target(1);
             tmp: State_ref;
           begin
             for I in 2 .. parent.substates.all'last loop
                if parent.substates(I)= target then
                  tmp := parent.substates(1);
                  parent.substates(1) := target;
                  parent.substates(I) := tmp;
                  exit;
                end if;
             end loop;
             -- return without further deading with this pseudo transition
             return;
           end;
        end if;
      end if;
      --
      -- parse the HUGO flavour of transition body or
      --  ...
      --
      --  Further transition elaboration
      --  add this transition to the table of ChartTransitions
      --
      This_Transition.Num_Key :=
            All_Classes(Current_Class).ChartTransitions.all'Length + 1;
      All_Classes(Current_Class).ChartTransitions :=
        new Transitions_Table'(
           All_Classes(Current_Class).ChartTransitions.all & This_Transition);
      --
      -- WE STILL HAVE:
      --   TO SET THE TRANSITION OWNER
      --   TO ADD IT TO THE OWNER'S LOCAL TRANSITIONS
      --   TO ADD IT TO THE SOURCE(1).OUTGOING CATALOGUE
      declare
        Current_State: State_Ref;
        Found: Boolean;
      begin
        -- find the LCA (least common ancestor) of the sources
        --
        Tmp_Owner := This_Transition.Source(1).Parent;
        for I in 2 .. This_Transition.Source.all'Length loop
          Found := False;
          while (not Found) and Tmp_Owner /= null loop
            Current_State := This_Transition.Source(I);
            Found := False;
            while (not Found) and Current_State /= null loop
              if Current_State.Parent = Tmp_Owner then
                Found := True;
                exit;
              end if;
              Current_State := Current_State.Parent;
            end loop;
            if not Found then
              Tmp_Owner :=  Tmp_Owner.Parent;
            end if;
          end loop;
        end loop;
        --
        -- find the LCA of the sources+target
        --
        for I in This_Transition.Target.all'Range loop
          Found := False;
          while (not Found) and Tmp_Owner /= null loop
            Current_State := This_Transition.Target(I);
            Found := False;
            while (not Found) and Current_State /= null loop
              if Current_State.Parent = Tmp_Owner then
                Found := True;
                exit;
              end if;
              Current_State :=  Current_State.Parent;
            end loop;
            if not Found then
              Tmp_Owner :=  Tmp_Owner.Parent;
            end if;
          end loop;
        end loop;
        --
        -- Tmp_Owner = LCA
        --
        if Tmp_Owner = null then
          Give_Error ("7140 Error in State Name???");
          raise Parsing_Error;
        else
          --  THIS IS A BUG
          -- WE CANNOT MOVE LOCAL TRANSITION OWNDER BY A PARALLEL STATE
          -- TO ITS PARENT, OTHERWISE WE LOSE THEIR PARALLEL COMPOSITION
          -- while Tmp_Owner.Kind = Parallel loop
          --   Tmp_Owner :=  Tmp_Owner.Parent;
          --   --  NOTICE when Lazy_Parsing the Kind can still be Composite being later
          --   --   changed into Parallel. In the case we should move out the localtransitions.
          --   if Tmp_Owner = null then
          --     Give_Error ("Invalid model with top level parallel state");
          --     raise Parsing_Error;
          --   end if;
          -- end loop;
          This_Transition.Owner := Tmp_Owner;
          if Tmp_Owner.Kind = Parallel then
             Give_Error ("7157 Transitions inside a parallel state cannot connect different regions.");
             raise Parsing_Error;
          end if;
        end if;
      end;
      --
      Tmp_Owner.LocalTransitions :=
        new Transitions_Table'(
          Tmp_Owner.LocalTransitions.all & This_Transition);
                --
      -- parse the HUGO flavour of transition body or
      --  complete the null transition
      --
      if This_Transition.Trigger = null then
        This_Transition.Trigger :=  Null_Event;
        This_Transition.Actions := new Actions_Table'(No_Actions);
        if Current_item = "{"  then
             -- HUGO FLAVOUR
          Skip_Token;
          Parse_Transition_Structure(This_Transition);
          -- this sets  Return_or_Caller_Found
          Skip_Token("}");
        end if;
      end if;
      --
      -- OutGoing_Catalogue ...
      --
--     declare
--       This_Substate: State_Ref;
--     begin
--       for I in Tmp_Owner.SubStates.all'Range loop
--         This_Substate := Tmp_Owner.Substates(I);
--         --
--         if This_Transition.Source(1) = This_Substate or else
--            IsNested (This_Transition.Source(1).all, This_Substate.all) then
--           --
--           -- build its catalogue;
--           This_Substate.OutgoingTransitions :=
--              Add_To_Outgoing_Catalogue (This_Transition,
--                                          This_Substate.OutgoingTransitions);
--           exit;
--         end if;
--         --
--        end loop;
--      end;
      --
  exception
    when others =>
      Parsing_Failed := True;
      if Parsing_Errors > 5 then
        raise Parsing_Error;
      else
        while  Current_Item /= "" and then
              (Current_Item /= "}"  or else
               Next_Item = "}") and then
               Current_Item /= "Class" and then
               Current_Item /= "class" and then
               Current_Item /= "end" and then
               Next_Item /= ":" and then           --  Obj: Class
               Next_Item /= "." and then           --  S1.s2 -> s3
               Next_Item /= "->" and then          --  s2 -> s4
               Current_Item /= "Objects" and then
               Current_Item /= "objects" loop
            Skip_Token;  -- skip items until ond of transition
        end loop;
      if Current_Item= "}" then Skip_Token; end if;
    end if;
    --
  end Parse_Transition;

  procedure Parse_Transitions is
  begin
    if Current_Item = "Transitions" or else
       Current_Item = "transitions" or else
       Current_Item = "behaviour" or else
       Current_Item = "Behaviour" or else
       Current_Item = "behavior" or else
       Current_Item = "Behavior" then
      Skip_Token;
    else
       Give_Error("7237 I was Expecting 'Transitions' (or 'Behavior'), and found '" &
                Current_Item &"' instead.");
       raise Parsing_Error;
    end if;
    if Current_item = ":" then
      Skip_Token;
    end if;
    -- Class /Chart Definition MUST be ended by "end".
    while Current_Item /= "" and then
          Current_Item /= "end"  loop
      Parse_Transition;
    end loop;
    --
    if Current_Item = "end"  then
      Skip_Token;
      if Current_Item = All_Classes(Current_Class).Name.all  then
        Skip_Token;
      end if;
      if Current_Item = ";" then
         Skip_Token;
      end if;
    end if;
  end Parse_Transitions;

--  New Action  "return <expr>" required for trans triggered by operations
--  Check Add_Action and adjust evaluation Env so that return type is known
--  New special signal "return(v)"  "return"
--  OOPS  CALL  events MUST HAVE AN IMPLICIT caller:obj PARAMETER!!!
--
begin
  null;
end UML_Parser;
