Changeset 547


Ignore:
Timestamp:
Apr 28, 2018, 11:25:32 AM (4 years ago)
Author:
Maxim Reznik
Message:

Split subtype_indication into two

scalar_subtype_indication and composite_subtype_indication.
This allows have different types for "Up" property.
scalar_subtype_indication has Interpretation_Set_Index and
composite_subtype_indication has Interpretation_Tuple_List_Index.
"Up" property of scalar_subtype_indication should have the same
type as expression, because both of them are membership_choice.

Location:
trunk/ada-2012/src
Files:
22 edited

Legend:

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

    r546 r547  
    1818  composite_constraint,
    1919  constrained_array_definition,
    20   constraint,
    2120  decimal_fixed_point_definition,
    2221  delta_constraint,
     
    7574  simple_name,
    7675  string_literal,
     76  scalar_subtype_indication,
     77  composite_subtype_indication,
    7778  subtype_indication,
    7879  subtype_indication_or_access_definition,
     
    10611062.)
    10621063
    1063 Rules for subtype_indication. :
     1064Rules for scalar_subtype_indication. :
    10641065(.
    10651066      --  3.2.2 (8)
    10661067      Gela.Pass_Utils.Resolve.Shall_Be_Subtype
    10671068        (Self.Compilation,
    1068          ${subtype_indication.env_in}, ${subtype_mark.Up}, ${subtype_mark.Down});
    1069 .)
    1070 
    1071 Rules for subtype_indication. :
     1069         ${scalar_subtype_indication.env_in},
     1070         ${subtype_mark.Up},
     1071         ${subtype_mark.Down});
     1072.)
     1073
     1074Rules for scalar_subtype_indication. :
    10721075(.
    10731076      Gela.Pass_Utils.Resolve.Constraint
    10741077        (Self.Compilation,
    1075          Subtype_Constraint,
    1076          ${subtype_indication.env_in},
     1078         Scalar_Constraint,
     1079         ${scalar_subtype_indication.env_in},
    10771080         ${subtype_mark.Up},
    1078          ${Subtype_Constraint.Up:0},
    1079          ${Subtype_Constraint.Down});
     1081         ${scalar_constraint.Up:0},
     1082         ${scalar_constraint.Down});
     1083.)
     1084
     1085Rules for composite_subtype_indication. :
     1086(.
     1087      --  3.2.2 (8)
     1088      Gela.Pass_Utils.Resolve.Shall_Be_Subtype
     1089        (Self.Compilation,
     1090         ${composite_subtype_indication.env_in},
     1091         ${subtype_mark.Up},
     1092         ${subtype_mark.Down});
     1093.)
     1094
     1095Rules for composite_subtype_indication. :
     1096(.
     1097      Gela.Pass_Utils.Resolve.Constraint
     1098        (Self.Compilation,
     1099         Composite_Constraint,
     1100         ${composite_subtype_indication.env_in},
     1101         ${subtype_mark.Up},
     1102         ${composite_constraint.Up:0},
     1103         ${composite_constraint.Down});
    10801104.)
    10811105
  • trunk/ada-2012/src/ag/env_in.ag

    r534 r547  
    9999  composite_constraint,
    100100  constrained_array_definition,
    101   constraint,
    102101  context_item,
    103102  decimal_fixed_point_definition,
     
    283282  subtype_declaration,
    284283  subtype_indication,
     284  scalar_subtype_indication,
     285  composite_subtype_indication,
    285286  subtype_indication_or_access_definition,
    286287  subtype_mark,
     
    27022703.)
    27032704
    2704 Rules for subtype_indication. :
    2705 (.
    2706       ${subtype_mark.env_in} := ${subtype_indication.env_in};
    2707 .)
    2708 
    2709 Rules for subtype_indication. :
     2705Rules for scalar_subtype_indication. :
     2706(.
     2707      ${subtype_mark.env_in} := ${scalar_subtype_indication.env_in};
     2708.)
     2709
     2710Rules for composite_subtype_indication. :
     2711(.
     2712      ${subtype_mark.env_in} := ${composite_subtype_indication.env_in};
     2713.)
     2714
     2715Rules for scalar_subtype_indication. :
    27102716(.
    27112717      --  Depend on ${subtype_mark.Errors}
    2712       ${Subtype_Constraint.env_in} := ${subtype_indication.env_in};
     2718      ${scalar_constraint.env_in} := ${scalar_subtype_indication.env_in};
     2719.)
     2720
     2721Rules for composite_subtype_indication. :
     2722(.
     2723      --  Depend on ${subtype_mark.Errors}
     2724      ${composite_constraint.env_in} := ${composite_subtype_indication.env_in};
    27132725.)
    27142726
  • trunk/ada-2012/src/ag/env_out.ag

    r534 r547  
    137137  subtype_declaration,
    138138  subtype_indication,
     139  scalar_subtype_indication,
     140  composite_subtype_indication,
    139141  subunit,
    140142  task_body,
     
    889891.)
    890892
    891 Rules for subtype_indication. :
    892 (.
    893       ${subtype_indication.env_out} := ${subtype_indication.env_in};
     893Rules for scalar_subtype_indication. :
     894(.
     895      ${scalar_subtype_indication.env_out} := ${scalar_subtype_indication.env_in};
     896.)
     897
     898Rules for composite_subtype_indication. :
     899(.
     900      ${composite_subtype_indication.env_out} := ${composite_subtype_indication.env_in};
    894901.)
    895902
  • trunk/ada-2012/src/ag/errors.ag

    r534 r547  
    2424  clause_or_pragma,
    2525  constrained_array_definition,
    26   constraint,
    2726  defining_expanded_unit_name,
    2827  defining_identifier,
     
    9897  string_literal,
    9998  subtype_indication,
     99  scalar_subtype_indication,
     100  composite_subtype_indication,
    100101  subtype_indication_or_access_definition,
    101102  subtype_mark,
     
    151152.)
    152153
    153 Rules for subtype_indication. :
    154 (.
    155       ${subtype_indication.Errors} := ${Subtype_Constraint.Errors:0};
     154Rules for scalar_subtype_indication. :
     155(.
     156      ${scalar_subtype_indication.Errors} := ${scalar_constraint.Errors:0};
     157.)
     158
     159Rules for composite_subtype_indication. :
     160(.
     161      ${composite_subtype_indication.Errors} := ${composite_constraint.Errors:0};
    156162.)
    157163
  • trunk/ada-2012/src/ag/syntax.ag

    r523 r547  
    317317;
    318318
    319 constraint ::= scalar_constraint | composite_constraint;
    320 
    321319composite_constraint ::=
    322320  token         <left_token>
     
    16851683
    16861684subtype_indication ::=
     1685  scalar_subtype_indication | composite_subtype_indication;
     1686
     1687scalar_subtype_indication ::=
     1688  subtype_mark
     1689  [scalar_constraint];
     1690
     1691composite_subtype_indication ::=
    16871692  token <not_token>
    16881693  token <null_token>
    16891694  subtype_mark
    1690   [constraint <Subtype_Constraint>];
     1695  [composite_constraint];
    16911696
    16921697subtype_indication_or_access_definition ::=
  • trunk/ada-2012/src/ag/up.ag

    r532 r547  
    1010  character_literal,
    1111  clause_name,
    12   composite_constraint,
    1312  constrained_array_definition,
    14   constraint,
    1513  delta_constraint,
    1614  digits_constraint,
     
    5755  string_literal,
    5856  subtype_indication,
     57  scalar_subtype_indication,
     58  composite_subtype_indication,
    5959  subtype_indication_or_access_definition,
    6060  subtype_mark,
     
    7979  Record_Component_Associations,
    8080  Variants,
    81   association_list
     81  association_list,
     82  composite_constraint
    8283   : Gela.Interpretations.Interpretation_Tuple_List_Index : Up;
    8384
     
    233234Rules for composite_constraint. :
    234235(.
    235       ${composite_constraint.Up} :=
    236         Gela.Interpretations.Interpretation_Set_Index (${Associations.Up});
     236      ${composite_constraint.Up} := ${Associations.Up};
    237237.)
    238238
     
    409409.)
    410410
    411 Rules for subtype_indication. :
    412 (.
    413       ${subtype_indication.Up} := ${subtype_mark.Up};
     411Rules for scalar_subtype_indication. :
     412(.
     413      ${scalar_subtype_indication.Up} := ${subtype_mark.Up};
     414.)
     415
     416Rules for composite_subtype_indication. :
     417(.
     418      ${composite_subtype_indication.Up} := ${subtype_mark.Up};
    414419.)
    415420
  • trunk/ada-2012/src/api/gela-type_managers.ads

    r541 r547  
    66with Gela.Elements.Defining_Names;
    77with Gela.Elements.Discrete_Subtype_Definitions;
     8with Gela.Elements.Object_Definitions;
    89with Gela.Elements.Subtype_Mark_Or_Access_Definitions;
    910with Gela.Profiles;
     
    4445      return Gela.Semantic_Types.Type_Index is abstract;
    4546   --  Get type view from given subtype mark
     47
     48   not overriding function Type_From_Subtype_Indication
     49     (Self  : access Type_Manager;
     50      Env   : Gela.Semantic_Types.Env_Index;
     51      Node  : access Gela.Elements.Object_Definitions.Object_Definition'Class)
     52      return Gela.Semantic_Types.Type_Index is abstract;
     53   --  Get type view from given subtype indication
    4654
    4755   not overriding function Type_From_Discrete_Subtype
  • trunk/ada-2012/src/api/gela-types-simple.ads

    r526 r547  
    1 limited with Gela.Elements.Subtype_Indications;
     1limited with Gela.Elements.Subtype_Marks;
    22
    33package Gela.Types.Simple is
     
    6565   not overriding function Get_Designated
    6666     (Self   : Object_Access_Type)
    67       return Gela.Elements.Subtype_Indications.Subtype_Indication_Access
     67      return Gela.Elements.Subtype_Marks.Subtype_Mark_Access
    6868        is abstract;
    6969
  • trunk/ada-2012/src/asis/asis-definitions.adb

    r415 r547  
    1111
    1212with Gela.Element_Visiters;
    13 with Gela.Elements.Constraints;
     13with Gela.Elements.Composite_Constraints;
     14with Gela.Elements.Composite_Subtype_Indications;
     15with Gela.Elements.Scalar_Constraints;
     16with Gela.Elements.Scalar_Subtype_Indications;
    1417with Gela.Elements.Simple_Expression_Range_Drs;
    1518with Gela.Elements.Simple_Expressions;
    16 with Gela.Elements.Subtype_Indications;
    1719
    1820package body Asis.Definitions is
     
    547549         end record;
    548550
    549          overriding procedure Subtype_Indication
     551         overriding procedure Composite_Subtype_Indication
    550552           (Self : in out Visiter;
    551             Node : not null Gela.Elements.Subtype_Indications.
    552               Subtype_Indication_Access);
     553            Node : not null Gela.Elements.Composite_Subtype_Indications.
     554              Composite_Subtype_Indication_Access);
     555
     556         overriding procedure Scalar_Subtype_Indication
     557           (Self : in out Visiter;
     558            Node : not null Gela.Elements.Scalar_Subtype_Indications.
     559              Scalar_Subtype_Indication_Access);
    553560      end Get;
    554561
    555562      package body Get is
    556563
    557          overriding procedure Subtype_Indication
     564         overriding procedure Composite_Subtype_Indication
    558565           (Self : in out Visiter;
    559             Node : not null Gela.Elements.Subtype_Indications.
    560               Subtype_Indication_Access)
     566            Node : not null Gela.Elements.Composite_Subtype_Indications.
     567              Composite_Subtype_Indication_Access)
    561568         is
    562             X : constant Gela.Elements.Constraints.Constraint_Access :=
    563               Node.Subtype_Constraint;
     569            X : constant Gela.Elements.Composite_Constraints.
     570              Composite_Constraint_Access := Node.Composite_Constraint;
    564571         begin
    565572            Self.Result := Gela.Elements.Element_Access (X);
    566          end Subtype_Indication;
     573         end Composite_Subtype_Indication;
     574
     575         overriding procedure Scalar_Subtype_Indication
     576           (Self : in out Visiter;
     577            Node : not null Gela.Elements.Scalar_Subtype_Indications.
     578              Scalar_Subtype_Indication_Access)
     579         is
     580            X : constant Gela.Elements.Scalar_Constraints.
     581              Scalar_Constraint_Access := Node.Scalar_Constraint;
     582         begin
     583            Self.Result := Gela.Elements.Element_Access (X);
     584         end Scalar_Subtype_Indication;
    567585      end Get;
    568586
  • trunk/ada-2012/src/asis/asis-extensions-flat_kinds.adb

    r539 r547  
    3535with Gela.Elements.Component_Definitions;
    3636with Gela.Elements.Composite_Constraints;
     37with Gela.Elements.Composite_Subtype_Indications;
    3738with Gela.Elements.Constrained_Array_Definitions;
    3839with Gela.Elements.Decimal_Fixed_Point_Definitions;
     
    165166with Gela.Elements.Requeue_Statements;
    166167with Gela.Elements.Return_Object_Specifications;
     168with Gela.Elements.Scalar_Subtype_Indications;
    167169with Gela.Elements.Select_Or_Paths;
    168170with Gela.Elements.Selected_Components;
     
    178180with Gela.Elements.String_Literals;
    179181with Gela.Elements.Subtype_Declarations;
    180 with Gela.Elements.Subtype_Indications;
    181182with Gela.Elements.Subunits;
    182183with Gela.Elements.Task_Bodies;
     
    368369        Composite_Constraint_Access);
    369370
     371   overriding procedure Composite_Subtype_Indication
     372     (Self : in out Visiter;
     373      Node : not null Gela.Elements.Composite_Subtype_Indications.
     374        Composite_Subtype_Indication_Access);
     375
    370376   overriding procedure Constrained_Array_Definition
    371377     (Self : in out Visiter;
     
    10351041   is null;
    10361042
     1043   overriding procedure Scalar_Subtype_Indication
     1044     (Self : in out Visiter;
     1045      Node : not null Gela.Elements.Scalar_Subtype_Indications.
     1046        Scalar_Subtype_Indication_Access);
     1047
    10371048   overriding procedure Select_Or_Path
    10381049     (Self : in out Visiter;
     
    10961107      Node : not null Gela.Elements.Subtype_Declarations.
    10971108        Subtype_Declaration_Access);
    1098 
    1099    overriding procedure Subtype_Indication
    1100      (Self : in out Visiter;
    1101       Node : not null Gela.Elements.Subtype_Indications.
    1102         Subtype_Indication_Access);
    11031109
    11041110   overriding procedure Subunit
     
    14921498   end Composite_Constraint;
    14931499
     1500   overriding procedure Composite_Subtype_Indication
     1501     (Self : in out Visiter;
     1502      Node : not null Gela.Elements.Composite_Subtype_Indications.
     1503        Composite_Subtype_Indication_Access)
     1504   is
     1505      pragma Unreferenced (Node);
     1506   begin
     1507      Self.Result := A_Subtype_Indication;
     1508   end Composite_Subtype_Indication;
     1509
    14941510   overriding procedure Constrained_Array_Definition
    14951511     (Self : in out Visiter;
     
    24242440   end Requeue_Statement;
    24252441
     2442   overriding procedure Scalar_Subtype_Indication
     2443     (Self : in out Visiter;
     2444      Node : not null Gela.Elements.Scalar_Subtype_Indications.
     2445        Scalar_Subtype_Indication_Access)
     2446   is
     2447      pragma Unreferenced (Node);
     2448   begin
     2449      Self.Result := A_Subtype_Indication;
     2450   end Scalar_Subtype_Indication;
     2451
    24262452   overriding procedure Select_Or_Path
    24272453     (Self : in out Visiter;
     
    25532579   end Subtype_Declaration;
    25542580
    2555    overriding procedure Subtype_Indication
    2556      (Self : in out Visiter;
    2557       Node : not null Gela.Elements.Subtype_Indications.
    2558         Subtype_Indication_Access)
    2559    is
    2560       pragma Unreferenced (Node);
    2561    begin
    2562       Self.Result := A_Subtype_Indication;
    2563    end Subtype_Indication;
    2564 
    25652581   overriding procedure Task_Body
    25662582     (Self : in out Visiter;
  • trunk/ada-2012/src/parser/gela-larl_parsers.adb

    r537 r547  
    44with Gela.Elements.Associations;
    55with Gela.Elements.Composite_Constraints;
    6 with Gela.Elements.Constraints;
     6with Gela.Elements.Composite_Subtype_Indications;
    77with Gela.Elements.Defining_Expanded_Unit_Names;
    88with Gela.Elements.Expression_Or_Boxes;
    99with Gela.Elements.Identifiers;
    1010with Gela.Elements.Prefixes;
     11with Gela.Elements.Scalar_Subtype_Indications;
    1112with Gela.Elements.Selector_Names;
    1213with Gela.Elements.Subtype_Marks;
     14
    1315with Gela.LARL_Parsers.Data;
    1416with Gela.LARL_Parsers.On_Reduce;
     
    320322            Factory : not null Gela.Element_Factories.Element_Factory_Access;
    321323            Subtype_Mark : Gela.Elements.Subtype_Marks.Subtype_Mark_Access;
    322             Subtype_Constraint : Gela.Elements.Constraints.Constraint_Access;
     324            Subtype_Constraint : Gela.Elements.Composite_Constraints.
     325              Composite_Constraint_Access;
    323326         end record;
    324327
     
    350353            Self.Subtype_Mark :=
    351354              Gela.Elements.Subtype_Marks.Subtype_Mark_Access (Prefix);
    352             Self.Subtype_Constraint :=
    353               Gela.Elements.Constraints.Constraint_Access (CC);
     355            Self.Subtype_Constraint := CC;
    354356         end Function_Call;
    355357
     
    358360      V : Visiters.Visiter := (Self.Factory, null, null);
    359361   begin
    360       V.Subtype_Constraint := Gela.Elements.Constraints.Constraint_Access
    361         (Constraint);
    362 
    363       if not Constraint.Assigned then
     362      if Constraint.Assigned then
     363         declare
     364            Result : constant Gela.Elements.Scalar_Subtype_Indications
     365              .Scalar_Subtype_Indication_Access :=
     366                Self.Factory.Scalar_Subtype_Indication
     367                  (Gela.Elements.Subtype_Marks.Subtype_Mark_Access (Mark),
     368                   Constraint);
     369         begin
     370            return Gela.Elements.Subtype_Indications.Subtype_Indication_Access
     371              (Result);
     372         end;
     373
     374      else
    364375         Mark.Visit (V);
     376
     377         if not V.Subtype_Mark.Assigned then
     378            V.Subtype_Mark :=
     379              Gela.Elements.Subtype_Marks.Subtype_Mark_Access (Mark);
     380         end if;
     381
     382         declare
     383            Result : constant Gela.Elements.Composite_Subtype_Indications
     384              .Composite_Subtype_Indication_Access :=
     385                Self.Factory.Composite_Subtype_Indication
     386                  (Not_Token            => Not_Token,
     387                   Null_Token           => Null_Token,
     388                   Subtype_Mark         => V.Subtype_Mark,
     389                   Composite_Constraint => V.Subtype_Constraint);
     390         begin
     391            return Gela.Elements.Subtype_Indications.Subtype_Indication_Access
     392              (Result);
     393         end;
    365394      end if;
    366395
    367       if not V.Subtype_Mark.Assigned then
    368          V.Subtype_Mark :=
    369            Gela.Elements.Subtype_Marks.Subtype_Mark_Access (Mark);
    370       end if;
    371 
    372       return Self.Factory.Subtype_Indication
    373         (Not_Token          => Not_Token,
    374          Null_Token         => Null_Token,
    375          Subtype_Mark       => V.Subtype_Mark,
    376          Subtype_Constraint => V.Subtype_Constraint);
    377 
    378396   end To_Subtype_Indication;
    379397
  • trunk/ada-2012/src/semantic/gela-derived_type_views.adb

    r543 r547  
    9191   overriding function Get_Designated
    9292     (Self   : Type_View)
    93       return Gela.Elements.Subtype_Indications.Subtype_Indication_Access
    94    is
     93      return Gela.Elements.Subtype_Marks.Subtype_Mark_Access is
    9594   begin
    9695      return Gela.Types.Simple.Object_Access_Type_Access
  • trunk/ada-2012/src/semantic/gela-derived_type_views.ads

    r543 r547  
    11with Gela.Elements.Defining_Names;
    22with Gela.Elements.Full_Type_Declarations;
    3 with Gela.Elements.Subtype_Indications;
     3with Gela.Elements.Subtype_Marks;
    44with Gela.Lexical_Types;
    55with Gela.Types.Arrays;
     
    6161   overriding function Get_Designated
    6262     (Self   : Type_View)
    63       return Gela.Elements.Subtype_Indications.Subtype_Indication_Access;
     63      return Gela.Elements.Subtype_Marks.Subtype_Mark_Access;
    6464
    6565   overriding function Index_Types
  • trunk/ada-2012/src/semantic/gela-inheritance.adb

    r514 r547  
    44with Gela.Elements.Component_Declarations;
    55with Gela.Elements.Component_Items;
     6with Gela.Elements.Composite_Subtype_Indications;
    67with Gela.Elements.Defining_Identifiers;
    78with Gela.Elements.Defining_Names;
     
    1011with Gela.Elements.Record_Definitions;
    1112with Gela.Elements.Record_Type_Definitions;
     13with Gela.Elements.Scalar_Subtype_Indications;
    1214with Gela.Elements.Selected_Components;
    1315with Gela.Elements.Subtype_Indications;
    1416with Gela.Elements.Subtype_Marks;
    1517with Gela.Environments;
     18with Gela.Interpretations;
     19with Gela.Lexical_Types;
    1620with Gela.Property_Getters;
    1721with Gela.Property_Resets;
    1822with Gela.Property_Setters;
    1923with Gela.Property_Visiters;
    20 with Gela.Lexical_Types;
    21 with Gela.Interpretations;
    22 --  with Gela.Type_Managers;
    2324
    2425package body Gela.Inheritance is
     
    235236        Gela.Elements.Subtype_Indications.Subtype_Indication_Access :=
    236237          Node.Parent_Subtype_Indication;
    237       Subtype_Mark : constant
    238         Gela.Elements.Subtype_Marks.Subtype_Mark_Access :=
    239           Parent.Subtype_Mark;
    240238
    241239      package Each is
     
    247245         end record;
    248246
     247         overriding procedure Composite_Subtype_Indication
     248           (Self : in out Visiter;
     249            Node : not null Gela.Elements.Composite_Subtype_Indications.
     250              Composite_Subtype_Indication_Access);
     251
     252         overriding procedure Scalar_Subtype_Indication
     253           (Self : in out Visiter;
     254            Node : not null Gela.Elements.Scalar_Subtype_Indications.
     255              Scalar_Subtype_Indication_Access);
     256
    249257         overriding procedure Identifier
    250258           (Self : in out Visiter;
     
    295303         end Component_Declaration;
    296304
     305         overriding procedure Composite_Subtype_Indication
     306           (Self : in out Visiter;
     307            Node : not null Gela.Elements.Composite_Subtype_Indications.
     308              Composite_Subtype_Indication_Access) is
     309         begin
     310            Node.Subtype_Mark.Visit (Self);
     311         end Composite_Subtype_Indication;
     312
    297313         overriding procedure Full_Type_Declaration
    298314           (Self : in out Visiter;
     
    336352         end Record_Type_Definition;
    337353
     354         overriding procedure Scalar_Subtype_Indication
     355           (Self : in out Visiter;
     356            Node : not null Gela.Elements.Scalar_Subtype_Indications.
     357              Scalar_Subtype_Indication_Access) is
     358         begin
     359            Node.Subtype_Mark.Visit (Self);
     360         end Scalar_Subtype_Indication;
     361
    338362         overriding procedure Selected_Component
    339363           (Self : in out Visiter;
     
    353377         return;
    354378      end if;
    355       Subtype_Mark.Visit (V);
     379      Parent.Visit (V);
    356380      Inherited := Gela.Elements.Element_Sequence_Access (V.Components);
    357381   end Copy_Declarations;
  • trunk/ada-2012/src/semantic/gela-pass_utils.adb

    r543 r547  
    622622
    623623      Type_Index : constant Gela.Semantic_Types.Type_Index :=
    624         TM.Type_From_Subtype_Mark
    625           (Subtype_Indication.Env_In, Subtype_Indication.Subtype_Mark);
     624        TM.Type_From_Subtype_Indication
     625          (Subtype_Indication.Env_In, Subtype_Indication);
    626626
    627627      Type_View : constant Gela.Types.Type_View_Access :=
  • trunk/ada-2012/src/semantic/gela-plain_type_managers.adb

    r543 r547  
    88with Gela.Elements.Component_Declarations;
    99with Gela.Elements.Component_Definitions;
     10with Gela.Elements.Composite_Subtype_Indications;
    1011with Gela.Elements.Constrained_Array_Definitions;
    1112with Gela.Elements.Defining_Character_Literals;
     
    2728with Gela.Elements.Number_Declarations;
    2829with Gela.Elements.Object_Declarations;
    29 with Gela.Elements.Object_Definitions;
    3030with Gela.Elements.Package_Declarations;
    3131with Gela.Elements.Parameter_Specifications;
    3232with Gela.Elements.Record_Type_Definitions;
     33with Gela.Elements.Scalar_Subtype_Indications;
    3334with Gela.Elements.Selected_Components;
    3435with Gela.Elements.Selector_Names;
     
    672673            Parent : constant Gela.Elements.Subtype_Indications.
    673674              Subtype_Indication_Access := Node.Parent_Subtype_Indication;
    674             Subtype_Mark : constant Gela.Elements.Subtype_Marks
    675               .Subtype_Mark_Access  := Parent.Subtype_Mark;
    676675            Tipe : constant Gela.Semantic_Types.Type_Index :=
    677               Type_From_Declaration.Self.Type_From_Subtype_Mark
    678                 (Env, Subtype_Mark);
     676              Type_From_Declaration.Self.Type_From_Subtype_Indication
     677                (Env, Parent);
    679678            Type_View : Gela.Type_Categories.Type_View_Access;
    680679         begin
     
    842841            Indication : constant Gela.Elements.Subtype_Indications.
    843842              Subtype_Indication_Access := Node.Type_Declaration_View;
    844             Subtype_Mark : constant Gela.Elements.Subtype_Marks
    845               .Subtype_Mark_Access  := Indication.Subtype_Mark;
    846          begin
    847             Self.Result := Type_From_Declaration.Self.Type_From_Subtype_Mark
    848               (Env, Subtype_Mark);
     843         begin
     844            Self.Result :=
     845              Type_From_Declaration.Self.Type_From_Subtype_Indication
     846                (Env, Indication);
    849847         end Subtype_Declaration;
    850848
     
    10381036   end Type_From_Discrete_Subtype;
    10391037
     1038   overriding function Type_From_Subtype_Indication
     1039     (Self  : access Type_Manager;
     1040      Env   : Gela.Semantic_Types.Env_Index;
     1041      Node  : access Gela.Elements.Object_Definitions.Object_Definition'Class)
     1042      return Gela.Semantic_Types.Type_Index
     1043   is
     1044
     1045      package Visiters is
     1046         type Visiter is new Gela.Element_Visiters.Visiter with record
     1047            Result  : Gela.Semantic_Types.Type_Index := 0;
     1048         end record;
     1049
     1050         overriding procedure Composite_Subtype_Indication
     1051           (Self : in out Visiter;
     1052            Node : not null Gela.Elements.Composite_Subtype_Indications.
     1053              Composite_Subtype_Indication_Access);
     1054
     1055         overriding procedure Scalar_Subtype_Indication
     1056           (Self : in out Visiter;
     1057            Node : not null Gela.Elements.Scalar_Subtype_Indications.
     1058              Scalar_Subtype_Indication_Access);
     1059
     1060      end Visiters;
     1061
     1062      --------------
     1063      -- Visiters --
     1064      --------------
     1065
     1066      package body Visiters is
     1067
     1068         overriding procedure Composite_Subtype_Indication
     1069           (Self : in out Visiter;
     1070            Node : not null Gela.Elements.Composite_Subtype_Indications.
     1071              Composite_Subtype_Indication_Access) is
     1072         begin
     1073            Self.Result := Type_From_Subtype_Indication.Self.
     1074              Type_From_Subtype_Mark (Env, Node.Subtype_Mark);
     1075         end Composite_Subtype_Indication;
     1076
     1077         overriding procedure Scalar_Subtype_Indication
     1078           (Self : in out Visiter;
     1079            Node : not null Gela.Elements.Scalar_Subtype_Indications.
     1080              Scalar_Subtype_Indication_Access) is
     1081         begin
     1082            Self.Result := Type_From_Subtype_Indication.Self.
     1083              Type_From_Subtype_Mark (Env, Node.Subtype_Mark);
     1084         end Scalar_Subtype_Indication;
     1085
     1086      end Visiters;
     1087
     1088      V : Visiters.Visiter := (Result => 0);
     1089   begin
     1090      Node.Visit (V);
     1091
     1092      return V.Result;
     1093   end Type_From_Subtype_Indication;
     1094
    10401095   ----------------------------
    10411096   -- Type_From_Subtype_Mark --
     
    11711226              Parameter_Specification_Access);
    11721227
    1173          overriding procedure Subtype_Indication
    1174            (Self : in out Visiter;
    1175             Node : not null Gela.Elements.Subtype_Indications.
    1176               Subtype_Indication_Access);
    1177 
    11781228      end Visiters;
    11791229
     
    12011251                Node.Component_Subtype_Indication;
    12021252         begin
    1203             X.Visit (Self);
     1253            Self.Result :=
     1254              Type_Of_Object_Declaration.Self.Type_From_Subtype_Indication
     1255                (Env,
     1256                 Gela.Elements.Object_Definitions.Object_Definition_Access
     1257                   (X));
    12041258         end Component_Definition;
    12051259
     
    12731327              Object_Definition_Access := Node.Object_Declaration_Subtype;
    12741328         begin
    1275             X.Visit (Self);
     1329            Self.Result :=
     1330              Type_Of_Object_Declaration.Self.Type_From_Subtype_Indication
     1331                (Env, X);
    12761332         end Object_Declaration;
    12771333
     
    12891345         end Parameter_Specification;
    12901346
    1291          overriding procedure Subtype_Indication
    1292            (Self : in out Visiter;
    1293             Node : not null Gela.Elements.Subtype_Indications.
    1294               Subtype_Indication_Access)
    1295          is
    1296             X : constant Gela.Elements.Subtype_Marks.Subtype_Mark_Access  :=
    1297               Node.Subtype_Mark;
    1298          begin
    1299             Self.Result :=
    1300               Type_Of_Object_Declaration.Self.Type_From_Subtype_Mark (Env, X);
    1301          end Subtype_Indication;
    13021347      end Visiters;
    13031348
  • trunk/ada-2012/src/semantic/gela-plain_type_managers.ads

    r543 r547  
    99with Gela.Elements.Formal_Type_Declarations;
    1010with Gela.Elements.Full_Type_Declarations;
     11with Gela.Elements.Object_Definitions;
    1112with Gela.Elements.Root_Type_Definitions;
    1213with Gela.Elements.Subtype_Mark_Or_Access_Definitions;
     
    1415with Gela.Profiles;
    1516with Gela.Semantic_Types;
     17with Gela.Type_Categories;
    1618with Gela.Type_Managers;
    1719with Gela.Types;
    18 with Gela.Type_Categories;
    1920
    2021package Gela.Plain_Type_Managers is
     
    148149      return Gela.Semantic_Types.Type_Index;
    149150
     151   overriding function Type_From_Subtype_Indication
     152     (Self  : access Type_Manager;
     153      Env   : Gela.Semantic_Types.Env_Index;
     154      Node  : access Gela.Elements.Object_Definitions.Object_Definition'Class)
     155      return Gela.Semantic_Types.Type_Index;
     156
    150157   overriding function Type_From_Subtype_Mark
    151158     (Self  : access Type_Manager;
  • trunk/ada-2012/src/semantic/gela-plain_type_views.adb

    r543 r547  
    44with Gela.Elements.Component_Declarations;
    55with Gela.Elements.Component_Items;
     6with Gela.Elements.Composite_Subtype_Indications;
    67with Gela.Elements.Defining_Identifiers;
    78with Gela.Elements.Discriminant_Specifications;
     
    910with Gela.Elements.Record_Definitions;
    1011with Gela.Elements.Record_Type_Definitions;
     12with Gela.Elements.Scalar_Subtype_Indications;
    1113with Gela.Elements.Variant_Parts;
    1214with Gela.Elements.Variants;
     
    238240   overriding function Get_Designated
    239241     (Self   : Type_View)
    240       return Gela.Elements.Subtype_Indications.Subtype_Indication_Access
     242      return Gela.Elements.Subtype_Marks.Subtype_Mark_Access
    241243   is
    242244      package Get is
    243245         type Visiter is new Gela.Element_Visiters.Visiter with record
    244             Result : Gela.Elements.Subtype_Indications.
    245               Subtype_Indication_Access;
     246            Result : Gela.Elements.Subtype_Marks. Subtype_Mark_Access;
    246247         end record;
    247248
     
    251252              Access_To_Object_Definition_Access);
    252253
     254         overriding procedure Composite_Subtype_Indication
     255           (Self : in out Visiter;
     256            Node : not null Gela.Elements.Composite_Subtype_Indications.
     257              Composite_Subtype_Indication_Access);
     258
     259         overriding procedure Scalar_Subtype_Indication
     260           (Self : in out Visiter;
     261            Node : not null Gela.Elements.Scalar_Subtype_Indications.
     262              Scalar_Subtype_Indication_Access);
     263
    253264      end Get;
    254265
     
    260271              Access_To_Object_Definition_Access) is
    261272         begin
    262             Self.Result := Node.Subtype_Indication;
     273            Node.Subtype_Indication.Visit (Self);
    263274         end Access_To_Object_Definition;
     275
     276         overriding procedure Composite_Subtype_Indication
     277           (Self : in out Visiter;
     278            Node : not null Gela.Elements.Composite_Subtype_Indications.
     279              Composite_Subtype_Indication_Access) is
     280         begin
     281            Self.Result := Node.Subtype_Mark;
     282         end Composite_Subtype_Indication;
     283
     284         overriding procedure Scalar_Subtype_Indication
     285           (Self : in out Visiter;
     286            Node : not null Gela.Elements.Scalar_Subtype_Indications.
     287              Scalar_Subtype_Indication_Access) is
     288         begin
     289            Self.Result := Node.Subtype_Mark;
     290         end Scalar_Subtype_Indication;
    264291
    265292      end Get;
  • trunk/ada-2012/src/semantic/gela-plain_type_views.ads

    r543 r547  
    22with Gela.Elements.Full_Type_Declarations;
    33with Gela.Elements.Formal_Type_Declarations;
    4 with Gela.Elements.Subtype_Indications;
     4with Gela.Elements.Subtype_Marks;
    55with Gela.Elements.Discriminant_Parts;
    66with Gela.Lexical_Types;
     
    7474   overriding function Get_Designated
    7575     (Self   : Type_View)
    76       return Gela.Elements.Subtype_Indications.Subtype_Indication_Access;
     76      return Gela.Elements.Subtype_Marks.Subtype_Mark_Access;
    7777
    7878   overriding function Is_Expected_Type
  • trunk/ada-2012/src/semantic/gela-resolve-each.adb

    r542 r547  
    1 with Gela.Elements.Subtype_Indications;
    21with Gela.Plain_Int_Sets.Cursors;
    32with Gela.Types.Simple;
     
    364363         is
    365364            pragma Unreferenced (Self);
    366             SI : constant Gela.Elements.Subtype_Indications
    367               .Subtype_Indication_Access := Value.Get_Designated;
    368365            Index : constant Gela.Semantic_Types.Type_Index :=
    369366              Step.Self.Name.TM.Type_From_Subtype_Mark
    370                 (Step.Self.Name.Env, SI.Subtype_Mark);
     367                (Step.Self.Name.Env, Value.Get_Designated);
    371368         begin
    372369            Step.Self.Is_Implicit_Dereference := True;
  • trunk/ada-2012/src/semantic/gela-resolve.adb

    r546 r547  
    1212with Gela.Elements.Range_Attribute_References;
    1313with Gela.Elements.Simple_Expression_Ranges;
    14 with Gela.Elements.Subtype_Indications;
    1514with Gela.Environments;
    1615with Gela.Profiles;
     
    319318         type Visiter is new Gela.Element_Visiters.Visiter with null record;
    320319
     320         overriding procedure Range_Attribute_Reference
     321           (Self : in out Visiter;
     322            Node : not null Gela.Elements.Range_Attribute_References.
     323              Range_Attribute_Reference_Access);
     324
     325         overriding procedure Simple_Expression_Range
     326           (Self : in out Visiter;
     327            Node : not null Gela.Elements.Simple_Expression_Ranges.
     328              Simple_Expression_Range_Access);
     329
     330      end Each_Constraint;
     331
     332      package body Each_Constraint is
     333
     334         overriding procedure Range_Attribute_Reference
     335           (Self : in out Visiter;
     336            Node : not null Gela.Elements.Range_Attribute_References.
     337              Range_Attribute_Reference_Access)
     338         is
     339            pragma Unreferenced (Node, Self);
     340         begin
     341            --  3.5 (5)
     342            Gela.Resolve.To_Type
     343              (Comp    => Comp,
     344               Env     => Env,
     345               Type_Up => Type_Up,
     346               Expr_Up => Constr,
     347               Result  => Result);
     348         end Range_Attribute_Reference;
     349
     350         overriding procedure Simple_Expression_Range
     351           (Self : in out Visiter;
     352            Node : not null Gela.Elements.Simple_Expression_Ranges.
     353              Simple_Expression_Range_Access)
     354         is
     355            pragma Unreferenced (Node, Self);
     356         begin
     357            --  3.5 (5)
     358            Gela.Resolve.To_Type
     359              (Comp    => Comp,
     360               Env     => Env,
     361               Type_Up => Type_Up,
     362               Expr_Up => Constr,
     363               Result  => Result);
     364         end Simple_Expression_Range;
     365
     366      end Each_Constraint;
     367
     368      V : Each_Constraint.Visiter;
     369
     370   begin
     371      Result := 0;
     372
     373      if not Constraint.Assigned then
     374         return;
     375      end if;
     376
     377      Constraint.Visit (V);
     378   end Constraint;
     379
     380   procedure Constraint
     381     (Comp       : Gela.Compilations.Compilation_Access;
     382      Constraint : access Gela.Elements.Element'Class;
     383      Env        : Gela.Semantic_Types.Env_Index;
     384      Type_Up    : Gela.Interpretations.Interpretation_Set_Index;
     385      Constr     : Gela.Interpretations.Interpretation_Tuple_List_Index;
     386      Result     : out Gela.Interpretations.Interpretation_Index)
     387   is
     388      package Each_Constraint is
     389         type Visiter is new Gela.Element_Visiters.Visiter with null record;
     390
    321391         overriding procedure Composite_Constraint
    322392           (Self : in out Visiter;
    323393            Node : not null Gela.Elements.Composite_Constraints.
    324394              Composite_Constraint_Access);
    325 
    326          overriding procedure Range_Attribute_Reference
    327            (Self : in out Visiter;
    328             Node : not null Gela.Elements.Range_Attribute_References.
    329               Range_Attribute_Reference_Access);
    330 
    331          overriding procedure Simple_Expression_Range
    332            (Self : in out Visiter;
    333             Node : not null Gela.Elements.Simple_Expression_Ranges.
    334               Simple_Expression_Range_Access);
    335395
    336396      end Each_Constraint;
     
    352412            pragma Unreferenced (Node, Self);
    353413
    354             X : constant Gela.Interpretations.Interpretation_Tuple_List_Index
    355               := Gela.Interpretations.Interpretation_Tuple_List_Index (Constr);
    356 
    357414            Tuples : constant Gela.Interpretations
    358               .Interpretation_Tuple_Index_Array := IM.Get_Tuple_List (X);
     415              .Interpretation_Tuple_Index_Array := IM.Get_Tuple_List (Constr);
    359416
    360417            Output : Gela.Interpretations.Interpretation_Index_Array
     
    435492                    .Object_Access_Type_Access)
    436493               is
    437                   Designated : constant Gela.Elements.Subtype_Indications
    438                     .Subtype_Indication_Access := Value.Get_Designated;
    439494                  Des_Index  : constant Gela.Semantic_Types.Type_Index :=
    440                     TM.Type_From_Subtype_Mark (Env, Designated.Subtype_Mark);
     495                    TM.Type_From_Subtype_Mark (Env, Value.Get_Designated);
    441496                  Des_View   : constant Gela.Types.Type_View_Access :=
    442497                    TM.Get (Des_Index);
     
    526581         end Composite_Constraint;
    527582
    528          overriding procedure Range_Attribute_Reference
    529            (Self : in out Visiter;
    530             Node : not null Gela.Elements.Range_Attribute_References.
    531               Range_Attribute_Reference_Access)
    532          is
    533             pragma Unreferenced (Node, Self);
    534          begin
    535             --  3.5 (5)
    536             Gela.Resolve.To_Type
    537               (Comp    => Comp,
    538                Env     => Env,
    539                Type_Up => Type_Up,
    540                Expr_Up => Constr,
    541                Result  => Result);
    542          end Range_Attribute_Reference;
    543 
    544          overriding procedure Simple_Expression_Range
    545            (Self : in out Visiter;
    546             Node : not null Gela.Elements.Simple_Expression_Ranges.
    547               Simple_Expression_Range_Access)
    548          is
    549             pragma Unreferenced (Node, Self);
    550          begin
    551             --  3.5 (5)
    552             Gela.Resolve.To_Type
    553               (Comp    => Comp,
    554                Env     => Env,
    555                Type_Up => Type_Up,
    556                Expr_Up => Constr,
    557                Result  => Result);
    558          end Simple_Expression_Range;
    559 
    560583      end Each_Constraint;
    561584
     
    571594      Constraint.Visit (V);
    572595   end Constraint;
     596
    573597
    574598   -----------------
  • trunk/ada-2012/src/semantic/gela-resolve.ads

    r546 r547  
    150150     (Comp : Gela.Compilations.Compilation_Access)
    151151      return Gela.Interpretations.Interpretation_Set_Index;
     152
     153   procedure Constraint
     154     (Comp       : Gela.Compilations.Compilation_Access;
     155      Constraint : access Gela.Elements.Element'Class;
     156      Env        : Gela.Semantic_Types.Env_Index;
     157      Type_Up    : Gela.Interpretations.Interpretation_Set_Index;
     158      Constr     : Gela.Interpretations.Interpretation_Tuple_List_Index;
     159      Result     : out Gela.Interpretations.Interpretation_Index);
    152160
    153161   procedure Constraint
Note: See TracChangeset for help on using the changeset viewer.