Changeset 512


Ignore:
Timestamp:
Jul 30, 2017, 11:55:34 AM (5 years ago)
Author:
Maxim Reznik
Message:

Separate Property_Reset and Property_Getter

from Gela.Instantiation to their-own packages.

Location:
trunk/ada-2012/src/semantic
Files:
4 added
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ada-2012/src/semantic/gela-instantiation.adb

    r496 r512  
    44with Gela.Element_Visiters;
    55with Gela.Lexical_Types;
     6with Gela.Property_Getters;
     7with Gela.Property_Resets;
    68with Gela.Property_Setters;
    79with Gela.Property_Visiters;
     
    4042
    4143   package Cloners is
     44      type Property_Getter is limited new Gela.Property_Getters.Getter with
     45      record
     46         Visiter : Gela.Property_Visiters.Visiter
     47           (Property_Getter'Unchecked_Access);
     48      end record;
     49
    4250      type Cloner is new Gela.Element_Cloners.Cloner with record
    4351         Map              : Name_Maps.Map;
    4452         Instance_Name    : Gela.Elements.Defining_Names.Defining_Name_Access;
    4553         Template         : access Gela.Elements.Element'Class;
     54         Getter           : Property_Getter;
    4655      end record;
    4756
     
    5968
    6069   package Setters is
     70
    6171      type Property_Setter
    6272        (Source : Gela.Elements.Element_Access;
    6373         Cloner : access Cloners.Cloner)
    64       is new Gela.Property_Setters.Property_Setter with record
    65          Corresponding_Generic_Element : Gela.Elements.Element_Access;
    66       end record;
    67 
    68       overriding procedure On_Index
    69         (Self    : in out Property_Setter;
    70          Element : Gela.Elements.Element_Access;
    71          Value   : out Gela.Lexical_Types.Token_Count);
    72 
    73       overriding procedure On_Env_In
    74         (Self    : in out Property_Setter;
    75          Element : Gela.Elements.Element_Access;
    76          Value   : out Gela.Semantic_Types.Env_Index);
    77 
    78       overriding procedure On_Env_Out
    79         (Self    : in out Property_Setter;
    80          Element : Gela.Elements.Element_Access;
    81          Value   : out Gela.Semantic_Types.Env_Index);
    82 
    83       overriding procedure On_Down
    84         (Self    : in out Property_Setter;
    85          Element : Gela.Elements.Element_Access;
    86          Value   : out Gela.Interpretations.Interpretation_Index);
    87 
    88       overriding procedure On_Errors
    89         (Self    : in out Property_Setter;
    90          Element : Gela.Elements.Element_Access;
    91          Value   : out Gela.Semantic_Types.Error_Set_Index);
    92 
    93       overriding procedure On_Up
    94         (Self    : in out Property_Setter;
    95          Element : Gela.Elements.Element_Access;
    96          Value   : out Gela.Interpretations.
    97            Interpretation_Tuple_Index);
    98 
    99       overriding procedure On_Up
    100         (Self    : in out Property_Setter;
    101          Element : Gela.Elements.Element_Access;
    102          Value   : out Gela.Interpretations.
    103            Interpretation_Tuple_List_Index);
    104 
    105       overriding procedure On_Name_List
    106         (Self    : in out Property_Setter;
    107          Element : Gela.Elements.Element_Access;
    108          Value   : out Gela.Lexical_Types.Symbol_List);
    109 
    110       overriding procedure On_Limited_With_List
    111         (Self    : in out Property_Setter;
    112          Element : Gela.Elements.Element_Access;
    113          Value   : out Gela.Lexical_Types.Symbol_List);
    114 
    115       overriding procedure On_With_List
    116         (Self    : in out Property_Setter;
    117          Element : Gela.Elements.Element_Access;
    118          Value   : out Gela.Lexical_Types.Symbol_List);
    119 
    120       overriding procedure On_Up
    121         (Self    : in out Property_Setter;
    122          Element : Gela.Elements.Element_Access;
    123          Value   : out Gela.Interpretations.
    124            Interpretation_Set_Index);
    125 
    126       overriding procedure On_Static_Value
    127         (Self    : in out Property_Setter;
    128          Element : Gela.Elements.Element_Access;
    129          Value   : out Gela.Semantic_Types.Value_Index);
     74      is new Gela.Property_Resets.Property_Reset with null record;
    13075
    13176      overriding procedure On_Defining_Name
     
    13984         Element : Gela.Elements.Element_Access;
    14085         Value   : out Gela.Lexical_Types.Symbol);
    141 
    142       overriding procedure On_Declarative_Region
    143         (Self    : in out Property_Setter;
    144          Element : Gela.Elements.Element_Access;
    145          Value   : out Gela.Semantic_Types.Env_Index);
    146 
    147       overriding procedure On_Type_Index
    148         (Self    : in out Property_Setter;
    149          Element : Gela.Elements.Element_Access;
    150          Value   : out Gela.Semantic_Types.Type_Index);
    151 
    152       overriding procedure On_Corresponding_Type
    153         (Self    : in out Property_Setter;
    154          Element : Gela.Elements.Element_Access;
    155          Value   : out Gela.Elements.Element_Access);
    156 
    157       overriding procedure On_Corresponding_Generic_Element
    158         (Self    : in out Property_Setter;
    159          Element : Gela.Elements.Element_Access;
    160          Value   : out Gela.Elements.Element_Access);
    161 
    162       overriding procedure On_Corresponding_View
    163         (Self    : in out Property_Setter;
    164          Element : Gela.Elements.Element_Access;
    165          Value   : out Gela.Elements.Element_Access);
    166 
    167       overriding procedure On_Expanded
    168         (Self    : in out Property_Setter;
    169          Element : Gela.Elements.Element_Access;
    170          Value   : out Gela.Elements.Element_Access);
    17186
    17287      overriding procedure On_Chosen_Interpretation
     
    212127   package body Setters is
    213128
    214       overriding procedure On_Index
    215         (Self    : in out Property_Setter;
    216          Element : Gela.Elements.Element_Access;
    217          Value   : out Gela.Lexical_Types.Token_Count)
    218       is
    219          pragma Unreferenced (Self, Element);
    220       begin
    221          Value := 0;
    222       end On_Index;
    223 
    224       overriding procedure On_Env_In
    225         (Self    : in out Property_Setter;
    226          Element : Gela.Elements.Element_Access;
    227          Value   : out Gela.Semantic_Types.Env_Index)
    228       is
    229          pragma Unreferenced (Self, Element);
    230       begin
    231          Value := 0;
    232       end On_Env_In;
    233 
    234       overriding procedure On_Env_Out
    235         (Self    : in out Property_Setter;
    236          Element : Gela.Elements.Element_Access;
    237          Value   : out Gela.Semantic_Types.Env_Index)
    238       is
    239          pragma Unreferenced (Self, Element);
    240       begin
    241          Value := 0;
    242       end On_Env_Out;
    243 
    244       overriding procedure On_Down
    245         (Self    : in out Property_Setter;
    246          Element : Gela.Elements.Element_Access;
    247          Value   : out Gela.Interpretations.Interpretation_Index)
    248       is
    249          pragma Unreferenced (Self, Element);
    250       begin
    251          Value := 0;
    252       end On_Down;
    253 
    254       overriding procedure On_Errors
    255         (Self    : in out Property_Setter;
    256          Element : Gela.Elements.Element_Access;
    257          Value   : out Gela.Semantic_Types.Error_Set_Index)
    258       is
    259          pragma Unreferenced (Self, Element);
    260       begin
    261          Value := 0;
    262       end On_Errors;
    263 
    264       overriding procedure On_Up
    265         (Self    : in out Property_Setter;
    266          Element : Gela.Elements.Element_Access;
    267          Value   : out Gela.Interpretations.
    268            Interpretation_Tuple_Index)
    269       is
    270          pragma Unreferenced (Self, Element);
    271       begin
    272          Value := 0;
    273       end On_Up;
    274 
    275       overriding procedure On_Up
    276         (Self    : in out Property_Setter;
    277          Element : Gela.Elements.Element_Access;
    278          Value   : out Gela.Interpretations.
    279            Interpretation_Tuple_List_Index)
    280       is
    281          pragma Unreferenced (Self, Element);
    282       begin
    283          Value := 0;
    284       end On_Up;
    285 
    286       overriding procedure On_Name_List
    287         (Self    : in out Property_Setter;
    288          Element : Gela.Elements.Element_Access;
    289          Value   : out Gela.Lexical_Types.Symbol_List)
    290       is
    291          pragma Unreferenced (Self, Element);
    292       begin
    293          Value := 0;
    294       end On_Name_List;
    295 
    296       overriding procedure On_Limited_With_List
    297         (Self    : in out Property_Setter;
    298          Element : Gela.Elements.Element_Access;
    299          Value   : out Gela.Lexical_Types.Symbol_List)
    300       is
    301          pragma Unreferenced (Self, Element);
    302       begin
    303          Value := 0;
    304       end On_Limited_With_List;
    305 
    306       overriding procedure On_With_List
    307         (Self    : in out Property_Setter;
    308          Element : Gela.Elements.Element_Access;
    309          Value   : out Gela.Lexical_Types.Symbol_List)
    310       is
    311          pragma Unreferenced (Self, Element);
    312       begin
    313          Value := 0;
    314       end On_With_List;
    315 
    316       overriding procedure On_Up
    317         (Self    : in out Property_Setter;
    318          Element : Gela.Elements.Element_Access;
    319          Value   : out Gela.Interpretations.
    320            Interpretation_Set_Index)
    321       is
    322          pragma Unreferenced (Self, Element);
    323       begin
    324          Value := 0;
    325       end On_Up;
    326 
    327       overriding procedure On_Static_Value
    328         (Self    : in out Property_Setter;
    329          Element : Gela.Elements.Element_Access;
    330          Value   : out Gela.Semantic_Types.Value_Index)
    331       is
    332          pragma Unreferenced (Self, Element);
    333       begin
    334          Value := 0;
    335       end On_Static_Value;
    336 
    337129      ------------------
    338130      -- On_Full_Name --
     
    345137      is
    346138         pragma Unreferenced (Element);
    347          type Property_Visiter is new Gela.Property_Visiters.Property_Visiter
    348            with null record;
    349 
    350          overriding procedure On_Full_Name
    351            (Self    : in out Property_Visiter;
    352             Element : Gela.Elements.Element_Access;
    353             Value   : Gela.Lexical_Types.Symbol);
    354 
    355          overriding procedure On_Full_Name
    356            (Self    : in out Property_Visiter;
    357             Element : Gela.Elements.Element_Access;
    358             Value   : Gela.Lexical_Types.Symbol)
    359          is
    360             pragma Unreferenced (Self, Element);
    361          begin
    362             Setters.On_Full_Name.Value := Value;
    363          end On_Full_Name;
    364 
    365          Getter  : aliased Property_Visiter;
    366          Visiter : Gela.Property_Visiters.Visiter (Getter'Access);
    367       begin
    368          Self.Source.Visit (Visiter);
     139      begin
     140         Self.Source.Visit (Self.Cloner.Getter.Visiter);
     141         Value := Self.Cloner.Getter.Full_Name;
     142         Self.Cloner.Getter.Full_Name := Self.Full_Name;
    369143      end On_Full_Name;
    370144
     
    379153      is
    380154         pragma Unreferenced (Element);
    381          type Property_Visiter is new Gela.Property_Visiters.Property_Visiter
    382            with null record;
    383 
    384          overriding procedure On_Defining_Name
    385            (Self    : in out Property_Visiter;
    386             Element : Gela.Elements.Element_Access;
    387             Value   : Gela.Elements.Defining_Names.Defining_Name_Access);
    388 
    389          overriding procedure On_Defining_Name
    390            (Self    : in out Property_Visiter;
    391             Element : Gela.Elements.Element_Access;
    392             Value   : Gela.Elements.Defining_Names.Defining_Name_Access)
    393          is
    394             pragma Unreferenced (Self, Element);
    395          begin
    396             Setters.On_Defining_Name.Value := Value;
    397          end On_Defining_Name;
    398 
    399          Getter  : aliased Property_Visiter;
    400          Visiter : Gela.Property_Visiters.Visiter (Getter'Access);
     155
    401156         Cursor  : Name_Maps.Cursor;
    402157      begin
    403          Self.Source.Visit (Visiter);
     158         Self.Source.Visit (Self.Cloner.Getter.Visiter);
     159         Value := Self.Cloner.Getter.Defining_Name;
     160         Self.Cloner.Getter.Defining_Name := null;
    404161
    405162         if Value.Assigned then
     
    412169      end On_Defining_Name;
    413170
    414       overriding procedure On_Declarative_Region
    415         (Self    : in out Property_Setter;
    416          Element : Gela.Elements.Element_Access;
    417          Value   : out Gela.Semantic_Types.Env_Index)
    418       is
    419          pragma Unreferenced (Self, Element);
    420       begin
    421          Value := 0;
    422       end On_Declarative_Region;
    423 
    424       overriding procedure On_Type_Index
    425         (Self    : in out Property_Setter;
    426          Element : Gela.Elements.Element_Access;
    427          Value   : out Gela.Semantic_Types.Type_Index)
    428       is
    429          pragma Unreferenced (Self, Element);
    430       begin
    431          Value := 0;
    432       end On_Type_Index;
    433 
    434       overriding procedure On_Corresponding_Type
    435         (Self    : in out Property_Setter;
    436          Element : Gela.Elements.Element_Access;
    437          Value   : out Gela.Elements.Element_Access)
    438       is
    439          pragma Unreferenced (Self, Element);
    440       begin
    441          Value := null;
    442       end On_Corresponding_Type;
    443 
    444       overriding procedure On_Corresponding_Generic_Element
    445         (Self    : in out Property_Setter;
    446          Element : Gela.Elements.Element_Access;
    447          Value   : out Gela.Elements.Element_Access)
     171      overriding procedure On_Chosen_Interpretation
     172        (Self    : in out Property_Setter;
     173         Element : Gela.Elements.Element_Access;
     174         Value   : out Gela.Interpretations.Interpretation_Kinds)
    448175      is
    449176         pragma Unreferenced (Element);
    450177      begin
    451          Value := Self.Corresponding_Generic_Element;
    452       end On_Corresponding_Generic_Element;
    453 
    454       overriding procedure On_Corresponding_View
    455         (Self    : in out Property_Setter;
    456          Element : Gela.Elements.Element_Access;
    457          Value   : out Gela.Elements.Element_Access)
    458       is
    459          pragma Unreferenced (Self, Element);
    460       begin
    461          Value := null;
    462       end On_Corresponding_View;
    463 
    464       overriding procedure On_Expanded
    465         (Self    : in out Property_Setter;
    466          Element : Gela.Elements.Element_Access;
    467          Value   : out Gela.Elements.Element_Access)
    468       is
    469          pragma Unreferenced (Self, Element);
    470       begin
    471          Value := null;
    472       end On_Expanded;
    473 
    474       overriding procedure On_Chosen_Interpretation
    475         (Self    : in out Property_Setter;
    476          Element : Gela.Elements.Element_Access;
    477          Value   : out Gela.Interpretations.Interpretation_Kinds)
    478       is
    479          pragma Unreferenced (Element);
    480          type Property_Visiter is new Gela.Property_Visiters.Property_Visiter
    481            with null record;
    482 
    483          overriding procedure On_Chosen_Interpretation
    484            (Self    : in out Property_Visiter;
    485             Element : Gela.Elements.Element_Access;
    486             Value   : Gela.Interpretations.Interpretation_Kinds);
    487 
    488          overriding procedure On_Chosen_Interpretation
    489            (Self    : in out Property_Visiter;
    490             Element : Gela.Elements.Element_Access;
    491             Value   : Gela.Interpretations.Interpretation_Kinds)
    492          is
    493             pragma Unreferenced (Self, Element);
    494          begin
    495             Setters.On_Chosen_Interpretation.Value := Value;
    496          end On_Chosen_Interpretation;
    497 
    498          Getter  : aliased Property_Visiter;
    499          Visiter : Gela.Property_Visiters.Visiter (Getter'Access);
    500       begin
    501          Self.Source.Visit (Visiter);
     178         Self.Source.Visit (Self.Cloner.Getter.Visiter);
     179         Value := Self.Cloner.Getter.Chosen_Interpretation;
     180         Self.Cloner.Getter.Chosen_Interpretation :=
     181           Self.Chosen_Interpretation;
    502182      end On_Chosen_Interpretation;
    503183   end Setters;
Note: See TracChangeset for help on using the changeset viewer.