Changeset 399


Ignore:
Timestamp:
Feb 16, 2015, 6:35:11 AM (5 years ago)
Author:
Maxim Reznik
Message:

Make distinction between index and disriminant constraint

Location:
trunk/ada-2012
Files:
10 edited

Legend:

Unmodified
Added
Removed
  • trunk/ada-2012/Makefile

    r348 r399  
    1 GELA_BUILD=$(abspath build)
     1export GELA_BUILD=$(abspath build)
    22AG_DRIVER=$(GELA_BUILD)/ag/ag_driver
    33YACC_DRIVER=$(GELA_BUILD)/ag/yacc_driver
  • trunk/ada-2012/src/ag/main.ag.pp

    r383 r399  
    3636      ${procedure_declaration.corresponding_type} := null;
    3737.)
     38
     39Synthesized attributes
     40  subtype_indication
     41   : Gela.Semantic_Types.Type_Index : type_index;
     42
     43Rules for subtype_indication. :
     44(.
     45      ${subtype_indication.type_index} :=
     46        Self.Compilation.Context.Types.Type_From_Subtype_Mark (Subtype_Mark);
     47.)
  • trunk/ada-2012/src/asis/asis-elements.adb

    r391 r399  
    3838      return Asis.Access_Definition_Kinds
    3939   is
    40    begin
    41       if Assigned (Definition) then
    42          Raise_Not_Implemented ("");
    43          return Not_An_Access_Definition;
     40      Map : constant array (F.An_Access_Definition)
     41        of Asis.Access_Definition_Kinds :=
     42          (F.An_Anonymous_Access_To_Variable =>
     43             Asis.An_Anonymous_Access_To_Variable,
     44           F.An_Anonymous_Access_To_Constant =>
     45             Asis.An_Anonymous_Access_To_Constant,
     46           F.An_Anonymous_Access_To_Procedure =>
     47             Asis.An_Anonymous_Access_To_Procedure,
     48           F.An_Anonymous_Access_To_Protected_Procedure =>
     49             Asis.An_Anonymous_Access_To_Protected_Procedure,
     50           F.An_Anonymous_Access_To_Function =>
     51             Asis.An_Anonymous_Access_To_Function,
     52           F.An_Anonymous_Access_To_Protected_Function =>
     53             Asis.An_Anonymous_Access_To_Protected_Function);
     54
     55      Kind : constant Asis.Extensions.Flat_Kinds.Element_Flat_Kind :=
     56        Asis.Extensions.Flat_Kinds.Flat_Kind (Definition);
     57   begin
     58      if Kind in Map'Range then
     59         return Map (Kind);
    4460      else
    4561         return Not_An_Access_Definition;
  • trunk/ada-2012/src/asis/asis-extensions-flat_kinds.adb

    r398 r399  
    192192with Gela.Elements.While_Loop_Statements;
    193193with Gela.Elements.With_Clauses;
     194with Gela.Elements.Defining_Names;
     195with Gela.Type_Managers;
     196with Gela.Semantic_Types;
     197with Gela.Type_Views;
    194198
    195199package body Asis.Extensions.Flat_Kinds is
     
    12431247      Node : not null Gela.Elements.Associations.Association_Access)
    12441248   is
    1245       pragma Unreferenced (Node);
    1246    begin
    1247       Self.Result := A_Parameter_Association;
     1249      Parent : Gela.Elements.Element_Access := Node.Enclosing_Element;
     1250   begin
     1251      while Auxilary ((Data => Parent)) loop
     1252         Parent := Parent.Enclosing_Element;
     1253      end loop;
     1254
     1255      Parent.Visit (Self);
     1256
     1257      case Self.Result is
     1258         when A_Record_Aggregate =>
     1259            Self.Result := A_Record_Component_Association;
     1260         when A_Discriminant_Constraint =>
     1261            Self.Result := A_Discriminant_Association;
     1262         when others =>
     1263            Self.Result := A_Parameter_Association;
     1264      end case;
    12481265   end Association;
    12491266
     
    14331450        Composite_Constraint_Access)
    14341451   is
    1435       pragma Unreferenced (Node);
    1436    begin
    1437       Self.Result := An_Index_Constraint;  --  FIXME
     1452      use type Gela.Type_Views.Type_View_Access;
     1453
     1454      Comp : constant Gela.Compilations.Compilation_Access :=
     1455        Node.Enclosing_Compilation;
     1456
     1457      TM : constant Gela.Type_Managers.Type_Manager_Access :=
     1458        Comp.Context.Types;
     1459
     1460      Subtype_Indication : constant Gela.Elements.Subtype_Indications.
     1461        Subtype_Indication_Access :=
     1462          Gela.Elements.Subtype_Indications.Subtype_Indication_Access
     1463            (Node.Enclosing_Element);
     1464
     1465      Type_Index : constant Gela.Semantic_Types.Type_Index :=
     1466        Subtype_Indication.Type_Index;
     1467
     1468      Type_View : constant Gela.Type_Views.Type_View_Access :=
     1469        TM.Get (Type_Index);
     1470   begin
     1471      if Type_View /= null and then Type_View.Category in
     1472        Gela.Type_Views.A_String .. Gela.Type_Views.An_Other_Array
     1473      then
     1474         Self.Result := An_Index_Constraint;
     1475      else
     1476         Self.Result := A_Discriminant_Constraint;
     1477      end if;
    14381478   end Composite_Constraint;
    14391479
     
    17511791      Node : not null Gela.Elements.Identifiers.Identifier_Access)
    17521792   is
    1753       pragma Unreferenced (Node);
    1754    begin
     1793      Name : constant Gela.Elements.Defining_Names.Defining_Name_Access :=
     1794        Node.Defining_Name;
     1795   begin
     1796      if Name.Assigned then
     1797         Name.Visit (Self);
     1798
     1799         if Self.Result = A_Defining_Enumeration_Literal then
     1800            Self.Result := An_Enumeration_Literal;
     1801
     1802            return;
     1803         end if;
     1804      end if;
     1805
    17551806      Self.Result := An_Identifier;
    17561807   end Identifier;
  • trunk/ada-2012/src/asis/asis-extensions-flat_kinds.ads

    r388 r399  
    11package Asis.Extensions.Flat_Kinds is
     2   pragma Preelaborate;
    23
    34   type Element_Flat_Kind is
  • trunk/ada-2012/src/asis/asis-extensions.ads

    r252 r399  
    11package Asis.Extensions is
     2   pragma Preelaborate;
    23
    34end Asis.Extensions;
  • trunk/ada-2012/src/asis/asis.adb

    r351 r399  
    22with Asis.Exceptions;
    33with Asis.Implementation;
     4with Asis.Extensions.Flat_Kinds;
    45
    56with Gela.Element_Visiters;
     
    116117              Composite_Constraint_Access)
    117118         is
    118             pragma Unreferenced (Node);
    119          begin
    120             Self.Result := Self.Flags (Is_Association);
     119            use type Asis.Extensions.Flat_Kinds.Element_Flat_Kind;
     120
     121            Kind : constant Asis.Extensions.Flat_Kinds.Element_Flat_Kind :=
     122              Asis.Extensions.Flat_Kinds.Flat_Kind
     123                ((Data => Gela.Elements.Element_Access (Node)));
     124         begin
     125            if Kind = Asis.Extensions.Flat_Kinds.An_Index_Constraint then
     126               Self.Result := Self.Flags (Is_Association);
     127            else
     128               Self.Result := False;
     129            end if;
    121130         end Composite_Constraint;
    122131
  • trunk/ada-2012/src/semantic/gela-plain_type_managers.adb

    r396 r399  
    22with Gela.Element_Factories;
    33with Gela.Element_Visiters;
     4with Gela.Elements.Component_Declarations;
     5with Gela.Elements.Component_Definitions;
    46with Gela.Elements.Defining_Identifiers;
     7with Gela.Elements.Discriminant_Specifications;
     8with Gela.Elements.Identifiers;
    59with Gela.Elements.Object_Declarations;
    610with Gela.Elements.Object_Definitions;
    711with Gela.Elements.Record_Type_Definitions;
    812with Gela.Elements.Root_Type_Definitions;
     13with Gela.Elements.Subtype_Indication_Or_Access_Definitions;
    914with Gela.Elements.Subtype_Indications;
     15with Gela.Elements.Subtype_Mark_Or_Access_Definitions;
    1016with Gela.Elements.Type_Definitions;
     17with Gela.Elements.Unconstrained_Array_Definitions;
    1118with Gela.Plain_Type_Views;
    12 with Gela.Elements.Identifiers;
    13 with Gela.Elements.Discriminant_Specifications;
    14 with Gela.Elements.Subtype_Mark_Or_Access_Definitions;
    15 with Gela.Elements.Component_Declarations;
    16 with Gela.Elements.Component_Definitions;
    17 with Gela.Elements.Subtype_Indication_Or_Access_Definitions;
    1819
    1920package body Gela.Plain_Type_Managers is
     
    179180              Root_Type_Definition_Access);
    180181
     182         overriding procedure Unconstrained_Array_Definition
     183           (Self : in out Visiter;
     184            Node : not null Gela.Elements.Unconstrained_Array_Definitions.
     185              Unconstrained_Array_Definition_Access);
     186
    181187      end Visiters;
    182188
     
    228234            Self.Result := Node.Type_Kind;
    229235         end Root_Type_Definition;
     236
     237         overriding procedure Unconstrained_Array_Definition
     238           (Self : in out Visiter;
     239            Node : not null Gela.Elements.Unconstrained_Array_Definitions.
     240              Unconstrained_Array_Definition_Access) is
     241         begin
     242            Self.Result := Type_From_Declaration.Self.Get
     243              (Category => Gela.Type_Views.An_Other_Array,
     244               Decl     => Gela.Elements.Full_Type_Declarations.
     245                 Full_Type_Declaration_Access (Node.Enclosing_Element));
     246         end Unconstrained_Array_Definition;
     247
    230248      end Visiters;
    231249
  • trunk/ada-2012/tests/asis/asis2xml.gpl/list.txt

    r387 r399  
    55./A/A27003A.ADA 2988623080
    66./A/A29003A.ADA 470204489
     7./A/A2A031A.ADA 84672784
  • trunk/ada-2012/tests/asis/def_name/def_name.adb

    r383 r399  
    9090              (Asis.Expressions.Selector (Item));
    9191         when Asis.An_Operator_Symbol =>
     92            On_Identifier (Item);
     93         when Asis.An_Enumeration_Literal =>
    9294            On_Identifier (Item);
    9395         when others =>
Note: See TracChangeset for help on using the changeset viewer.