Changeset 315


Ignore:
Timestamp:
Oct 17, 2014, 11:50:49 AM (6 years ago)
Author:
Maxim Reznik
Message:

New Add_With_Clause method for Env

Location:
branches/invoke/src
Files:
2 added
5 edited

Legend:

Unmodified
Added
Removed
  • branches/invoke/src/api/gela-environments.ads

    r312 r315  
    1515     (Self  : Environment_Set)
    1616      return Gela.Semantic_Types.Env_Index is abstract;
    17    --  Return environment that incudes library level names.
     17   --  Return environment that incudes only library level names.
     18
     19   not overriding function Empty_Environment
     20     (Self  : Environment_Set)
     21      return Gela.Semantic_Types.Env_Index is abstract;
     22   --  Return environment that incudes no names nor use/with clauses at all.
     23
     24   not overriding function Add_With_Clause
     25     (Self   : in out Environment_Set;
     26      Index  : Gela.Semantic_Types.Env_Index;
     27      Symbol : Gela.Lexical_Types.Symbol)
     28      return Gela.Semantic_Types.Env_Index is abstract;
     29   --  Create new environment by adding with clause for given Symbol
     30   --  to provided env with given Index. Return index of created environment
    1831
    1932   not overriding function Library_Unit_Environment
  • branches/invoke/src/semantic/gela-library_environments.adb

    r312 r315  
    599599   end Add_Use_Package;
    600600
     601   overriding function Add_With_Clause
     602     (Self   : in out Environment_Set;
     603      Index  : Gela.Semantic_Types.Env_Index;
     604      Symbol : Gela.Lexical_Types.Symbol)
     605      return Gela.Semantic_Types.Env_Index
     606   is
     607      pragma Unreferenced (Self);
     608      pragma Unreferenced (Symbol);
     609   begin
     610      return Index;
     611   end Add_With_Clause;
     612
    601613   --------------------
    602614   -- Direct_Visible --
     
    637649      end return;
    638650   end Direct_Visible;
     651
     652   -----------------------
     653   -- Empty_Environment --
     654   -----------------------
     655
     656   overriding function Empty_Environment
     657     (Self  : Environment_Set) return Gela.Semantic_Types.Env_Index
     658   is
     659      pragma Unreferenced (Self);
     660   begin
     661      return 0;
     662   end Empty_Environment;
    639663
    640664   ------------------------------
  • branches/invoke/src/semantic/gela-library_environments.ads

    r312 r315  
    3636   type Environment_Set (Context : access Gela.Contexts.Context'Class) is
    3737     new Gela.Environments.Environment_Set with null record;
     38
     39   overriding function Empty_Environment
     40     (Self  : Environment_Set)
     41      return Gela.Semantic_Types.Env_Index;
     42
     43   overriding function Add_With_Clause
     44     (Self   : in out Environment_Set;
     45      Index  : Gela.Semantic_Types.Env_Index;
     46      Symbol : Gela.Lexical_Types.Symbol)
     47      return Gela.Semantic_Types.Env_Index;
    3848
    3949   overriding function Add_Defining_Name
  • branches/invoke/src/semantic/gela-plain_environments.adb

    r313 r315  
    11package body Gela.Plain_Environments is
    22
    3    package Cursors is
    4       --  Cursor over names in Direct_Visible_Item_List with some Symbol
     3   package Direct_Visible_Cursors is
     4      --  Cursor over names in Local then go to enclosing region, etc
    55      type Defining_Name_Cursor is
    66        new Gela.Defining_Name_Cursors.Defining_Name_Cursor with
    77         record
    8             Set    : Plain_Environment_Set_Access;
    9             Name   : Direct_Visible_Item_Count;
    10             --  Points to Direct_Visible_Item_List
     8            Set     : Plain_Environment_Set_Access;
     9            Current : Gela.Name_List_Managers.Defining_Name_Cursor;
     10            Region  : Region_Item_Index;
    1111         end record;
    1212
     
    1616      overriding function Element
    1717        (Self : Defining_Name_Cursor)
    18          return Gela.Elements.Defining_Names.Defining_Name_Access;
     18      return Gela.Elements.Defining_Names.Defining_Name_Access;
    1919
    2020      overriding procedure Next
    2121        (Self : in out Defining_Name_Cursor);
    2222
    23       procedure Internal_Next
     23      procedure Initialize
    2424        (Self   : in out Defining_Name_Cursor;
    2525         Symbol : Gela.Lexical_Types.Symbol);
    26    end Cursors;
    27 
    28    -------------
    29    -- Cursors --
    30    -------------
    31 
    32    package body Cursors is
    33 
    34       -----------------
    35       -- Has_Element --
    36       -----------------
     26   end Direct_Visible_Cursors;
     27
     28   ----------------------------
     29   -- Direct_Visible_Cursors --
     30   ----------------------------
     31
     32   package body Direct_Visible_Cursors is
    3733
    3834      overriding function Has_Element
    3935        (Self : Defining_Name_Cursor) return Boolean is
    4036      begin
    41          return Self.Name in Direct_Visible_Item_Index;
     37         return Self.Current.Has_Element;
    4238      end Has_Element;
    43 
    44       -------------
    45       -- Element --
    46       -------------
    4739
    4840      overriding function Element
     
    5042         return Gela.Elements.Defining_Names.Defining_Name_Access is
    5143      begin
    52          return Self.Set.Direct_Visible.Head (Self.Name).Name;
     44         return Self.Current.Element;
    5345      end Element;
    5446
    55       ----------
    56       -- Next --
    57       ----------
    58 
    5947      overriding procedure Next (Self : in out Defining_Name_Cursor) is
    60          Set    : constant Plain_Environment_Set_Access := Self.Set;
    61          Symbol : constant Gela.Lexical_Types.Symbol :=
    62            Set.Direct_Visible.Head (Self.Name).Symbol;
    63       begin
    64          Self.Name := Set.Direct_Visible.Tail (Self.Name);
    65 
    66          Defining_Name_Cursor'Class (Self).Internal_Next (Symbol);
    67       end Next;
    68 
    69       -------------------
    70       -- Internal_Next --
    71       -------------------
    72 
    73       procedure Internal_Next
    74         (Self   : in out Defining_Name_Cursor;
    75          Symbol : Gela.Lexical_Types.Symbol)
    76       is
    77          use type Gela.Lexical_Types.Symbol;
    78 
    79          Set : constant Plain_Environment_Set_Access := Self.Set;
    80       begin
    81          while Self.Name in Direct_Visible_Item_Index
    82            and then Set.Direct_Visible.Head (Self.Name).Symbol /= Symbol
    83          loop
    84             Self.Name := Set.Direct_Visible.Tail (Self.Name);
    85          end loop;
    86       end Internal_Next;
    87 
    88    end Cursors;
    89 
    90    package Direct_Visible_Cursors is
    91       --  Cursor over names in Local then go to enclosing region, etc
    92       type Defining_Name_Cursor is
    93         new Cursors.Defining_Name_Cursor with
    94          record
    95             Region : Region_Item_Index;
    96          end record;
    97 
    98       procedure Internal_Next
    99         (Self   : in out Defining_Name_Cursor;
    100          Symbol : Gela.Lexical_Types.Symbol);
    101    end Direct_Visible_Cursors;
    102 
    103    ----------------------------
    104    -- Direct_Visible_Cursors --
    105    ----------------------------
    106 
    107    package body Direct_Visible_Cursors is
    108 
    109       -------------------
    110       -- Internal_Next --
    111       -------------------
    112 
    113       procedure Internal_Next
    114         (Self   : in out Defining_Name_Cursor;
    115          Symbol : Gela.Lexical_Types.Symbol)
    116       is
    117          use type Gela.Lexical_Types.Symbol;
    118 
     48         Symbol : constant Gela.Lexical_Types.Symbol := Self.Current.Symbol;
    11949         Region : Region_Item_Count;
    120          Set    : constant Plain_Environment_Set_Access := Self.Set;
    121       begin
    122          loop
    123             Cursors.Defining_Name_Cursor (Self).Internal_Next (Symbol);
    124             exit when Self.Has_Element;
    125             Region := Set.Region.Tail (Self.Region);
     50         Local  : Gela.Name_List_Managers.List;
     51      begin
     52         Self.Current.Next;
     53         while not Self.Has_Element loop
     54            Region := Self.Set.Region.Tail (Self.Region);
    12655
    12756            if Region in Region_Item_Index then
    12857               Self.Region := Region;
    129                Self.Name := Set.Region.Head (Self.Region).Local;
     58               Local := Self.Set.Region.Head (Self.Region).Local;
     59               Self.Current := Self.Set.Names.Find (Local, Symbol);
    13060            else
    13161               return;
    13262            end if;
    13363         end loop;
    134       end Internal_Next;
     64      end Next;
     65
     66      -------------------
     67      -- Internal_Next --
     68      -------------------
     69
     70      procedure Initialize
     71        (Self   : in out Defining_Name_Cursor;
     72         Symbol : Gela.Lexical_Types.Symbol)
     73      is
     74         Region : Region_Item_Count := Self.Region;
     75         Local  : Gela.Name_List_Managers.List;
     76      begin
     77         while Region in Region_Item_Index loop
     78            Local := Self.Set.Region.Head (Self.Region).Local;
     79            Self.Region := Region;
     80            Self.Current := Self.Set.Names.Find (Local, Symbol);
     81
     82            exit when Self.Has_Element;
     83            Region := Self.Set.Region.Tail (Self.Region);
     84         end loop;
     85      end Initialize;
    13586
    13687   end Direct_Visible_Cursors;
     
    13990      --  Cursor over names in each used package
    14091      type Defining_Name_Cursor is
    141         new Cursors.Defining_Name_Cursor with
     92        new Gela.Defining_Name_Cursors.Defining_Name_Cursor with
    14293         record
     94            Set      : Plain_Environment_Set_Access;
     95            Current  : Gela.Name_List_Managers.Defining_Name_Cursor;
    14396            Env      : Env_Item_Index;
    14497            Region   : Region_Item_Count;
     
    148101         end record;
    149102
     103      overriding function Has_Element
     104        (Self : Defining_Name_Cursor) return Boolean;
     105
     106      overriding function Element
     107        (Self : Defining_Name_Cursor)
     108         return Gela.Elements.Defining_Names.Defining_Name_Access;
     109
     110      overriding procedure Next
     111        (Self : in out Defining_Name_Cursor);
     112
    150113      function Name_To_Region
    151114        (Self : Defining_Name_Cursor;
     
    153116         return Region_Item_Count;
    154117
    155       procedure Internal_Next
    156         (Self   : in out Defining_Name_Cursor;
    157          Symbol : Gela.Lexical_Types.Symbol);
    158 
    159118      procedure Initialize
    160119        (Self   : in out Defining_Name_Cursor;
     
    169128   package body Use_Package_Cursors is
    170129
    171       -------------------
    172       -- Internal_Next --
    173       -------------------
    174 
    175       procedure Internal_Next
    176         (Self   : in out Defining_Name_Cursor;
    177          Symbol : Gela.Lexical_Types.Symbol)
    178       is
    179          use type Gela.Lexical_Types.Symbol;
     130      overriding function Has_Element
     131        (Self : Defining_Name_Cursor) return Boolean is
     132      begin
     133         return Self.Current.Has_Element;
     134      end Has_Element;
     135
     136      overriding function Element
     137        (Self : Defining_Name_Cursor)
     138         return Gela.Elements.Defining_Names.Defining_Name_Access is
     139      begin
     140         return Self.Current.Element;
     141      end Element;
     142
     143      overriding procedure Next (Self : in out Defining_Name_Cursor) is
     144         use type Region_Item_Count;
    180145         use type Defining_Name_Item_Count;
    181          use type Region_Item_Count;
    182 
     146
     147         Symbol : constant Gela.Lexical_Types.Symbol := Self.Current.Symbol;
     148         Local  : Gela.Name_List_Managers.List;
     149         Target : Region_Item_Count;
    183150         Name   : Defining_Name_Item_Count;
    184          Target : Region_Item_Count;
    185          Set    : constant Plain_Environment_Set_Access := Self.Set;
    186       begin
    187          loop
    188             --  Next name in Region.Local
    189             Cursors.Defining_Name_Cursor (Self).Internal_Next (Symbol);
    190             exit when Self.Has_Element;
    191 
     151      begin
     152         Self.Current.Next;
     153
     154         while not Self.Current.Has_Element loop
    192155            Target := 0;
    193156
     
    210173            end loop;
    211174
    212             Self.Name := Set.Region.Head (Target).Local;
     175            Local := Self.Set.Region.Head (Target).Local;
     176            Self.Current := Self.Set.Names.Find (Local, Symbol);
    213177         end loop;
    214       end Internal_Next;
     178      end Next;
    215179
    216180      --------------------
     
    256220         use type Region_Item_Count;
    257221         use type Defining_Name_Item_Count;
     222
    258223         Target : Region_Item_Count;
     224         Local  : Gela.Name_List_Managers.List;
    259225      begin
    260226         Self.Region := Self.Set.Env.Element (Self.Env).Nested_Region_List;
     
    268234
    269235               if Target /= 0 then
    270                   Self.Name := Self.Set.Region.Head (Target).Local;
    271                   Cursors.Defining_Name_Cursor (Self).Internal_Next (Symbol);
     236                  Local := Self.Set.Region.Head (Target).Local;
     237                  Self.Current := Self.Set.Names.Find (Local, Symbol);
    272238
    273239                  if Self.Has_Element then
     
    324290      Env_Index : Gela.Semantic_Types.Env_Index;
    325291      Reg       : Region_Item;
    326       DV        : constant Direct_Visible_Item :=
    327         (Symbol => Symbol,
    328          Name   => Name);
    329292   begin
    330293      if Index in Env_Item_Index then
     
    335298
    336299      if Env.Nested_Region_List = 0 then
    337          Reg := (Name => null, Local => 0, Use_Package => 0);
     300         Reg := (Name => null,
     301                 Local => Self.Names.Empty_List,
     302                 Use_Package => 0);
    338303      else
    339304         Reg := Self.Region.Head (Env.Nested_Region_List);
    340305      end if;
    341306
    342       Self.Direct_Visible.Prepend
    343         (Value  => DV,
     307      Self.Names.Append
     308        (Symbol => Symbol,
     309         Name   => Name,
    344310         Input  => Reg.Local,
    345311         Output => Reg.Local);
     
    407373   end Add_Use_Package;
    408374
     375   ---------------------
     376   -- Add_With_Clause --
     377   ---------------------
     378
     379   overriding function Add_With_Clause
     380     (Self   : in out Environment_Set;
     381      Index  : Gela.Semantic_Types.Env_Index;
     382      Symbol : Gela.Lexical_Types.Symbol)
     383      return Gela.Semantic_Types.Env_Index is
     384   begin
     385      return Self.Lib.Add_With_Clause (Index, Symbol);
     386   end Add_With_Clause;
     387
    409388   --------------------
    410389   -- Direct_Visible --
     
    424403         return Self.Lib.Direct_Visible (Index, Symbol);
    425404      elsif Index not in Env_Item_Index then
    426          return Direct_Visible_Cursors.Defining_Name_Cursor'
    427            (Set => null, Region => Region_Item_Index'First, Name => 0);
     405         return None : constant Direct_Visible_Cursors.Defining_Name_Cursor :=
     406           (others => <>);
    428407      end if;
    429408
     
    433412        (Set    => Plain_Environment_Set_Access (Self),
    434413         Region => Env.Nested_Region_List,
    435          Name   => Self.Region.Head (Env.Nested_Region_List).Local)
     414         others => <>)
    436415      do
    437          Result.Internal_Next (Symbol);
     416         Result.Initialize (Symbol);
    438417      end return;
    439418   end Direct_Visible;
     419
     420   -----------------------
     421   -- Empty_Environment --
     422   -----------------------
     423
     424   overriding function Empty_Environment
     425     (Self  : Environment_Set)
     426      return Gela.Semantic_Types.Env_Index is
     427   begin
     428      return Self.Lib.Empty_Environment;
     429   end Empty_Environment;
    440430
    441431   ------------------------------
     
    453443      Next  : constant Region_Item :=
    454444        (Name        => Region,
    455          Local       => 0,
     445         Local       => Self.Names.Empty_List,
    456446         Use_Package => 0);
    457447   begin
     
    597587         Region   => 0,
    598588         Use_Name => 0,
    599          Name     => 0)
     589         others   => <>)
    600590      do
    601591         Result.Initialize (Symbol);
  • branches/invoke/src/semantic/gela-plain_environments.ads

    r312 r315  
    1111with Ada.Containers.Vectors;
    1212with Gela.Peristent_Lists;
     13with Gela.Name_List_Managers;
    1314
    1415package Gela.Plain_Environments is
     
    2021
    2122private
    22 
    23    --  Direct_Visible_Item  --
    24 
    25    type Direct_Visible_Item is record
    26       Symbol : Gela.Lexical_Types.Symbol;
    27       Name   : Gela.Elements.Defining_Names.Defining_Name_Access;
    28    end record;
    29 
    30    package Direct_Visible_Item_Lists is new Gela.Peristent_Lists
    31      (Element_Type => Direct_Visible_Item);
    32 
    33    subtype Direct_Visible_Item_Count is Direct_Visible_Item_Lists.Count_Type;
    34    subtype Direct_Visible_Item_Index is Direct_Visible_Item_Lists.Index_Type;
    3523
    3624   package Defining_Name_Lists is new Gela.Peristent_Lists
     
    4533      Name : Gela.Elements.Defining_Names.Defining_Name_Access;
    4634      --  Defining name corresponding to given region, if any
    47       Local : Direct_Visible_Item_Count;
     35      Local : Gela.Name_List_Managers.List;
    4836      --  List of Direct_Visible_Item.
    4937      Use_Package : Defining_Name_Item_Count;
     
    9987     new Gela.Environments.Environment_Set with
    10088   record
     89      Names : aliased Gela.Name_List_Managers.Name_List_Manager;
    10190      Lib : aliased Gela.Library_Environments.Environment_Set (Context);
    10291      Env            : Env_Item_Vectors.Vector;
    10392      Region         : Region_Item_Lists.Container;
    104       Direct_Visible : Direct_Visible_Item_Lists.Container;
    10593      Use_Package    : Defining_Name_Lists.Container;
    10694      Units_Env      : Symbol_Maps.Map;
     
    10997      --  Reverse mapping for Units_Env
    11098   end record;
     99
     100   overriding function Empty_Environment
     101     (Self  : Environment_Set)
     102      return Gela.Semantic_Types.Env_Index;
     103
     104   overriding function Add_With_Clause
     105     (Self   : in out Environment_Set;
     106      Index  : Gela.Semantic_Types.Env_Index;
     107      Symbol : Gela.Lexical_Types.Symbol)
     108      return Gela.Semantic_Types.Env_Index;
    111109
    112110   overriding function Add_Defining_Name
Note: See TracChangeset for help on using the changeset viewer.