Changeset 396


Ignore:
Timestamp:
Feb 7, 2015, 12:15:18 PM (5 years ago)
Author:
Maxim Reznik
Message:

Add interpretation of record aggregate

Location:
trunk/ada-2012
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • trunk/ada-2012/src/api/gela-type_views.ads

    r391 r396  
    4646      return Gela.Elements.Defining_Names.Defining_Name_Access is abstract;
    4747
     48   not overriding function Get_Component
     49     (Self   : Type_View;
     50      Symbol : Gela.Lexical_Types.Symbol)
     51      return Gela.Elements.Defining_Names.Defining_Name_Access is abstract;
     52
    4853--     function Is_Elementary           (Self : Abstract_Type) return Boolean;
    4954--     function Is_Scalar               (Self : Abstract_Type) return Boolean;
  • trunk/ada-2012/src/semantic/gela-debug_properties.adb

    r391 r396  
    1515   package Dump_Property is
    1616
    17       type Property is (Up, Down, Env_In, Env_Out);
     17      type Property is (Up, Down, Env_In, Env_Out, Full_Name);
    1818      pragma Unreferenced (Env_Out);
    1919
     
    3434         Element : Gela.Elements.Element_Access;
    3535         Value   : Gela.Semantic_Types.Env_Index);
     36
     37      overriding procedure On_Full_Name
     38        (Self    : in out Property_Visiter;
     39         Element : Gela.Elements.Element_Access;
     40         Value   : Gela.Lexical_Types.Symbol);
    3641
    3742      overriding procedure On_Up
     
    118123            Value);
    119124      end On_Env_In;
     125
     126      overriding procedure On_Full_Name
     127        (Self    : in out Property_Visiter;
     128         Element : Gela.Elements.Element_Access;
     129         Value   : Gela.Lexical_Types.Symbol)
     130      is
     131         pragma Unreferenced (Element);
     132      begin
     133         if Self.Flags (Full_Name) = False then
     134            return;
     135         end if;
     136
     137         Put_Line
     138           ("full_name:" &
     139              Gela.Lexical_Types.Symbol'Image (Value));
     140      end On_Full_Name;
    120141
    121142      overriding procedure On_Up
  • trunk/ada-2012/src/semantic/gela-plain_type_managers.adb

    r395 r396  
    1111with Gela.Plain_Type_Views;
    1212with Gela.Elements.Identifiers;
     13with Gela.Elements.Discriminant_Specifications;
     14with Gela.Elements.Subtype_Mark_Or_Access_Definitions;
     15with Gela.Elements.Component_Declarations;
     16with Gela.Elements.Component_Definitions;
     17with Gela.Elements.Subtype_Indication_Or_Access_Definitions;
    1318
    1419package body Gela.Plain_Type_Managers is
     
    291296         end record;
    292297
     298         overriding procedure Component_Declaration
     299           (Self : in out Visiter;
     300            Node : not null Gela.Elements.Component_Declarations.
     301              Component_Declaration_Access);
     302
     303         overriding procedure Component_Definition
     304           (Self : in out Visiter;
     305            Node : not null Gela.Elements.Component_Definitions.
     306              Component_Definition_Access);
     307
     308         overriding procedure Discriminant_Specification
     309           (Self : in out Visiter;
     310            Node : not null Gela.Elements.Discriminant_Specifications.
     311              Discriminant_Specification_Access);
     312
    293313         overriding procedure Object_Declaration
    294314           (Self : in out Visiter;
     
    304324
    305325      package body Visiters is
     326
     327         overriding procedure Component_Declaration
     328           (Self : in out Visiter;
     329            Node : not null Gela.Elements.Component_Declarations.
     330              Component_Declaration_Access)
     331         is
     332            X : constant Gela.Elements.Component_Definitions.
     333              Component_Definition_Access :=
     334                Node.Object_Declaration_Subtype;
     335         begin
     336            X.Visit (Self);
     337         end Component_Declaration;
     338
     339         overriding procedure Component_Definition
     340           (Self : in out Visiter;
     341            Node : not null Gela.Elements.Component_Definitions.
     342              Component_Definition_Access)
     343         is
     344            X : constant Gela.Elements.Subtype_Indication_Or_Access_Definitions
     345              .Subtype_Indication_Or_Access_Definition_Access :=
     346                Node.Component_Subtype_Indication;
     347         begin
     348            X.Visit (Self);
     349         end Component_Definition;
     350
     351         overriding procedure Discriminant_Specification
     352           (Self : in out Visiter;
     353            Node : not null Gela.Elements.Discriminant_Specifications.
     354              Discriminant_Specification_Access)
     355         is
     356            X : constant Gela.Elements.Subtype_Mark_Or_Access_Definitions.
     357              Subtype_Mark_Or_Access_Definition_Access :=
     358                Node.Object_Declaration_Subtype;
     359         begin
     360            X.Visit (Self);
     361         end Discriminant_Specification;
    306362
    307363         overriding procedure Object_Declaration
  • trunk/ada-2012/src/semantic/gela-plain_type_views.adb

    r391 r396  
    11with Gela.Element_Visiters;
     2with Gela.Elements.Defining_Identifiers;
    23with Gela.Elements.Discriminant_Parts;
     4with Gela.Elements.Discriminant_Specifications;
    35with Gela.Elements.Known_Discriminant_Parts;
    4 with Gela.Elements.Discriminant_Specifications;
    5 with Gela.Elements.Defining_Identifiers;
     6with Gela.Elements.Type_Definitions;
     7with Gela.Elements.Record_Type_Definitions;
     8with Gela.Elements.Alt_Record_Definitions;
     9with Gela.Elements.Record_Definitions;
     10with Gela.Elements.Component_Items;
     11with Gela.Elements.Component_Declarations;
     12with Gela.Elements.Variant_Parts;
     13with Gela.Elements.Variants;
    614
    715package body Gela.Plain_Type_Views is
     
    3442      return Gela.Type_Views.Type_View_Access (Value);
    3543   end Create_Full_Type;
     44
     45   -------------------
     46   -- Get_Component --
     47   -------------------
     48
     49   overriding function Get_Component
     50     (Self   : Type_View;
     51      Symbol : Gela.Lexical_Types.Symbol)
     52      return Gela.Elements.Defining_Names.Defining_Name_Access
     53   is
     54      package Get is
     55         type Visiter is new Gela.Element_Visiters.Visiter with record
     56            Result : Gela.Elements.Defining_Identifiers.
     57              Defining_Identifier_Access;
     58         end record;
     59
     60         overriding procedure Component_Declaration
     61           (Self : in out Visiter;
     62            Node : not null Gela.Elements.Component_Declarations.
     63              Component_Declaration_Access);
     64
     65         overriding procedure Record_Definition
     66           (Self : in out Visiter;
     67            Node : not null Gela.Elements.Record_Definitions.
     68              Record_Definition_Access);
     69
     70         overriding procedure Record_Type_Definition
     71           (Self : in out Visiter;
     72            Node : not null Gela.Elements.Record_Type_Definitions.
     73              Record_Type_Definition_Access);
     74
     75         overriding procedure Variant
     76           (Self : in out Visiter;
     77            Node : not null Gela.Elements.Variants.Variant_Access);
     78
     79         overriding procedure Variant_Part
     80           (Self : in out Visiter;
     81            Node : not null Gela.Elements.Variant_Parts.Variant_Part_Access);
     82
     83      end Get;
     84
     85      package body Get is
     86
     87         overriding procedure Component_Declaration
     88           (Self : in out Visiter;
     89            Node : not null Gela.Elements.Component_Declarations.
     90              Component_Declaration_Access)
     91         is
     92            use type Gela.Lexical_Types.Symbol;
     93            Names : constant Gela.Elements.Defining_Identifiers.
     94              Defining_Identifier_Sequence_Access := Node.Names;
     95            Pos : Gela.Elements.Defining_Identifiers.
     96              Defining_Identifier_Sequence_Cursor := Names.First;
     97         begin
     98            while Pos.Has_Element loop
     99               if Pos.Element.Full_Name = Symbol then
     100                  Self.Result := Pos.Element;
     101
     102                  return;
     103               end if;
     104
     105               Pos.Next;
     106            end loop;
     107         end Component_Declaration;
     108
     109         overriding procedure Record_Type_Definition
     110           (Self : in out Visiter;
     111            Node : not null Gela.Elements.Record_Type_Definitions.
     112              Record_Type_Definition_Access)
     113         is
     114            X : constant Gela.Elements.Alt_Record_Definitions.
     115              Alt_Record_Definition_Access := Node.Record_Definition;
     116         begin
     117            X.Visit (Self);
     118         end Record_Type_Definition;
     119
     120         overriding procedure Record_Definition
     121           (Self : in out Visiter;
     122            Node : not null Gela.Elements.Record_Definitions.
     123              Record_Definition_Access)
     124         is
     125            List : constant Gela.Elements.Component_Items.
     126              Component_Item_Sequence_Access := Node.Record_Components;
     127            Cursor : Gela.Elements.Component_Items.
     128              Component_Item_Sequence_Cursor := List.First;
     129         begin
     130            while Cursor.Has_Element loop
     131               Cursor.Element.Visit (Self);
     132               Cursor.Next;
     133            end loop;
     134         end Record_Definition;
     135
     136         overriding procedure Variant
     137           (Self : in out Visiter;
     138            Node : not null Gela.Elements.Variants.Variant_Access)
     139         is
     140            List : constant Gela.Elements.Component_Items.
     141              Component_Item_Sequence_Access := Node.Record_Components;
     142            Cursor : Gela.Elements.Component_Items.
     143              Component_Item_Sequence_Cursor := List.First;
     144         begin
     145            while Cursor.Has_Element loop
     146               Cursor.Element.Visit (Self);
     147               Cursor.Next;
     148            end loop;
     149         end Variant;
     150
     151         overriding procedure Variant_Part
     152           (Self : in out Visiter;
     153            Node : not null Gela.Elements.Variant_Parts.Variant_Part_Access)
     154         is
     155            List : constant Gela.Elements.Variants.Variant_Sequence_Access :=
     156              Node.Variants;
     157            Cursor : Gela.Elements.Variants.Variant_Sequence_Cursor :=
     158              List.First;
     159         begin
     160            while Cursor.Has_Element loop
     161               Cursor.Element.Visit (Self);
     162               Cursor.Next;
     163            end loop;
     164         end Variant_Part;
     165      end Get;
     166
     167      V : Get.Visiter;
     168      View : Gela.Elements.Type_Definitions.Type_Definition_Access;
     169      D : constant Gela.Elements.Defining_Names.Defining_Name_Access :=
     170        Self.Get_Discriminant (Symbol);
     171   begin
     172      if D.Assigned then
     173         return D;
     174      else
     175         View := Self.Decl.Type_Declaration_View;
     176         View.Visit (V);
     177         return Gela.Elements.Defining_Names.Defining_Name_Access (V.Result);
     178      end if;
     179   end Get_Component;
    36180
    37181   ----------------------
  • trunk/ada-2012/src/semantic/gela-plain_type_views.ads

    r391 r396  
    3232      return Gela.Elements.Defining_Names.Defining_Name_Access;
    3333
     34   overriding function Get_Component
     35     (Self   : Type_View;
     36      Symbol : Gela.Lexical_Types.Symbol)
     37      return Gela.Elements.Defining_Names.Defining_Name_Access;
     38
    3439end Gela.Plain_Type_Views;
  • trunk/ada-2012/src/semantic/gela-resolve.adb

    r395 r396  
    11911191            Down   : Gela.Interpretations.Interpretation_Index_Array);
    11921192
     1193         overriding procedure On_Tuple
     1194           (Self  : in out Visiter;
     1195            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     1196            Down  : Gela.Interpretations.Interpretation_Index_Array);
     1197         --  Tuple is interpretation of aggregate
     1198
    11931199      end Each;
     1200
     1201      package Each_Association is
     1202         --  Visiter for interpretation of an association of aggregate
     1203
     1204         type Visiter is new Gela.Interpretations.Visiter with record
     1205            Index : aliased Gela.Interpretations.Interpretation_Index;
     1206         end record;
     1207
     1208         overriding procedure On_Tuple
     1209           (Self  : in out Visiter;
     1210            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     1211            Down  : Gela.Interpretations.Interpretation_Index_Array);
     1212
     1213      end Each_Association;
     1214
     1215      package Each_Symbol is
     1216         --  Visiter for interpretation of an symbol of association
     1217
     1218         type Visiter is new Gela.Interpretations.Visiter with record
     1219            Index          : aliased Gela.Interpretations.Interpretation_Index;
     1220            Component_Type : Gela.Semantic_Types.Type_Index;
     1221         end record;
     1222
     1223         overriding procedure On_Symbol
     1224           (Self   : in out Visiter;
     1225            Symbol : Gela.Lexical_Types.Symbol;
     1226            Down   : Gela.Interpretations.Interpretation_Index_Array);
     1227
     1228      end Each_Symbol;
    11941229
    11951230      IM : constant Gela.Interpretations.Interpretation_Manager_Access :=
    11961231        Comp.Context.Interpretation_Manager;
     1232
     1233      TM : constant Gela.Type_Managers.Type_Manager_Access :=
     1234        Comp.Context.Types;
     1235
     1236      View : constant Gela.Type_Views.Type_View_Access := TM.Get (Type_Up);
    11971237
    11981238      Cursor : Gela.Interpretations.Cursor'Class := IM.Get_Cursor (Expr_Up);
     
    12261266         end On_Expression;
    12271267
     1268         overriding procedure On_Tuple
     1269           (Self  : in out Visiter;
     1270            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     1271            Down  : Gela.Interpretations.Interpretation_Index_Array)
     1272         is
     1273            pragma Unreferenced (Self);
     1274            pragma Unreferenced (Down);
     1275            use type Gela.Type_Views.Type_View_Access;
     1276            V      : aliased Each_Association.Visiter;
     1277            Chosen : Gela.Interpretations.Interpretation_Index;
     1278         begin
     1279            if View /= null and then
     1280              View.Category in Gela.Type_Views.A_Untagged_Record
     1281            then
     1282               Wrap_Tuple
     1283                 (Self   => V'Access,
     1284                  IM     => IM,
     1285                  Value  => Value,
     1286                  Found  => V.Index'Access,
     1287                  Chosen => Chosen);
     1288
     1289               Self.Index := Chosen;
     1290            end if;
     1291         end On_Tuple;
    12281292      end Each;
    12291293
     1294      package body Each_Association is
     1295
     1296         overriding procedure On_Tuple
     1297           (Self  : in out Visiter;
     1298            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     1299            Down  : Gela.Interpretations.Interpretation_Index_Array)
     1300         is
     1301            pragma Unreferenced (Down);
     1302
     1303            V      : aliased Each_Symbol.Visiter;
     1304            Expr   : Gela.Interpretations.Interpretation_Index;
     1305            Chosen : Gela.Interpretations.Interpretation_Index;
     1306         begin
     1307            Wrap_Tuple
     1308              (Self   => V'Access,
     1309               IM     => IM,
     1310               Value  => Value (Value'First + 1 .. Value'Last),
     1311               Found  => V.Index'Access,
     1312               Chosen => Chosen);
     1313
     1314            --  Resolve expression of association
     1315            To_Type
     1316              (Comp    => Comp,
     1317               Type_Up => V.Component_Type,
     1318               Expr_Up => Value (Value'First),
     1319               Result  => Expr);
     1320
     1321            IM.Get_Tuple_Index (Expr, Chosen, Chosen);
     1322
     1323            Self.Index := Chosen;
     1324         end On_Tuple;
     1325
     1326      end Each_Association;
     1327
     1328      package body Each_Symbol is
     1329
     1330         overriding procedure On_Symbol
     1331           (Self   : in out Visiter;
     1332            Symbol : Gela.Lexical_Types.Symbol;
     1333            Down   : Gela.Interpretations.Interpretation_Index_Array)
     1334         is
     1335            pragma Unreferenced (Down);
     1336
     1337            Name : constant Gela.Elements.Defining_Names.Defining_Name_Access
     1338              := View.Get_Component (Symbol);
     1339         begin
     1340            if Name.Assigned then
     1341               IM.Get_Defining_Name_Index
     1342                 (Name   => Name,
     1343                  Result => Self.Index);
     1344
     1345               Self.Component_Type :=
     1346                 TM.Type_Of_Object_Declaration (Name.Enclosing_Element);
     1347            end if;
     1348         end On_Symbol;
     1349
     1350      end Each_Symbol;
     1351
    12301352      Visiter : aliased Each.Visiter;
    12311353   begin
     1354      Result := 0;
    12321355      Visiter.Type_Index := Type_Up;
    12331356
  • trunk/ada-2012/tests/asis/def_name/list.txt

    r387 r396  
    55./A/A27003A.ADA +543928668
    66./A/A29003A.ADA +3628525875
    7 ./A/A2A031A.ADA 2681792585
     7./A/A2A031A.ADA +2866251805
    88./A/A33003A.ADA 540739767
    99./A/A34017C.ADA 276208521
Note: See TracChangeset for help on using the changeset viewer.