Changeset 316


Ignore:
Timestamp:
Oct 27, 2014, 5:23:06 PM (6 years ago)
Author:
Maxim Reznik
Message:

Add withed region list to env

Location:
branches/invoke/src
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • branches/invoke/src/ag/down.ag

    r313 r316  
    476476Rules for procedure_call_statement. :
    477477(.
    478       ${Called_Name.Down} := 0;  --  FIXME
     478      --  FIXME  take parameters into account
     479      Gela.Pass_Utils.Resolve.Interpretation
     480        (Self.Compilation,
     481         ${procedure_call_statement.env_in},
     482         ${Called_Name.Up},
     483         ${Called_Name.Down});
    479484.)
    480485
  • branches/invoke/src/ag/env_in.ag

    r313 r316  
    817817Rules for compilation_unit_body. :
    818818(.
     819      --  depends on ${Context_Clause_Elements.env_out}
    819820      ${Unit_Declaration.env_in} :=
    820821        Self.Compilation.Context.Environment_Set.Library_Level_Environment;
     
    20912092Rules for procedure_body. :
    20922093(.
     2094      --  ${Body_Statements.Errors}
    20932095      ${Body_Exception_Handlers.env_in} := ${Body_Declarative_Items.env_out};
    20942096.)
  • branches/invoke/src/ag/env_out.ag

    r299 r316  
    768768Rules for procedure_declaration. :
    769769(.
    770       ${procedure_declaration.env_out} := ${procedure_declaration.env_in};
     770      ${procedure_declaration.env_out} := Self.Compilation.Context.Environment_Set.
     771        Leave_Declarative_Region (${Parameter_Profile.env_out});
    771772.)
    772773
  • branches/invoke/src/ag/errors.ag

    r296 r316  
    11Synthesized attributes
     2  abort_statement,
     3  accept_statement,
    24  access_definition,
    35  allocator,
     
    57  anonymous_access_to_object_definition,
    68  anonymous_access_to_procedure_definition,
     9  assignment_statement,
     10  asynchronous_select,
    711  attribute_reference,
     12  block_statement,
    813  case_expression,
     14  case_statement,
    915  character_literal,
    1016  clause_name,
     
    1622  defining_identifier,
    1723  defining_program_unit_name,
     24  delay_statement,
    1825  delta_constraint,
    1926  digits_constraint,
    2027  direct_name,
     28  discrete_range_attribute_reference,
     29  discrete_simple_expression_range,
    2130  discrete_subtype_definition,
    2231  discrete_subtype_indication,
    23   discrete_range_attribute_reference,
    24   discrete_simple_expression_range,
     32  exit_statement,
    2533  explicit_dereference,
    2634  expression,
     35  extended_return_statement,
    2736  extension_aggregate,
     37  for_loop_statement,
    2838  function_call,
     39  goto_statement,
    2940  identifier,
    3041  if_expression,
     42  if_statement,
     43  label_decorator,
     44  loop_statement,
    3145  membership_test,
    3246  name,
    3347  null_literal,
     48  null_statement,
    3449  numeric_literal,
    3550  object_declaration,
     
    3853  package_declaration,
    3954  parameter_specification,
     55  pragma_node,
    4056  prefix,
     57  procedure_call_statement,
    4158  program_unit_name,
    4259  qualified_expression,
    4360  quantified_expression,
     61  raise_statement,
    4462  range_attribute_reference,
    4563  range_constraint,
    4664  record_aggregate,
     65  requeue_statement,
    4766  scalar_constraint,
    4867  selected_component,
    4968  selected_identifier,
     69  selective_accept,
    5070  short_circuit,
    5171  simple_expression,
    5272  simple_expression_range,
     73  simple_return_statement,
     74  statement,
    5375  subtype_indication,
    5476  subtype_indication_or_access_definition,
    5577  subtype_mark,
    5678  subtype_mark_or_access_definition,
     79  terminate_alternative_statement,
    5780  unconstrained_array_definition,
     81  while_loop_statement,
    5882  Discrete_Subtype_Definitions,
    59   Index_Subtype_Definitions
     83  Index_Subtype_Definitions,
     84  Body_Statements
    6085
    6186   : Gela.Semantic_Types.Error_Set_Index : Errors;
     
    196221      ${Discrete_Subtype_Definitions.Errors} := ${discrete_subtype_definition.Errors};
    197222.)
     223Rules for Body_Statements.statement :
     224(.
     225      ${Body_Statements.Errors} := 0;
     226.)
     227Rules for Body_Statements.statement :
     228(.
     229      ${Body_Statements.Errors} := ${statement.Errors};
     230.)
    198231Rules for unconstrained_array_definition. :
    199232(.
     
    249282      ${defining_identifier.Errors} := 0;
    250283.)
     284Rules for abort_statement. :
     285(.
     286      ${abort_statement.Errors} := 0;  --  FIXME
     287.)
     288Rules for accept_statement. :
     289(.
     290      ${accept_statement.Errors} := 0;  --  FIXME
     291.)
     292Rules for assignment_statement. :
     293(.
     294      ${assignment_statement.Errors} := 0;  --  FIXME
     295.)
     296Rules for asynchronous_select. :
     297(.
     298      ${asynchronous_select.Errors} := 0;  --  FIXME
     299.)
     300Rules for block_statement. :
     301(.
     302      ${block_statement.Errors} := 0;  --  FIXME
     303.)
     304Rules for case_statement. :
     305(.
     306      ${case_statement.Errors} := 0;  --  FIXME
     307.)
     308Rules for delay_statement. :
     309(.
     310      ${delay_statement.Errors} := 0;  --  FIXME
     311.)
     312Rules for exit_statement. :
     313(.
     314      ${exit_statement.Errors} := 0;  --  FIXME
     315.)
     316Rules for extended_return_statement. :
     317(.
     318      ${extended_return_statement.Errors} := 0;  --  FIXME
     319.)
     320Rules for for_loop_statement. :
     321(.
     322      ${for_loop_statement.Errors} := 0;  --  FIXME
     323.)
     324Rules for goto_statement. :
     325(.
     326      ${goto_statement.Errors} := 0;  --  FIXME
     327.)
     328Rules for if_statement. :
     329(.
     330      ${if_statement.Errors} := 0;  --  FIXME
     331.)
     332Rules for label_decorator. :
     333(.
     334      ${label_decorator.Errors} := 0;  --  FIXME
     335.)
     336Rules for loop_statement. :
     337(.
     338      ${loop_statement.Errors} := 0;  --  FIXME
     339.)
     340Rules for null_statement. :
     341(.
     342      ${null_statement.Errors} := 0;  --  FIXME
     343.)
     344Rules for pragma_node. :
     345(.
     346      ${pragma_node.Errors} := 0;  --  FIXME
     347.)
     348Rules for procedure_call_statement. :
     349(.
     350      ${procedure_call_statement.Errors} := 0;  --  FIXME
     351.)
     352Rules for raise_statement. :
     353(.
     354      ${raise_statement.Errors} := 0;  --  FIXME
     355.)
     356Rules for requeue_statement. :
     357(.
     358      ${requeue_statement.Errors} := 0;  --  FIXME
     359.)
     360Rules for selective_accept. :
     361(.
     362      ${selective_accept.Errors} := 0;  --  FIXME
     363.)
     364Rules for simple_return_statement. :
     365(.
     366      ${simple_return_statement.Errors} := 0;  --  FIXME
     367.)
     368Rules for terminate_alternative_statement. :
     369(.
     370      ${terminate_alternative_statement.Errors} := 0;  --  FIXME
     371.)
     372Rules for while_loop_statement. :
     373(.
     374      ${while_loop_statement.Errors} := 0;  --  FIXME
     375.)
  • branches/invoke/src/semantic/gela-pass_utils.adb

    r314 r316  
    99
    1010with Gela.Element_Visiters;
     11with Gela.Elements.Compilation_Unit_Bodies;
    1112with Gela.Elements.Compilation_Unit_Declarations;
    1213with Gela.Elements.Context_Items;
     
    1516with Gela.Elements.Identifiers;
    1617with Gela.Elements.Package_Declarations;
     18with Gela.Elements.Procedure_Bodies;
    1719with Gela.Elements.Program_Unit_Names;
    1820with Gela.Elements.Selected_Identifiers;
     
    2022with Gela.Elements.Type_Definitions;
    2123with Gela.Elements.Use_Package_Clauses;
     24with Gela.Elements.With_Clauses;
    2225with Gela.Environments;
    2326with Gela.Plain_Type_Managers;
     
    5053         end record;
    5154
     55         overriding procedure Compilation_Unit_Body
     56           (Self : in out Visiter;
     57            Node : not null Gela.Elements.Compilation_Unit_Bodies.
     58              Compilation_Unit_Body_Access);
     59
    5260         overriding procedure Compilation_Unit_Declaration
    5361           (Self : in out Visiter;
     
    6472              Package_Declaration_Access);
    6573
     74         overriding procedure Procedure_Body
     75           (Self : in out Visiter;
     76            Node : not null Gela.Elements.Procedure_Bodies.
     77              Procedure_Body_Access);
     78
    6679         overriding procedure Selected_Identifier
    6780           (Self : in out Visiter;
     
    7487              Use_Package_Clause_Access);
    7588
     89         overriding procedure With_Clause  --  Use env.out instead
     90           (Self : in out Visiter;
     91            Node : not null Gela.Elements.With_Clauses.With_Clause_Access);
    7692      end Get;
    7793
    7894      package body Get is
     95
     96         overriding procedure Compilation_Unit_Body
     97           (Self : in out Visiter;
     98            Node : not null Gela.Elements.Compilation_Unit_Bodies.
     99              Compilation_Unit_Body_Access)
     100         is
     101            List : constant Gela.Elements.Context_Items.
     102              Context_Item_Sequence_Access := Node.Context_Clause_Elements;
     103
     104            Cursor : Gela.Elements.Element_Sequence_Cursor'Class := List.First;
     105         begin
     106            while Cursor.Has_Element loop
     107               Cursor.Element.Visit (Self);
     108               Cursor.Next;
     109            end loop;
     110         end Compilation_Unit_Body;
    79111
    80112         overriding procedure Compilation_Unit_Declaration
     
    109141         end Package_Declaration;
    110142
     143         overriding procedure Procedure_Body
     144           (Self : in out Visiter;
     145            Node : not null Gela.Elements.Procedure_Bodies.
     146              Procedure_Body_Access) is
     147         begin
     148            Node.Parent.Visit (Self);
     149         end Procedure_Body;
     150
    111151         overriding procedure Selected_Identifier
    112152           (Self : in out Visiter;
     
    141181            end loop;
    142182         end Use_Package_Clause;
     183
     184         overriding procedure With_Clause  --  Use env.out instead
     185           (Self : in out Visiter;
     186            Node : not null Gela.Elements.With_Clauses.With_Clause_Access)
     187         is
     188            pragma Unreferenced (Self);
     189            use type Gela.Lexical_Types.Symbol_List;
     190
     191            List : Gela.Lexical_Types.Symbol_List := Node.With_List;
     192            Set : constant Gela.Environments.Environment_Set_Access :=
     193              Comp.Context.Environment_Set;
     194         begin
     195            while List /= Gela.Lexical_Types.Empty_Symbol_List loop
     196               Env := Set.Add_With_Clause
     197                 (Index  => Env,
     198                  Symbol => Comp.Context.Symbols.Tail (List));
     199               List := Comp.Context.Symbols.Head (List);
     200            end loop;
     201         end With_Clause;
     202
    143203      end Get;
    144204
  • branches/invoke/src/semantic/gela-plain_environments.adb

    r315 r316  
     1--  with Gela.Plain_Environments.Debug;
     2
    13package body Gela.Plain_Environments is
    24
     
    191193
    192194         Env  : constant Env_Item := Self.Set.Env.Element (Self.Env);
    193          Next : Region_Item_Count := Env.Nested_Region_List;
    194       begin
    195          while Next /= 0 loop
    196             if Self.Set.Region.Head (Next).Name = Name then
    197                return Next;
    198             end if;
    199 
    200             Next := Self.Set.Region.Tail (Next);
    201          end loop;
    202 
    203          Next := Env.Other_Region_List;
    204 
    205          while Next /= 0 loop
    206             if Self.Set.Region.Head (Next).Name = Name then
    207                return Next;
    208             end if;
    209 
    210             Next := Self.Set.Region.Tail (Next);
     195         Next : Region_Item_Count;
     196      begin
     197         for J of Env.Region_List loop
     198            Next := J;
     199            while Next /= 0 loop
     200               if Self.Set.Region.Head (Next).Name = Name then
     201                  return Next;
     202               end if;
     203
     204               Next := Self.Set.Region.Tail (Next);
     205            end loop;
    211206         end loop;
    212207
    213208         return 0;
    214209      end Name_To_Region;
     210
     211      ----------------
     212      -- Initialize --
     213      ----------------
    215214
    216215      procedure Initialize
     
    221220         use type Defining_Name_Item_Count;
    222221
     222         Env    : constant Env_Item := Self.Set.Env.Element (Self.Env);
    223223         Target : Region_Item_Count;
    224224         Local  : Gela.Name_List_Managers.List;
    225225      begin
    226          Self.Region := Self.Set.Env.Element (Self.Env).Nested_Region_List;
     226         Self.Region := Env.Region_List (Nested);
    227227
    228228         while Self.Region /= 0 loop
     
    294294         Env := Self.Env.Element (Index);
    295295      else
    296          Env := (Nested_Region_List => 0, Other_Region_List => 0);
    297       end if;
    298 
    299       if Env.Nested_Region_List = 0 then
     296         Env := (Region_List => (Nested => 0, Other => 0, Withed => 0));
     297      end if;
     298
     299      if Env.Region_List (Nested) = 0 then
    300300         Reg := (Name => null,
    301301                 Local => Self.Names.Empty_List,
    302302                 Use_Package => 0);
    303303      else
    304          Reg := Self.Region.Head (Env.Nested_Region_List);
     304         Reg := Self.Region.Head (Env.Region_List (Nested));
    305305      end if;
    306306
     
    311311         Output => Reg.Local);
    312312
    313       if Env.Nested_Region_List = 0 then
     313      if Env.Region_List (Nested) = 0 then
    314314         --  Create Nested_Region_List as (Reg)
    315315         Self.Region.Prepend
    316316           (Value  => Reg,
    317317            Input  => 0,
    318             Output => Env.Nested_Region_List);
     318            Output => Env.Region_List (Nested));
    319319      else
    320320         --  Replace head of Nested_Region_List with Reg
    321321         Self.Region.Prepend
    322322           (Value  => Reg,
    323             Input  => Self.Region.Tail (Env.Nested_Region_List),
    324             Output => Env.Nested_Region_List);
     323            Input  => Self.Region.Tail (Env.Region_List (Nested)),
     324            Output => Env.Region_List (Nested));
    325325      end if;
    326326
     
    350350      Env_Index : Gela.Semantic_Types.Env_Index;
    351351      Env : Env_Item := Self.Env.Element (Index);
    352       Reg : Region_Item := Self.Region.Head (Env.Nested_Region_List);
     352      Reg : Region_Item := Self.Region.Head (Env.Region_List (Nested));
    353353   begin
    354354      Self.Use_Package.Prepend
     
    360360      Self.Region.Prepend
    361361        (Value  => Reg,
    362          Input  => Self.Region.Tail (Env.Nested_Region_List),
    363          Output => Env.Nested_Region_List);
     362         Input  => Self.Region.Tail (Env.Region_List (Nested)),
     363         Output => Env.Region_List (Nested));
    364364
    365365      Env_Index := Self.Env.Find_Index (Env);
     
    381381      Index  : Gela.Semantic_Types.Env_Index;
    382382      Symbol : Gela.Lexical_Types.Symbol)
    383       return Gela.Semantic_Types.Env_Index is
    384    begin
    385       return Self.Lib.Add_With_Clause (Index, Symbol);
     383      return Gela.Semantic_Types.Env_Index
     384   is
     385      procedure Append (Item : Region_Item);
     386
     387      Env_Index : Gela.Semantic_Types.Env_Index;
     388      Env    : Env_Item := Self.Env.Element (Index);
     389      Target : Gela.Semantic_Types.Env_Index :=
     390        Self.Library_Unit_Environment (Symbol);
     391      Target_Env : Env_Item;
     392      List   : Region_Item_Count;
     393
     394      procedure Append (Item : Region_Item) is
     395      begin
     396         Self.Region.Prepend
     397           (Value  => Item,
     398            Input  => Env.Region_List (Withed),
     399            Output => Env.Region_List (Withed));
     400      end Append;
     401
     402   begin
     403      Target := Self.Leave_Declarative_Region (Target);
     404      Target_Env := Self.Env.Element (Target);
     405      List := Target_Env.Region_List (Other);
     406
     407--        Gela.Plain_Environments.Debug
     408--          (Self  => Self'Access,
     409--           Index => Target);
     410--
     411      Self.Region.For_Each (List, Append'Access);
     412
     413      Env_Index := Self.Env.Find_Index (Env);
     414
     415      if Env_Index = 0 then
     416         Self.Env.Append (Env);
     417         Env_Index := Self.Env.Last_Index;
     418      end if;
     419
     420      return Env_Index;
    386421   end Add_With_Clause;
    387422
     
    411446      return Result : Direct_Visible_Cursors.Defining_Name_Cursor :=
    412447        (Set    => Plain_Environment_Set_Access (Self),
    413          Region => Env.Nested_Region_List,
     448         Region => Env.Region_List (Nested),
    414449         others => <>)
    415450      do
     
    449484         Env := Self.Env.Element (Index);
    450485      else
    451          Env := (Nested_Region_List => 0, Other_Region_List => 0);
     486         Env := (Region_List => (Nested => 0, Other => 0, Withed => 0));
    452487      end if;
    453488
    454489      Self.Region.Prepend
    455490        (Value  => Next,
    456          Input  => Env.Nested_Region_List,
    457          Output => Env.Nested_Region_List);
     491         Input  => Env.Region_List (Nested),
     492         Output => Env.Region_List (Nested));
    458493
    459494--     Shall we delete region with the same Name from Other_Region_List?
     
    505540      Env    : Env_Item := Self.Env.Element (Index);
    506541      Region : constant Region_Item :=
    507         Self.Region.Head (Env.Nested_Region_List);
     542        Self.Region.Head (Env.Region_List (Nested));
    508543   begin
    509544      --  Push top region to Other_Region_List
    510545      Self.Region.Prepend
    511546        (Value  => Region,
    512          Input  => Env.Other_Region_List,
    513          Output => Env.Other_Region_List);
     547         Input  => Env.Region_List (Other),
     548         Output => Env.Region_List (Other));
    514549
    515550      --  Pop top region from Nested_Region_List
    516       Env.Nested_Region_List := Self.Region.Tail (Env.Nested_Region_List);
     551      Env.Region_List (Nested) := Self.Region.Tail (Env.Region_List (Nested));
    517552
    518553      Found := Self.Env.Find_Index (Env);
  • branches/invoke/src/semantic/gela-plain_environments.ads

    r315 r316  
    4747   --  Env_Item  --
    4848
     49   type Region_Enum is (Nested, Other, Withed);
     50   --  Nested - List of nested regions, current - first
     51   --  Other  - List of all visible regions except Nested_Region_List
     52   --  Withed - List of regions available over with clauses
     53
     54   type Region_List_Array is array (Region_Enum) of Region_Item_Count;
    4955   type Env_Item is record
    50       Nested_Region_List : Region_Item_Count;
    51       --  List of nested region, current - first
    52       Other_Region_List  : Region_Item_Count;
    53       --  List of all visible regions except Nested_Region_List
     56      Region_List : Region_List_Array;
    5457   end record;
    5558
Note: See TracChangeset for help on using the changeset viewer.