Changeset 531


Ignore:
Timestamp:
Sep 18, 2017, 7:09:37 AM (5 years ago)
Author:
Maxim Reznik
Message:

Add chosen_interpretation to an identifier

If an identifier is used as a function call (without parameters)
set its chosen_interpretation to function call and create an empty
parameter list.

Add next test to asis2xml test list.

Location:
trunk/ada-2012
Files:
10 edited

Legend:

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

    r522 r531  
    11Synthesized attributes
    2  function_call,
    3  composite_constraint
    4   : Gela.Interpretations.Interpretation_Kinds : chosen_interpretation;
     2  function_call,
     3  identifier,
     4  composite_constraint
     5   : Gela.Interpretations.Interpretation_Kinds : chosen_interpretation;
    56
    67Rules for function_call. :
    78(.
    89      --  choose between Function_Call and Indexed_Component
     10      ${function_call.chosen_interpretation} :=
     11        Gela.Interpretations.Function_Call;
    912      Gela.Pass_Utils.Choose_Auxiliary_Apply_Interpretation
    1013        (Self.Compilation,
     
    2427.)
    2528
     29Rules for identifier.identifier_token :
     30(.
     31      --  choose between Function_Call and Identifier
     32      ${identifier.chosen_interpretation} := Gela.Interpretations.Identifier;
     33      Gela.Pass_Utils.Choose_Auxiliary_Apply_Interpretation
     34        (Self.Compilation,
     35         ${identifier.Down},
     36         ${identifier.chosen_interpretation});
     37.)
     38
    2639Rules for composite_constraint. :
    2740(.
  • trunk/ada-2012/src/asis/asis-expressions.adb

    r522 r531  
    513513            use type Gela.Lexical_Types.Token_Count;
    514514         begin
    515             Self.Result := Node.Left_Token /= 0;
     515            Self.Result := Node.Left_Token /= 0 or
     516              Node.Record_Component_Associations.Length = 0;
    516517         end Association_List;
    517518      end Get;
  • trunk/ada-2012/src/parser/gela-nodes-fixed_identifiers.adb

    r525 r531  
    11with Gela.Element_Factories;
     2with Gela.Elements.Associations;
    23with Gela.Elements.Identifiers;
    34with Gela.Property_Resets;
     
    3233   begin
    3334      return (Gela.Nodes.Identifiers.Create (Comp, Identifier_Token)
    34               with Prefix => null);
     35              with Prefix => null, Parameters => null);
    3536   end Create;
     37
     38   ------------------------------
     39   -- Function_Call_Parameters --
     40   ------------------------------
     41
     42   overriding function Function_Call_Parameters
     43     (Self : Identifier)
     44      return Gela.Elements.Association_Lists.Association_List_Access is
     45   begin
     46      return Self.Parameters;
     47   end Function_Call_Parameters;
     48
     49   ------------------
     50   -- Nested_Items --
     51   ------------------
     52
     53   overriding function Nested_Items
     54     (Self  : Identifier) return Gela.Elements.Nested_Array is
     55   begin
     56      if Self.Prefix.Assigned then
     57         return ((Gela.Elements.Nested_Element,
     58                 Gela.Elements.Element_Access (Self.Prefix)),
     59                 (Gela.Elements.Nested_Element,
     60                  Gela.Elements.Element_Access (Self.Parameters)));
     61      else
     62         return Gela.Nodes.Identifiers.Identifier (Self).Nested_Items;
     63      end if;
     64   end Nested_Items;
    3665
    3766   ------------
     
    6190               Set : aliased Gela.Property_Resets.Property_Reset;
    6291               Visiter : Gela.Property_Setters.Visiter (Set'Access);
     92               Sequence : Gela.Elements.Associations.
     93                 Association_Sequence_Access;
    6394            begin
    6495               Set.Defining_Name := Self.Defining_Name;
     
    69100               Set.Full_Name := Self.Full_Name;
    70101               Set.Static_Value := Self.Static_Value;
     102               Set.Chosen_Interpretation := Gela.Interpretations.Identifier;
    71103
    72104               Factory := Self.Enclosing_Compilation.Factory;
     
    74106               Identifier.Visit (Visiter);
    75107               Self.Prefix := Identifier;
     108               Sequence := Factory.Association_Sequence;
     109               Self.Parameters := Factory.Association_List (0, Sequence, 0);
     110
     111               Gela.Elements.Set_Enclosing.Element_Access (Self.Parameters)
     112                 .Set_Enclosing_Element (Self'Unchecked_Access);
     113               Gela.Elements.Set_Enclosing.Element_Access (Identifier)
     114                 .Set_Enclosing_Element (Self'Unchecked_Access);
    76115            end;
    77116         when Gela.Interpretations.Identifier =>
     
    81120      end case;
    82121   end Set_Chosen_Interpretation;
     122
     123   -----------------------
     124   -- Set_Defining_Name --
     125   -----------------------
     126
     127   overriding procedure Set_Defining_Name
     128     (Self    : in out Identifier;
     129      Value   : Gela.Elements.Defining_Names.Defining_Name_Access) is
     130   begin
     131      if Self.Prefix.Assigned then
     132         Gela.Nodes.Identifiers.Identifier (Self.Prefix.all)
     133           .Set_Defining_Name (Value);
     134      else
     135         Gela.Nodes.Identifiers.Identifier (Self).Set_Defining_Name (Value);
     136      end if;
     137   end Set_Defining_Name;
    83138
    84139   -----------
  • trunk/ada-2012/src/parser/gela-nodes-fixed_identifiers.ads

    r525 r531  
    44
    55
    6 with Gela.Nodes.Identifiers;
    76with Gela.Element_Visiters;
    87with Gela.Elements.Association_Lists;
     8with Gela.Elements.Defining_Names;
    99with Gela.Elements.Function_Calls;
    1010with Gela.Elements.Prefixes;
    1111with Gela.Interpretations;
     12with Gela.Nodes.Identifiers;
    1213
    1314package Gela.Nodes.Fixed_Identifiers is
     
    3132     and Gela.Elements.Function_Calls.Function_Call with
    3233   record
    33       Prefix : Gela.Elements.Prefixes.Prefix_Access;
     34      Prefix     : Gela.Elements.Prefixes.Prefix_Access;
     35      Parameters : Gela.Elements.Association_Lists.Association_List_Access;
    3436   end record;
    3537
     
    4042   overriding function Function_Call_Parameters
    4143     (Self : Identifier)
    42       return Gela.Elements.Association_Lists.Association_List_Access is
    43        (null);
     44      return Gela.Elements.Association_Lists.Association_List_Access;
    4445
    4546   overriding function Chosen_Interpretation
     
    5051      Value   : Gela.Interpretations.Interpretation_Kinds);
    5152
     53   overriding procedure Set_Defining_Name
     54     (Self    : in out Identifier;
     55      Value   : Gela.Elements.Defining_Names.Defining_Name_Access);
     56
    5257   overriding procedure Visit
    5358     (Self    : access Identifier;
    5459      Visiter : in out Gela.Element_Visiters.Visiter'Class);
    5560
     61   overriding function Nested_Items
     62     (Self  : Identifier) return Gela.Elements.Nested_Array;
     63
    5664end Gela.Nodes.Fixed_Identifiers;
  • trunk/ada-2012/src/semantic/gela-pass_utils.adb

    r497 r531  
    513513     (Comp   : Gela.Compilations.Compilation_Access;
    514514      Down   : Gela.Interpretations.Interpretation_Index;
    515       Result : out Gela.Interpretations.Unknown_Auxiliary_Apply_Kinds)
     515      Result : in out Gela.Interpretations.Unknown_Auxiliary_Apply_Kinds)
    516516   is
    517517      IM : constant Gela.Interpretations.Interpretation_Manager_Access :=
     
    520520      package Visiters is
    521521         type Visiter is new Gela.Interpretations.Down_Visiter with record
    522             Result : Gela.Interpretations.Interpretation_Kinds :=
    523               Gela.Interpretations.Function_Call;
     522            Result : Gela.Interpretations.Interpretation_Kinds;
    524523         end record;
    525524
     
    549548      end Visiters;
    550549
    551       V : Visiters.Visiter;
     550      V : Visiters.Visiter := (Result => Result);
    552551   begin
    553552      IM.Visit (Down, V);
  • trunk/ada-2012/src/semantic/gela-pass_utils.ads

    r514 r531  
    120120     (Comp   : Gela.Compilations.Compilation_Access;
    121121      Down   : Gela.Interpretations.Interpretation_Index;
    122       Result : out Gela.Interpretations.Unknown_Auxiliary_Apply_Kinds);
     122      Result : in out Gela.Interpretations.Unknown_Auxiliary_Apply_Kinds);
    123123   --  Maybe move it into separate unit???
    124124
  • trunk/ada-2012/src/semantic/gela-profiles-names.adb

    r415 r531  
    22with Gela.Element_Visiters;
    33with Gela.Elements.Defining_Identifiers;
     4with Gela.Elements.Function_Bodies;
    45with Gela.Elements.Function_Declarations;
    56with Gela.Elements.Parameter_Specifications;
     7with Gela.Elements.Procedure_Bodies;
     8with Gela.Elements.Procedure_Declarations;
    69with Gela.Type_Managers;
    7 with Gela.Elements.Procedure_Declarations;
    810
    911package body Gela.Profiles.Names is
     
    3840              Parameter_Specification_Sequence_Access);
    3941
     42         overriding procedure Function_Body
     43           (Self : in out Visiter;
     44            Node : not null Gela.Elements.Function_Bodies.
     45              Function_Body_Access);
     46
    4047         overriding procedure Function_Declaration
    4148           (Self : in out Visiter;
    4249            Node : not null Gela.Elements.Function_Declarations.
    4350              Function_Declaration_Access);
     51
     52         overriding procedure Procedure_Body
     53           (Self : in out Visiter;
     54            Node : not null Gela.Elements.Procedure_Bodies.
     55              Procedure_Body_Access);
    4456
    4557         overriding procedure Procedure_Declaration
     
    8496         end Add;
    8597
     98         overriding procedure Function_Body
     99           (Self : in out Visiter;
     100            Node : not null Gela.Elements.Function_Bodies.
     101              Function_Body_Access) is
     102         begin
     103            Self.Add (Node.Parameter_Profile);
     104         end Function_Body;
     105
    86106         overriding procedure Function_Declaration
    87107           (Self : in out Visiter;
     
    91111            Self.Add (Node.Parameter_Profile);
    92112         end Function_Declaration;
     113
     114         overriding procedure Procedure_Body
     115           (Self : in out Visiter;
     116            Node : not null Gela.Elements.Procedure_Bodies.
     117              Procedure_Body_Access) is
     118         begin
     119            Self.Add (Node.Parameter_Profile);
     120         end Procedure_Body;
    93121
    94122         overriding procedure Procedure_Declaration
     
    119147              Parameter_Specification_Sequence_Access);
    120148
     149         overriding procedure Function_Body
     150           (Self : in out Visiter;
     151            Node : not null Gela.Elements.Function_Bodies.
     152              Function_Body_Access);
     153
    121154         overriding procedure Function_Declaration
    122155           (Self : in out Visiter;
    123156            Node : not null Gela.Elements.Function_Declarations.
    124157              Function_Declaration_Access);
     158
     159         overriding procedure Procedure_Body
     160           (Self : in out Visiter;
     161            Node : not null Gela.Elements.Procedure_Bodies.
     162              Procedure_Body_Access);
    125163
    126164         overriding procedure Procedure_Declaration
     
    175213         end Add;
    176214
     215         overriding procedure Function_Body
     216           (Self : in out Visiter;
     217            Node : not null Gela.Elements.Function_Bodies.
     218              Function_Body_Access) is
     219         begin
     220            Self.Add (Node.Parameter_Profile);
     221
     222            Self.Result.Funct := True;
     223            Self.Result.Result :=
     224              TM.Type_From_Subtype_Mark (Env, Node.Result_Subtype);
     225         end Function_Body;
     226
    177227         overriding procedure Function_Declaration
    178228           (Self : in out Visiter;
    179229            Node : not null Gela.Elements.Function_Declarations.
    180               Function_Declaration_Access)
    181          is
     230              Function_Declaration_Access) is
    182231         begin
    183232            Self.Add (Node.Parameter_Profile);
     
    187236              TM.Type_From_Subtype_Mark (Env, Node.Result_Subtype);
    188237         end Function_Declaration;
     238
     239         overriding procedure Procedure_Body
     240           (Self : in out Visiter;
     241            Node : not null Gela.Elements.Procedure_Bodies.
     242              Procedure_Body_Access) is
     243         begin
     244            Self.Add (Node.Parameter_Profile);
     245         end Procedure_Body;
    189246
    190247         overriding procedure Procedure_Declaration
  • trunk/ada-2012/src/semantic/gela-resolve-each.adb

    r525 r531  
    11with Gela.Elements.Subtype_Indications;
    22with Gela.Plain_Int_Sets.Cursors;
    3 with Gela.Profiles;
    43with Gela.Types.Simple;
    54with Gela.Types.Visitors;
     
    193192            Decl : constant Gela.Elements.Element_Access :=
    194193              Name.Enclosing_Element;
    195             Profile : Gela.Profiles.Profile_Access;
    196194         begin
    197195            Self.Tipe := Self.TM.Type_Of_Object_Declaration (Self.Env, Decl);
    198196            exit when Self.Tipe not in 0;
    199             Profile := Self.TM.Get_Profile (Self.Env, Name);
    200 
    201             if Profile not in null and then
    202               Profile.Is_Function and then
    203               Profile.Allow_Empty_Argument_List
    204             then
    205                Self.Tipe := Profile.Return_Type;
    206                exit when Self.Tipe not in 0;
    207             end if;
    208197            Self.Name.Next;
    209198         end;
  • trunk/ada-2012/src/semantic/gela-resolve.adb

    r530 r531  
    565565      Set    : out Gela.Interpretations.Interpretation_Set_Index)
    566566   is
     567      procedure Add_Function
     568        (Name : Gela.Elements.Defining_Names.Defining_Name_Access);
     569
     570      TM : constant Gela.Type_Managers.Type_Manager_Access :=
     571        Comp.Context.Types;
    567572      IM : constant Gela.Interpretations.Interpretation_Manager_Access :=
    568573        Comp.Context.Interpretation_Manager;
    569574      ES : constant Gela.Environments.Environment_Set_Access :=
    570575        Comp.Context.Environment_Set;
     576
     577      ------------------
     578      -- Add_Function --
     579      ------------------
     580
     581      procedure Add_Function
     582        (Name : Gela.Elements.Defining_Names.Defining_Name_Access)
     583      is
     584         Tipe    : Gela.Semantic_Types.Type_Index;
     585         Profile : constant Gela.Profiles.Profile_Access :=
     586            TM.Get_Profile (Env, Name);
     587      begin
     588         if Profile not in null and then
     589           Profile.Is_Function and then
     590           Profile.Allow_Empty_Argument_List
     591         then
     592            Tipe := Profile.Return_Type;
     593
     594            if Tipe not in 0 then
     595               IM.Add_Expression
     596                 (Tipe   => Tipe,
     597                  Kind   => Gela.Interpretations.Function_Call,
     598               Down   => (1 .. 0 => 0),
     599                  Result => Set);
     600            end if;
     601         end if;
     602      end Add_Function;
     603
    571604      DV : Gela.Defining_Name_Cursors.Defining_Name_Cursor'Class :=
    572605        ES.Direct_Visible (Env, Symbol);
     
    582615            Down   => (1 .. 0 => 0),
    583616            Result => Set);
     617
     618         Add_Function (DV.Element);
    584619
    585620         DV.Next;
     
    599634               Down   => (1 .. 0 => 0),
    600635               Result => Set);
     636
     637            Add_Function (UV.Element);
    601638
    602639            UV.Next;
     
    16011638            end loop;
    16021639
     1640            for R in IM.Categories (Right) loop
     1641               declare
     1642                  Match : constant Gela.Interpretations.Type_Matcher_Access :=
     1643                    R.Matcher;
     1644               begin
     1645                  L_Type_View.Visit (Match.all);
     1646
     1647                  if Match.Is_Matched then
     1648                     Comp.Context.Interpretation_Manager.Add_Expression
     1649                       (Tipe   => L_Tipe,
     1650                        Down   => (L.Get_Index, R.Get_Index),
     1651                        Result => Set);
     1652                  end if;
     1653               end;
     1654            end loop;
     1655
    16031656            if L_Type_View.Is_Integer then
    16041657               Increment
     
    16211674      end loop;
    16221675
     1676      for L in IM.Categories (Left) loop
     1677         for R in Each.Expression (IM, TM, Env, Right) loop
     1678            declare
     1679               Match : constant Gela.Interpretations.Type_Matcher_Access :=
     1680                 L.Matcher;
     1681               Type_View : constant Gela.Types.Type_View_Access :=
     1682                 TM.Get (R.Expression_Type);
     1683            begin
     1684               Type_View.Visit (Match.all);
     1685
     1686               if Match.Is_Matched then
     1687                  Comp.Context.Interpretation_Manager.Add_Expression
     1688                    (Tipe   => R.Expression_Type,
     1689                     Down   => (L.Get_Index, R.Get_Index),
     1690                     Result => Set);
     1691               end if;
     1692            end;
     1693         end loop;
     1694      end loop;
     1695
    16231696      if L_Val (Integer).Count = 1 and R_Val (Integer).Count = 1 then
    16241697         declare
    1625             Matcher   : constant Type_Matchers.Type_Matcher_Access :=
     1698            Matcher : constant Type_Matchers.Type_Matcher_Access :=
    16261699              new Type_Matchers.Integer_Type_Matcher;
    16271700         begin
  • trunk/ada-2012/tests/asis/asis2xml.gpl/list.txt

    r517 r531  
    1818./A/A49027C.ADA 2834957112
    1919./A/A54B01A.ADA 203052181
     20./A/A54B02A.ADA 2819796340
Note: See TracChangeset for help on using the changeset viewer.