Changeset 398


Ignore:
Timestamp:
Feb 15, 2015, 3:00:58 PM (6 years ago)
Author:
Maxim Reznik
Message:

Create completion region for package_body

Location:
trunk/ada-2012
Files:
13 edited

Legend:

Unmodified
Added
Removed
  • trunk/ada-2012/src/ag/env_in.ag

    r397 r398  
    20582058Rules for package_body. :
    20592059(.
    2060       ${Body_Declarative_Items.env_in} := ${package_body.env_in};
     2060      ${Body_Declarative_Items.env_in} :=
     2061        Gela.Pass_Utils.Create_Completion_Region
     2062          (Self.Compilation,
     2063           ${package_body.env_in},
     2064           ${Names.full_name});
    20612065.)
    20622066
    20632067Rules for package_body. :
    20642068(.
    2065       ${Body_Statements.env_in} := ${package_body.env_in};
     2069      ${Body_Statements.env_in} := ${Body_Declarative_Items.env_out};
    20662070.)
    20672071
    20682072Rules for package_body. :
    20692073(.
    2070       ${Exception_Handlers.env_in} := ${package_body.env_in};
     2074      ${Exception_Handlers.env_in} := ${Body_Declarative_Items.env_out};
    20712075.)
    20722076
  • trunk/ada-2012/src/ag/env_out.ag

    r397 r398  
    905905Rules for use_package_clause. :
    906906(.
    907       ${use_package_clause.env_out} := ${use_package_clause.env_in};
     907      ${use_package_clause.env_out} := Gela.Pass_Utils.Add_Use_Package
     908        (Self.Compilation,
     909         ${use_package_clause.env_in},
     910         Node);
    908911.)
    909912
  • trunk/ada-2012/src/api/gela-environments.ads

    r318 r398  
    7272   --  with given Symbol which visible inside declarative region corresponding
    7373   --  to given Region name. Return Found = False if no such region found.
     74   --  If Region is null, use current (top) region to search in.
    7475
    7576   not overriding function Add_Defining_Name
     
    99100   --  Return index of created environment
    100101
     102   not overriding function Enter_Completion_Region
     103     (Self   : access Environment_Set;
     104      Index  : Gela.Semantic_Types.Env_Index;
     105      Region : Gela.Elements.Defining_Names.Defining_Name_Access)
     106      return Gela.Semantic_Types.Env_Index is abstract;
     107   --  Create new environment by extending provided env with completion of
     108   --  declarative region named by Region defining name.
     109   --  Return index of created environment
     110
    101111   not overriding function Leave_Declarative_Region
    102112     (Self   : access Environment_Set;
  • trunk/ada-2012/src/asis/asis-extensions-flat_kinds.adb

    r397 r398  
    119119with Gela.Elements.Membership_Tests;
    120120with Gela.Elements.Modular_Type_Definitions;
     121with Gela.Elements.Names;
    121122with Gela.Elements.Null_Components;
    122123with Gela.Elements.Null_Literals;
     
    231232   overriding procedure Allocator
    232233     (Self : in out Visiter;
    233       Node : not null Gela.Elements.Allocators.Allocator_Access)
    234    is null;
     234      Node : not null Gela.Elements.Allocators.Allocator_Access);
    235235
    236236   overriding procedure Anonymous_Access_To_Function_Definition
     
    810810   overriding procedure Membership_Test
    811811     (Self : in out Visiter;
    812       Node : not null Gela.Elements.Membership_Tests.Membership_Test_Access)
    813    is null;
     812      Node : not null Gela.Elements.Membership_Tests.Membership_Test_Access);
    814813
    815814   overriding procedure Modular_Type_Definition
     
    878877     (Self : in out Visiter;
    879878      Node : not null Gela.Elements.Package_Body_Stubs.
    880         Package_Body_Stub_Access)
    881    is null;
     879        Package_Body_Stub_Access);
    882880
    883881   overriding procedure Package_Declaration
     
    983981     (Self : in out Visiter;
    984982      Node : not null Gela.Elements.Qualified_Expressions.
    985         Qualified_Expression_Access)
    986    is null;
     983        Qualified_Expression_Access);
    987984
    988985   overriding procedure Quantified_Expression
     
    1000997     (Self : in out Visiter;
    1001998      Node : not null Gela.Elements.Range_Attribute_References.
    1002         Range_Attribute_Reference_Access)
    1003    is null;
     999        Range_Attribute_Reference_Access);
    10041000
    10051001   overriding procedure Range_Attribute_Reference_Dr
     
    11191115   overriding procedure Task_Body_Stub
    11201116     (Self : in out Visiter;
    1121       Node : not null Gela.Elements.Task_Body_Stubs.Task_Body_Stub_Access)
    1122    is null;
     1117      Node : not null Gela.Elements.Task_Body_Stubs.Task_Body_Stub_Access);
    11231118
    11241119   overriding procedure Task_Definition
     
    12031198   end Access_To_Object_Definition;
    12041199
     1200   overriding procedure Allocator
     1201     (Self : in out Visiter;
     1202      Node : not null Gela.Elements.Allocators.Allocator_Access)
     1203   is
     1204      Name : constant Gela.Elements.Names.Name_Access :=
     1205        Node.Subtype_Or_Expression;
     1206   begin
     1207      Name.Visit (Self);
     1208
     1209      case Self.Result is
     1210         when A_Qualified_Expression =>
     1211            Self.Result := An_Allocation_From_Qualified_Expression;
     1212         when others =>
     1213            Self.Result := An_Allocation_From_Subtype;
     1214      end case;
     1215   end Allocator;
     1216
    12051217   overriding procedure Anonymous_Access_To_Object_Definition
    12061218     (Self : in out Visiter;
     
    12421254   is
    12431255      package X renames Gela.Lexical_Types.Predefined_Symbols;
    1244 
    1245       Id : constant Gela.Elements.Identifiers.Identifier_Access :=
     1256      use type Gela.Lexical_Types.Token_Count;
     1257
     1258      Id    : constant Gela.Elements.Identifiers.Identifier_Access :=
    12461259        Node.Attribute_Designator_Identifier;
    1247       Comp    : constant Gela.Compilations.Compilation_Access :=
     1260      Comp  : constant Gela.Compilations.Compilation_Access :=
    12481261        Node.Enclosing_Compilation;
    1249       Token : constant Gela.Lexical_Types.Token :=
    1250         Comp.Get_Token (Id.Identifier_Token);
    1251       Map : constant array (Gela.Lexical_Types.Symbol range
     1262      Token : Gela.Lexical_Types.Token;
     1263      Map   : constant array (Gela.Lexical_Types.Symbol range
    12521264                              X.Access_Symbol .. X.Write) of Element_Flat_Kind
    12531265        :=
     
    13471359           X.Write => A_Write_Attribute);
    13481360   begin
     1361      if Node.Range_Token /= 0 then
     1362         Self.Result := A_Range_Attribute;
     1363
     1364         return;
     1365      end if;
     1366
     1367      Token := Comp.Get_Token (Id.Identifier_Token);
     1368
    13491369      if Token.Symbol in Map'Range then
    13501370         Self.Result := Map (Token.Symbol);
     
    17931813   end Loop_Statement;
    17941814
     1815   overriding procedure Membership_Test
     1816     (Self : in out Visiter;
     1817      Node : not null Gela.Elements.Membership_Tests.Membership_Test_Access)
     1818   is
     1819      use type Gela.Lexical_Types.Token_Count;
     1820   begin
     1821      if Node.Not_Token = 0 then
     1822         Self.Result := An_In_Range_Membership_Test;
     1823      else
     1824         Self.Result := A_Not_In_Range_Membership_Test;
     1825      end if;
     1826   end Membership_Test;
     1827
    17951828   overriding procedure Null_Component
    17961829     (Self : in out Visiter;
     
    18961929      Self.Result := A_Package_Body_Declaration;
    18971930   end Package_Body;
     1931
     1932   overriding procedure Package_Body_Stub
     1933     (Self : in out Visiter;
     1934      Node : not null Gela.Elements.Package_Body_Stubs.
     1935        Package_Body_Stub_Access)
     1936   is
     1937      pragma Unreferenced (Node);
     1938   begin
     1939      Self.Result := A_Package_Body_Stub;
     1940   end Package_Body_Stub;
    18981941
    18991942   overriding procedure Package_Declaration
     
    20882131   end Protected_Definition;
    20892132
     2133   overriding procedure Qualified_Expression
     2134     (Self : in out Visiter;
     2135      Node : not null Gela.Elements.Qualified_Expressions.
     2136        Qualified_Expression_Access)
     2137   is
     2138      pragma Unreferenced (Node);
     2139   begin
     2140      Self.Result := A_Qualified_Expression;
     2141   end Qualified_Expression;
     2142
     2143   overriding procedure Range_Attribute_Reference
     2144     (Self : in out Visiter;
     2145      Node : not null Gela.Elements.Range_Attribute_References.
     2146        Range_Attribute_Reference_Access)
     2147   is
     2148      pragma Unreferenced (Node);
     2149   begin
     2150      Self.Result := A_Range_Attribute_Reference;
     2151   end Range_Attribute_Reference;
     2152
    20902153   overriding procedure Record_Aggregate
    20912154     (Self : in out Visiter;
     
    22792342   end Task_Body;
    22802343
     2344   overriding procedure Task_Body_Stub
     2345     (Self : in out Visiter;
     2346      Node : not null Gela.Elements.Task_Body_Stubs.Task_Body_Stub_Access)
     2347   is
     2348      pragma Unreferenced (Node);
     2349   begin
     2350      Self.Result := A_Task_Body_Stub;
     2351   end Task_Body_Stub;
     2352
    22812353   overriding procedure Task_Definition
    22822354     (Self : in out Visiter;
  • trunk/ada-2012/src/asis/asis-iterator.adb

    r343 r398  
    1010     Natural :=
    1111       (Asis.Extensions.Flat_Kinds.A_Procedure_Body_Declaration => 16,
     12        Asis.Extensions.Flat_Kinds.A_Package_Declaration => 9,
     13        Asis.Extensions.Flat_Kinds.A_Package_Body_Declaration => 12,
    1214        others => 0);
    1315
  • trunk/ada-2012/src/semantic/gela-debug_properties.adb

    r396 r398  
    1616
    1717      type Property is (Up, Down, Env_In, Env_Out, Full_Name);
    18       pragma Unreferenced (Env_Out);
    1918
    2019      type Property_Flags is array (Property) of Boolean;
     
    3130
    3231      overriding procedure On_Env_In
     32        (Self    : in out Property_Visiter;
     33         Element : Gela.Elements.Element_Access;
     34         Value   : Gela.Semantic_Types.Env_Index);
     35
     36      overriding procedure On_Env_Out
    3337        (Self    : in out Property_Visiter;
    3438         Element : Gela.Elements.Element_Access;
     
    123127            Value);
    124128      end On_Env_In;
     129
     130      overriding procedure On_Env_Out
     131        (Self    : in out Property_Visiter;
     132         Element : Gela.Elements.Element_Access;
     133         Value   : Gela.Semantic_Types.Env_Index)
     134      is
     135         Comp : constant Gela.Compilations.Compilation_Access :=
     136           Element.Enclosing_Compilation;
     137         Env : constant Gela.Environments.Environment_Set_Access :=
     138           Comp.Context.Environment_Set;
     139      begin
     140         if Self.Flags (Env_Out) = False then
     141            return;
     142         end if;
     143
     144         Put_Line
     145           ("env_out:" &
     146              Gela.Semantic_Types.Env_Index'Image (Value));
     147
     148         Gela.Plain_Environments.Debug
     149           (Gela.Plain_Environments.Plain_Environment_Set_Access (Env),
     150            Value);
     151      end On_Env_Out;
    125152
    126153      overriding procedure On_Full_Name
  • trunk/ada-2012/src/semantic/gela-library_environments.adb

    r318 r398  
    662662   end Empty_Environment;
    663663
     664   -----------------------------
     665   -- Enter_Completion_Region --
     666   -----------------------------
     667
     668   overriding function Enter_Completion_Region
     669     (Self   : access Environment_Set;
     670      Index  : Gela.Semantic_Types.Env_Index;
     671      Region : Gela.Elements.Defining_Names.Defining_Name_Access)
     672      return Gela.Semantic_Types.Env_Index is
     673   begin
     674      raise Program_Error;
     675      return Self.Enter_Completion_Region (Index, Region);
     676   end Enter_Completion_Region;
     677
    664678   ------------------------------
    665679   -- Enter_Declarative_Region --
     
    768782      Set    : Gela.Symbol_Sets.Symbol_Set_Access;
    769783   begin
    770       if Index /= Library_Env then
     784      if Index /= Library_Env or not Region.Assigned then
    771785         return Library_Cursor.Defining_Name_Cursor'(Name => null);
    772786      end if;
  • trunk/ada-2012/src/semantic/gela-library_environments.ads

    r318 r398  
    6060      return Gela.Semantic_Types.Env_Index;
    6161
     62   overriding function Enter_Completion_Region
     63     (Self   : access Environment_Set;
     64      Index  : Gela.Semantic_Types.Env_Index;
     65      Region : Gela.Elements.Defining_Names.Defining_Name_Access)
     66      return Gela.Semantic_Types.Env_Index;
     67
    6268   overriding function Enter_Declarative_Region
    6369     (Self   : access Environment_Set;
  • trunk/ada-2012/src/semantic/gela-pass_utils.adb

    r383 r398  
    2727with Gela.Elements.Subtype_Mark_Or_Access_Definitions;
    2828with Gela.Elements.Type_Definitions;
    29 with Gela.Elements.Use_Package_Clauses;
    3029with Gela.Elements.With_Clauses;
    3130with Gela.Environments;
     
    5655      Env    : in out Gela.Semantic_Types.Env_Index);
    5756
     57   package Each_Use_Package is
     58      --  Iterate over each name in use package clause and add it to Env
     59
     60      type Visiter is new Gela.Element_Visiters.Visiter with record
     61         Set  : Gela.Environments.Environment_Set_Access;
     62         Env  : Gela.Semantic_Types.Env_Index;
     63         Name : Gela.Elements.Defining_Names.Defining_Name_Access;
     64      end record;
     65
     66      overriding procedure Identifier
     67        (Self : in out Visiter;
     68         Node : not null Gela.Elements.Identifiers.Identifier_Access);
     69
     70      overriding procedure Selected_Identifier
     71        (Self : in out Visiter;
     72         Node : not null Gela.Elements.Selected_Identifiers.
     73           Selected_Identifier_Access);
     74
     75      overriding procedure Use_Package_Clause
     76        (Self : in out Visiter;
     77         Node : not null Gela.Elements.Use_Package_Clauses.
     78           Use_Package_Clause_Access);
     79   end Each_Use_Package;
     80
     81   package body Each_Use_Package is
     82      overriding procedure Identifier
     83        (Self : in out Visiter;
     84         Node : not null Gela.Elements.Identifiers.Identifier_Access) is
     85      begin
     86         Self.Name := Node.Defining_Name;
     87      end Identifier;
     88
     89      overriding procedure Selected_Identifier
     90        (Self : in out Visiter;
     91         Node : not null Gela.Elements.Selected_Identifiers.
     92           Selected_Identifier_Access)
     93      is
     94         Selector : constant Gela.Elements.Selector_Names.
     95           Selector_Name_Access := Node.Selector;
     96      begin
     97         Selector.Visit (Self);
     98      end Selected_Identifier;
     99
     100      overriding procedure Use_Package_Clause
     101        (Self : in out Visiter;
     102         Node : not null Gela.Elements.Use_Package_Clauses.
     103           Use_Package_Clause_Access)
     104      is
     105         List : constant Gela.Elements.Program_Unit_Names.
     106           Program_Unit_Name_Sequence_Access := Node.Clause_Names;
     107         Cursor : Gela.Elements.Element_Sequence_Cursor'Class := List.First;
     108      begin
     109         while Cursor.Has_Element loop
     110            Cursor.Element.Visit (Self);
     111
     112            Self.Env := Self.Set.Add_Use_Package
     113              (Index => Self.Env,
     114               Name  => Self.Name);
     115
     116            Cursor.Next;
     117         end loop;
     118      end Use_Package_Clause;
     119
     120   end Each_Use_Package;
     121
    58122   procedure Add_Library_Level_Use_Clauses
    59123     (Comp   : Gela.Compilations.Compilation_Access;
     
    64128      package Get is
    65129
    66          type Visiter is new Gela.Element_Visiters.Visiter with record
    67             Name : Gela.Elements.Defining_Names.Defining_Name_Access;
    68          end record;
     130         type Visiter is new Each_Use_Package.Visiter with null record;
    69131
    70132         overriding procedure Compilation_Unit_Body
     
    78140              Compilation_Unit_Declaration_Access);
    79141
    80          overriding procedure Identifier
    81            (Self : in out Visiter;
    82             Node : not null Gela.Elements.Identifiers.Identifier_Access);
    83 
    84142         overriding procedure Package_Declaration
    85143           (Self : in out Visiter;
     
    91149            Node : not null Gela.Elements.Procedure_Bodies.
    92150              Procedure_Body_Access);
    93 
    94          overriding procedure Selected_Identifier
    95            (Self : in out Visiter;
    96             Node : not null Gela.Elements.Selected_Identifiers.
    97               Selected_Identifier_Access);
    98 
    99          overriding procedure Use_Package_Clause
    100            (Self : in out Visiter;
    101             Node : not null Gela.Elements.Use_Package_Clauses.
    102               Use_Package_Clause_Access);
    103151
    104152         overriding procedure With_Clause  --  Use env.out instead
     
    141189         end Compilation_Unit_Declaration;
    142190
    143          overriding procedure Identifier
    144            (Self : in out Visiter;
    145             Node : not null Gela.Elements.Identifiers.Identifier_Access) is
    146          begin
    147             Self.Name := Node.Defining_Name;
    148          end Identifier;
    149 
    150191         overriding procedure Package_Declaration
    151192           (Self : in out Visiter;
     
    164205         end Procedure_Body;
    165206
    166          overriding procedure Selected_Identifier
    167            (Self : in out Visiter;
    168             Node : not null Gela.Elements.Selected_Identifiers.
    169               Selected_Identifier_Access)
    170          is
    171             Selector : constant Gela.Elements.Selector_Names.
    172               Selector_Name_Access := Node.Selector;
    173          begin
    174             Selector.Visit (Self);
    175          end Selected_Identifier;
    176 
    177          overriding procedure Use_Package_Clause
    178            (Self : in out Visiter;
    179             Node : not null Gela.Elements.Use_Package_Clauses.
    180               Use_Package_Clause_Access)
    181          is
    182             Set : constant Gela.Environments.Environment_Set_Access :=
    183               Comp.Context.Environment_Set;
    184             List : constant Gela.Elements.Program_Unit_Names.
    185               Program_Unit_Name_Sequence_Access := Node.Clause_Names;
    186             Cursor : Gela.Elements.Element_Sequence_Cursor'Class := List.First;
    187          begin
    188             while Cursor.Has_Element loop
    189                Cursor.Element.Visit (Self);
    190 
    191                Env := Set.Add_Use_Package
    192                  (Index => Env,
    193                   Name  => Self.Name);
    194 
    195                Cursor.Next;
    196             end loop;
    197          end Use_Package_Clause;
    198 
    199207         overriding procedure With_Clause  --  Use env.out instead
    200208           (Self : in out Visiter;
    201209            Node : not null Gela.Elements.With_Clauses.With_Clause_Access)
    202210         is
    203             pragma Unreferenced (Self);
    204211            use type Gela.Lexical_Types.Symbol_List;
    205212
    206213            List : Gela.Lexical_Types.Symbol_List := Node.With_List;
    207             Set : constant Gela.Environments.Environment_Set_Access :=
    208               Comp.Context.Environment_Set;
    209214         begin
    210215            while List /= Gela.Lexical_Types.Empty_Symbol_List loop
    211                Env := Set.Add_With_Clause
    212                  (Index  => Env,
     216               Self.Env := Self.Set.Add_With_Clause
     217                 (Index  => Self.Env,
    213218                  Symbol => Comp.Context.Symbols.Head (List));
    214219               List := Comp.Context.Symbols.Tail (List);
     
    218223      end Get;
    219224
    220       V : Get.Visiter;
    221    begin
    222       Decl.Visit (V);
     225      Set : constant Gela.Environments.Environment_Set_Access :=
     226        Comp.Context.Environment_Set;
     227      Visiter : Get.Visiter := (Set, Env, null);
     228   begin
     229      Decl.Visit (Visiter);
     230      Env := Visiter.Env;
    223231   end Add_Library_Level_Use_Clauses;
    224232
     
    340348      return Env_2;
    341349   end Add_Names_Create_Region;
     350
     351   ---------------------
     352   -- Add_Use_Package --
     353   ---------------------
     354
     355   function Add_Use_Package
     356     (Comp : Gela.Compilations.Compilation_Access;
     357      Env  : Gela.Semantic_Types.Env_Index;
     358      Node : not null Gela.Elements.Use_Package_Clauses.
     359        Use_Package_Clause_Access)
     360      return Gela.Semantic_Types.Env_Index
     361   is
     362      Set : constant Gela.Environments.Environment_Set_Access :=
     363        Comp.Context.Environment_Set;
     364      Visiter : Each_Use_Package.Visiter := (Set, Env, null);
     365   begin
     366      Node.Visit (Visiter);
     367
     368      return Visiter.Env;
     369   end Add_Use_Package;
     370
     371   ------------------------------
     372   -- Create_Completion_Region --
     373   ------------------------------
     374
     375   function Create_Completion_Region
     376     (Comp   : Gela.Compilations.Compilation_Access;
     377      Env    : Gela.Semantic_Types.Env_Index;
     378      Symbol : Gela.Lexical_Types.Symbol)
     379      return Gela.Semantic_Types.Env_Index
     380   is
     381      Set   : constant Gela.Environments.Environment_Set_Access :=
     382        Comp.Context.Environment_Set;
     383      Name  : Gela.Elements.Defining_Names.Defining_Name_Access;
     384      Found : aliased Boolean := False;
     385      Pos   : constant Gela.Defining_Name_Cursors.Defining_Name_Cursor'Class :=
     386        Set.Visible (Env, null, Symbol, Found'Access);
     387   begin
     388      if Pos.Has_Element then
     389         Name := Pos.Element;
     390         return Set.Enter_Completion_Region (Env, Name);
     391      else
     392         return Env;
     393      end if;
     394   end Create_Completion_Region;
    342395
    343396   --------------------------------
  • trunk/ada-2012/src/semantic/gela-pass_utils.ads

    r370 r398  
    1212with Gela.Elements.Defining_Names;
    1313with Gela.Elements.Defining_Identifiers;
     14with Gela.Elements.Use_Package_Clauses;
    1415with Gela.Lexical_Types;
    1516with Gela.Semantic_Types;
     
    3839      return Gela.Semantic_Types.Env_Index;
    3940
     41   function Create_Completion_Region
     42     (Comp   : Gela.Compilations.Compilation_Access;
     43      Env    : Gela.Semantic_Types.Env_Index;
     44      Symbol : Gela.Lexical_Types.Symbol)
     45      return Gela.Semantic_Types.Env_Index;
     46
    4047   function Add_Names
    4148     (Comp         : Gela.Compilations.Compilation_Access;
     
    4653      return Gela.Semantic_Types.Env_Index;
    4754   --  Add (Symbol, Name) from List and Names to Env
     55
     56   function Add_Use_Package
     57     (Comp : Gela.Compilations.Compilation_Access;
     58      Env  : Gela.Semantic_Types.Env_Index;
     59      Node : not null Gela.Elements.Use_Package_Clauses.
     60        Use_Package_Clause_Access)
     61      return Gela.Semantic_Types.Env_Index;
     62   --  Add "use {Symbol};" to Env
    4863
    4964   function Add_Names_Create_Region
  • trunk/ada-2012/src/semantic/gela-plain_environments.adb

    r318 r398  
    33package body Gela.Plain_Environments is
    44
    5    package Direct_Visible_Cursors is
    6       --  Cursor over names in Local then go to enclosing region, etc
     5   function Name_To_Region
     6     (Self  : access Environment_Set'Class;
     7      Index : Gela.Semantic_Types.Env_Index;
     8      Name  : Gela.Elements.Defining_Names.Defining_Name_Access)
     9         return Region_Item_Count;
     10
     11   package Visible_Cursors is
     12      --  Cursor over names in Local
    713      type Defining_Name_Cursor is
    814        new Gela.Defining_Name_Cursors.Defining_Name_Cursor with
     
    1016            Set     : Plain_Environment_Set_Access;
    1117            Current : Gela.Name_List_Managers.Defining_Name_Cursor;
    12             Region  : Region_Item_Index;
    1318         end record;
    1419
     
    1924        (Self : Defining_Name_Cursor)
    2025      return Gela.Elements.Defining_Names.Defining_Name_Access;
     26
     27      overriding procedure Next
     28        (Self : in out Defining_Name_Cursor);
     29
     30      procedure Initialize
     31        (Self   : in out Defining_Name_Cursor'Class;
     32         Symbol : Gela.Lexical_Types.Symbol;
     33         Region : Region_Item_Index);
     34   end Visible_Cursors;
     35
     36   package body Visible_Cursors is
     37
     38      overriding function Has_Element
     39        (Self : Defining_Name_Cursor) return Boolean is
     40      begin
     41         return Self.Current.Has_Element;
     42      end Has_Element;
     43
     44      overriding function Element
     45        (Self : Defining_Name_Cursor)
     46         return Gela.Elements.Defining_Names.Defining_Name_Access is
     47      begin
     48         return Self.Current.Element;
     49      end Element;
     50
     51      overriding procedure Next (Self : in out Defining_Name_Cursor) is
     52      begin
     53         Self.Current.Next;
     54      end Next;
     55
     56      procedure Initialize
     57        (Self   : in out Defining_Name_Cursor'Class;
     58         Symbol : Gela.Lexical_Types.Symbol;
     59         Region : Region_Item_Index)
     60      is
     61         Local  : constant Gela.Name_List_Managers.List :=
     62           Self.Set.Region.Head (Region).Local;
     63      begin
     64         Self.Current := Self.Set.Names.Find (Local, Symbol);
     65      end Initialize;
     66
     67   end Visible_Cursors;
     68
     69   package Direct_Visible_Cursors is
     70      --  Cursor over names in Local then go to enclosing region, etc
     71      type Defining_Name_Cursor is
     72        new Visible_Cursors.Defining_Name_Cursor with
     73         record
     74            Region  : Region_Item_Index;
     75         end record;
    2176
    2277      overriding procedure Next
     
    3489   package body Direct_Visible_Cursors is
    3590
    36       overriding function Has_Element
    37         (Self : Defining_Name_Cursor) return Boolean is
    38       begin
    39          return Self.Current.Has_Element;
    40       end Has_Element;
    41 
    42       overriding function Element
    43         (Self : Defining_Name_Cursor)
    44          return Gela.Elements.Defining_Names.Defining_Name_Access is
    45       begin
    46          return Self.Current.Element;
    47       end Element;
    48 
    4991      overriding procedure Next (Self : in out Defining_Name_Cursor) is
    5092         Symbol : constant Gela.Lexical_Types.Symbol := Self.Current.Symbol;
    5193         Region : Region_Item_Count;
    52          Local  : Gela.Name_List_Managers.List;
    53       begin
    54          Self.Current.Next;
     94      begin
     95         Visible_Cursors.Defining_Name_Cursor (Self).Next;
     96
    5597         while not Self.Has_Element loop
    5698            Region := Self.Set.Region.Tail (Self.Region);
     
    58100            if Region in Region_Item_Index then
    59101               Self.Region := Region;
    60                Local := Self.Set.Region.Head (Self.Region).Local;
    61                Self.Current := Self.Set.Names.Find (Local, Symbol);
     102               Visible_Cursors.Initialize (Self, Symbol, Region);
    62103            else
    63104               return;
     
    66107      end Next;
    67108
    68       -------------------
    69       -- Internal_Next --
    70       -------------------
     109      ----------------
     110      -- Initialize --
     111      ----------------
    71112
    72113      procedure Initialize
     
    75116      is
    76117         Region : Region_Item_Count := Self.Region;
    77          Local  : Gela.Name_List_Managers.List;
    78118      begin
    79119         while Region in Region_Item_Index loop
    80             Local := Self.Set.Region.Head (Self.Region).Local;
    81120            Self.Region := Region;
    82             Self.Current := Self.Set.Names.Find (Local, Symbol);
     121            Visible_Cursors.Initialize (Self, Symbol, Region);
    83122
    84123            exit when Self.Has_Element;
     
    92131      --  Cursor over names in each used package
    93132      type Defining_Name_Cursor is
    94         new Gela.Defining_Name_Cursors.Defining_Name_Cursor with
     133        new Visible_Cursors.Defining_Name_Cursor with
    95134         record
    96             Set      : Plain_Environment_Set_Access;
    97             Current  : Gela.Name_List_Managers.Defining_Name_Cursor;
    98135            Env      : Env_Item_Index;
    99136            Region   : Region_Item_Count;
     
    103140         end record;
    104141
    105       overriding function Has_Element
    106         (Self : Defining_Name_Cursor) return Boolean;
    107 
    108       overriding function Element
    109         (Self : Defining_Name_Cursor)
    110          return Gela.Elements.Defining_Names.Defining_Name_Access;
    111 
    112142      overriding procedure Next
    113143        (Self : in out Defining_Name_Cursor);
     
    124154   end Use_Package_Cursors;
    125155
    126    ----------------------------
    127    -- Direct_Visible_Cursors --
    128    ----------------------------
     156   -------------------------
     157   -- Use_Package_Cursors --
     158   -------------------------
    129159
    130160   package body Use_Package_Cursors is
    131 
    132       overriding function Has_Element
    133         (Self : Defining_Name_Cursor) return Boolean is
    134       begin
    135          return Self.Current.Has_Element;
    136       end Has_Element;
    137 
    138       overriding function Element
    139         (Self : Defining_Name_Cursor)
    140          return Gela.Elements.Defining_Names.Defining_Name_Access is
    141       begin
    142          return Self.Current.Element;
    143       end Element;
    144161
    145162      overriding procedure Next (Self : in out Defining_Name_Cursor) is
     
    148165
    149166         Symbol : constant Gela.Lexical_Types.Symbol := Self.Current.Symbol;
    150          Local  : Gela.Name_List_Managers.List;
    151          Target : Region_Item_Count;
    152       begin
    153          Self.Current.Next;
     167         Region : Region_Item_Count;
     168      begin
     169         Visible_Cursors.Defining_Name_Cursor (Self).Next;
    154170
    155171         while not Self.Current.Has_Element loop
    156             Target := 0;
    157 
    158             while Target = 0 loop
     172            Region := 0;
     173
     174            while Region = 0 loop
    159175               --  Next name in use clauses of Region
    160176               Self.Use_Name := Self.Set.Use_Package.Tail (Self.Use_Name);
     
    171187               end loop;
    172188
    173                Target := Self.Name_To_Region
     189               Region := Self.Name_To_Region
    174190                 (Self.Set.Use_Package.Head (Self.Use_Name));
    175191            end loop;
    176192
    177             Local := Self.Set.Region.Head (Target).Local;
    178             Self.Current := Self.Set.Names.Find (Local, Symbol);
     193            Visible_Cursors.Initialize (Self, Symbol, Region);
    179194         end loop;
    180195      end Next;
     
    187202        (Self : Defining_Name_Cursor;
    188203         Name : Gela.Elements.Defining_Names.Defining_Name_Access)
    189          return Region_Item_Count
    190       is
    191          use type Region_Item_Count;
    192          use type Gela.Elements.Defining_Names.Defining_Name_Access;
    193 
    194          Env  : constant Env_Item := Self.Set.Env.Element (Self.Env);
    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;
    206          end loop;
    207 
    208          return 0;
     204         return Region_Item_Count is
     205      begin
     206         return Name_To_Region (Self.Set, Self.Env, Name);
    209207      end Name_To_Region;
    210208
     
    349347
    350348      Env_Index : Gela.Semantic_Types.Env_Index;
    351       Env : Env_Item := Self.Env.Element (Index);
    352       Reg : Region_Item := Self.Region.Head (Env.Region_List (Nested));
    353    begin
     349      Env : Env_Item;
     350      Reg : Region_Item;
     351   begin
     352      if Index in 0 | Self.Library_Level_Environment then
     353         --  Fix constraint_error because library_bodies doesn have env yet
     354         return Index;
     355      end if;
     356
     357      Env := Self.Env.Element (Index);
     358      Reg := Self.Region.Head (Env.Region_List (Nested));
     359
    354360      Self.Use_Package.Prepend
    355361        (Value  => Name,
     
    469475   end Empty_Environment;
    470476
     477   -----------------------------
     478   -- Enter_Completion_Region --
     479   -----------------------------
     480
     481   overriding function Enter_Completion_Region
     482     (Self   : access Environment_Set;
     483      Index  : Gela.Semantic_Types.Env_Index;
     484      Region : Gela.Elements.Defining_Names.Defining_Name_Access)
     485      return Gela.Semantic_Types.Env_Index
     486   is
     487      Env   : Env_Item;
     488      Found : Gela.Semantic_Types.Env_Index;
     489      Spec  : constant Region_Item_Count :=
     490        Name_To_Region (Self, Index, Region);
     491      Next  : Region_Item :=
     492        (Name        => Region,
     493         Local       => Self.Names.Empty_List,
     494         Use_Package => 0);
     495   begin
     496      if Index in Env_Item_Index then
     497         Env := Self.Env.Element (Index);
     498      else
     499         Env := (Region_List => (Nested => 0, Other => 0, Withed => 0));
     500      end if;
     501
     502      if Spec in Region_Item_Index then
     503         Next := Self.Region.Head (Spec);
     504      end if;
     505
     506--     Shall we delete region with the same Name from Other_Region_List?
     507
     508      Self.Region.Prepend
     509        (Value  => Next,
     510         Input  => Env.Region_List (Nested),
     511         Output => Env.Region_List (Nested));
     512
     513      Found := Self.Env.Find_Index (Env);
     514
     515      if Found not in Env_Item_Index then
     516         Self.Env.Append (Env);
     517         Found := Self.Env.Last_Index;
     518      end if;
     519
     520      return Found;
     521   end Enter_Completion_Region;
     522
    471523   ------------------------------
    472524   -- Enter_Declarative_Region --
     
    594646      end if;
    595647   end Library_Unit_Environment;
     648
     649   --------------------
     650   -- Name_To_Region --
     651   --------------------
     652
     653   function Name_To_Region
     654     (Self  : access Environment_Set'Class;
     655      Index : Gela.Semantic_Types.Env_Index;
     656      Name  : Gela.Elements.Defining_Names.Defining_Name_Access)
     657         return Region_Item_Count
     658   is
     659      use type Region_Item_Count;
     660      use type Gela.Elements.Defining_Names.Defining_Name_Access;
     661
     662      Env  : constant Env_Item := Self.Env.Element (Index);
     663      Next : Region_Item_Count;
     664   begin
     665      for J of Env.Region_List loop
     666         Next := J;
     667         while Next /= 0 loop
     668            if Self.Region.Head (Next).Name = Name then
     669               return Next;
     670            end if;
     671
     672            Next := Self.Region.Tail (Next);
     673         end loop;
     674      end loop;
     675
     676      return 0;
     677   end Name_To_Region;
    596678
    597679   ----------------------------------
     
    645727      return Gela.Defining_Name_Cursors.Defining_Name_Cursor'Class
    646728   is
    647       pragma Unreferenced (Index);
    648       Lib_Env : constant Gela.Semantic_Types.Env_Index :=
    649         Self.Library_Level_Environment;
    650    begin
    651       return Self.Lib.Visible (Lib_Env, Region, Symbol, Found);
     729      use type Gela.Lexical_Types.Symbol;
     730
     731      Item : Region_Item_Count;
     732   begin
     733      if Index = Gela.Library_Environments.Library_Env then
     734         return Self.Lib.Visible (Index, Region, Symbol, Found);
     735      elsif Index not in Env_Item_Index then
     736         return None : constant Visible_Cursors.Defining_Name_Cursor :=
     737           (others => <>);
     738      end if;
     739
     740      if Region.Assigned then
     741         Item := Name_To_Region (Self, Index, Region);
     742      else
     743         declare
     744            Env  : constant Env_Item := Self.Env.Element (Index);
     745         begin
     746            Item := Env.Region_List (Nested);
     747         end;
     748      end if;
     749
     750      if Item not in Region_Item_Index then
     751         return None : constant Visible_Cursors.Defining_Name_Cursor :=
     752           (others => <>);
     753      end if;
     754
     755      return Result : Visible_Cursors.Defining_Name_Cursor :=
     756        (Set    => Plain_Environment_Set_Access (Self),
     757         others => <>)
     758      do
     759         Result.Initialize (Symbol, Item);
     760      end return;
    652761   end Visible;
    653762
  • trunk/ada-2012/src/semantic/gela-plain_environments.ads

    r318 r398  
    130130      return Gela.Defining_Name_Cursors.Defining_Name_Cursor'Class;
    131131
     132   overriding function Enter_Completion_Region
     133     (Self   : access Environment_Set;
     134      Index  : Gela.Semantic_Types.Env_Index;
     135      Region : Gela.Elements.Defining_Names.Defining_Name_Access)
     136      return Gela.Semantic_Types.Env_Index;
     137
    132138   overriding function Enter_Declarative_Region
    133139     (Self   : access Environment_Set;
  • trunk/ada-2012/tests/asis/def_name/list.txt

    r397 r398  
    77./A/A2A031A.ADA +2866251805
    88./A/A33003A.ADA +158333631
    9 ./A/A34017C.ADA 276208521
     9./A/A34017C.ADA +1820504207
    1010./A/A35101B.ADA 4131699407
    1111./A/A35402A.ADA 4131699407
Note: See TracChangeset for help on using the changeset viewer.