Changeset 324


Ignore:
Timestamp:
Nov 10, 2014, 4:26:09 PM (6 years ago)
Author:
Maxim Reznik
Message:

Implement more Asis queries

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

Legend:

Unmodified
Added
Removed
  • trunk/ada-2012/src/asis/asis-declarations.adb

    r320 r324  
    1313with Asis.Compilation_Units;
    1414
     15with Gela.Compilations;
     16
    1517with Gela.Element_Visiters;
     18with Gela.Elements.Defining_Identifiers;
     19with Gela.Elements.Defining_Program_Unit_Names;
    1620with Gela.Elements.Entry_Bodies;
    1721with Gela.Elements.Function_Bodies;
    1822with Gela.Elements.Package_Bodies;
     23with Gela.Elements.Parameter_Specifications;
    1924with Gela.Elements.Procedure_Bodies;
     25with Gela.Elements.Procedure_Declarations;
    2026with Gela.Elements.Task_Bodies;
    2127with Gela.Elements.Statements;
     28with Gela.Lexical_Types;
    2229
    2330package body Asis.Declarations is
     
    597604      return Program_Text
    598605   is
     606      package Get is
     607         type Visiter is new Gela.Element_Visiters.Visiter with record
     608            Symbol : Gela.Lexical_Types.Symbol;
     609         end record;
     610
     611         overriding procedure Defining_Identifier
     612           (Self : in out Visiter;
     613            Node : not null Gela.Elements.Defining_Identifiers.
     614              Defining_Identifier_Access);
     615      end Get;
     616
     617      package body Get is
     618
     619         overriding procedure Defining_Identifier
     620           (Self : in out Visiter;
     621            Node : not null Gela.Elements.Defining_Identifiers.
     622              Defining_Identifier_Access)
     623         is
     624            Token : constant Gela.Lexical_Types.Token_Count :=
     625              Node.Identifier_Token;
     626            Comp  : constant Gela.Compilations.Compilation_Access :=
     627              Node.Enclosing_Compilation;
     628         begin
     629            Self.Symbol := Comp.Get_Token (Token).Symbol;
     630         end Defining_Identifier;
     631      end Get;
     632
     633      V       : Get.Visiter;
     634      Comp    : Gela.Compilations.Compilation_Access;
     635      Context : Gela.Contexts.Context_Access;
    599636   begin
    600637      Check_Nil_Element (Defining_Name, "Defining_Name_Image");
    601       Raise_Not_Implemented ("");
    602       return "";
     638      Defining_Name.Data.Visit (V);
     639      Comp := Defining_Name.Data.Enclosing_Compilation;
     640      Context := Comp.Context;
     641      return Context.Symbols.Image (V.Symbol).To_UTF_16_Wide_String;
    603642   end Defining_Name_Image;
    604643
     
    833872      return Asis.Defining_Name_List
    834873   is
     874      package Get is
     875         type Visiter is new Gela.Element_Visiters.Visiter with record
     876            Name  : Gela.Elements.Element_Access;
     877            Names : Gela.Elements.Element_Sequence_Access;
     878         end record;
     879
     880         overriding procedure Procedure_Body
     881           (Self : in out Visiter;
     882            Node : not null Gela.Elements.Procedure_Bodies.
     883              Procedure_Body_Access);
     884
     885         overriding procedure Procedure_Declaration
     886           (Self : in out Visiter;
     887            Node : not null Gela.Elements.Procedure_Declarations.
     888              Procedure_Declaration_Access);
     889
     890      end Get;
     891
     892      package body Get is
     893
     894         overriding procedure Procedure_Body
     895           (Self : in out Visiter;
     896            Node : not null Gela.Elements.Procedure_Bodies.
     897              Procedure_Body_Access)
     898         is
     899            Name : constant Gela.Elements.Defining_Program_Unit_Names.
     900              Defining_Program_Unit_Name_Access := Node.Names;
     901         begin
     902            Self.Name := Gela.Elements.Element_Access (Name);
     903         end Procedure_Body;
     904
     905         overriding procedure Procedure_Declaration
     906           (Self : in out Visiter;
     907            Node : not null Gela.Elements.Procedure_Declarations.
     908              Procedure_Declaration_Access)
     909         is
     910            Name : constant Gela.Elements.Defining_Program_Unit_Names.
     911              Defining_Program_Unit_Name_Access := Node.Names;
     912         begin
     913            Self.Name := Gela.Elements.Element_Access (Name);
     914         end Procedure_Declaration;
     915
     916      end Get;
     917
     918      use type Gela.Elements.Element_Access;
     919      use type Gela.Elements.Element_Sequence_Access;
     920      V : Get.Visiter;
    835921   begin
    836922      Check_Nil_Element (Declaration, "Names");
    837       Raise_Not_Implemented ("");
    838       return Nil_Element_List;
     923      Declaration.Data.Visit (V);
     924
     925      if V.Name /= null then
     926         return (1 => (Data => V.Name));
     927      elsif V.Names /= null then
     928         return Asis.To_List (V.Names);
     929      else
     930         Raise_Not_Implemented ("");
     931         return Asis.Nil_Element_List;
     932      end if;
    839933   end Names;
    840934
     
    9141008      return Asis.Parameter_Specification_List
    9151009   is
     1010      package Get is
     1011         type Visiter is new Gela.Element_Visiters.Visiter with record
     1012            List : Gela.Elements.Element_Sequence_Access;
     1013         end record;
     1014
     1015         overriding procedure Procedure_Declaration
     1016           (Self : in out Visiter;
     1017            Node : not null Gela.Elements.Procedure_Declarations.
     1018              Procedure_Declaration_Access);
     1019
     1020      end Get;
     1021
     1022      package body Get is
     1023
     1024         overriding procedure Procedure_Declaration
     1025           (Self : in out Visiter;
     1026            Node : not null Gela.Elements.Procedure_Declarations.
     1027              Procedure_Declaration_Access)
     1028         is
     1029            List : constant Gela.Elements.Parameter_Specifications.
     1030              Parameter_Specification_Sequence_Access :=
     1031                Node.Parameter_Profile;
     1032         begin
     1033            Self.List := Gela.Elements.Element_Sequence_Access (List);
     1034         end Procedure_Declaration;
     1035
     1036      end Get;
     1037
     1038      V : Get.Visiter;
    9161039   begin
    9171040      Check_Nil_Element (Declaration, "Parameter_Profile");
    918       Raise_Not_Implemented ("");
    919       return Nil_Element_List;
     1041      Declaration.Data.Visit (V);
     1042
     1043      return Asis.To_List (V.List);
    9201044   end Parameter_Profile;
    9211045
  • trunk/ada-2012/src/asis/asis-elements.adb

    r318 r324  
    99--  Purpose:
    1010--  Procedural wrapper over Object-Oriented ASIS implementation
     11
     12with System.Storage_Elements;
    1113
    1214with Gela.Compilations;
     
    19681970
    19691971   function Hash (Element : in Asis.Element) return Asis.ASIS_Integer is
     1972      subtype Integer_Address is System.Storage_Elements.Integer_Address;
     1973      use type Integer_Address;
     1974      X : Integer_Address;
    19701975   begin
    19711976      if Assigned (Element) then
    1972          Raise_Not_Implemented ("");
    1973          return 0;
     1977         X := System.Storage_Elements.To_Integer (Element.Data.all'Address);
     1978         X := X and Integer_Address (ASIS_Integer'Last);
     1979         return ASIS_Integer (X);
    19741980      else
    19751981         return 0;
  • trunk/ada-2012/src/asis/asis-expressions.adb

    r323 r324  
    714714      package Get is
    715715         type Visiter is new Gela.Element_Visiters.Visiter with record
    716             Symbol : Gela.Lexical_Types.Symbol;
     716            Token : Gela.Lexical_Types.Token_Count;
    717717         end record;
    718718
     
    735735              Numeric_Literal_Access)
    736736         is
    737             Token : constant Gela.Lexical_Types.Token_Count :=
    738               Node.Numeric_Literal_Token;
    739             Comp  : constant Gela.Compilations.Compilation_Access :=
    740               Node.Enclosing_Compilation;
    741737         begin
    742             Self.Symbol := Comp.Get_Token (Token).Symbol;
     738            Self.Token := Node.Numeric_Literal_Token;
    743739         end Numeric_Literal;
    744740
     
    748744              String_Literal_Access)
    749745         is
    750             Token : constant Gela.Lexical_Types.Token_Count :=
    751               Node.String_Literal_Token;
    752             Comp  : constant Gela.Compilations.Compilation_Access :=
    753               Node.Enclosing_Compilation;
    754746         begin
    755             Self.Symbol := Comp.Get_Token (Token).Symbol;
     747            Self.Token := Node.String_Literal_Token;
    756748         end String_Literal;
    757749
     
    760752      V       : Get.Visiter;
    761753      Comp    : Gela.Compilations.Compilation_Access;
    762       Context : Gela.Contexts.Context_Access;
     754      Source  : League.Strings.Universal_String;
     755      Token   : Gela.Lexical_Types.Token;
    763756   begin
    764757      Check_Nil_Element (Expression, "Value_Image");
    765758      Expression.Data.Visit (V);
    766759      Comp := Expression.Data.Enclosing_Compilation;
    767       Context := Comp.Context;
    768       return Context.Symbols.Image (V.Symbol).To_UTF_16_Wide_String;
     760      Source := Comp.Source;
     761      Token := Comp.Get_Token (V.Token);
     762      return Source.Slice (Token.First, Token.Last).To_UTF_16_Wide_String;
    769763   end Value_Image;
    770764
  • trunk/ada-2012/src/asis/asis-extensions-flat_kinds.adb

    r323 r324  
    265265   overriding procedure Association
    266266     (Self : in out Visiter;
    267       Node : not null Gela.Elements.Associations.Association_Access)
    268    is null;
     267      Node : not null Gela.Elements.Associations.Association_Access);
    269268
    270269   overriding procedure Asynchronous_Select
     
    717716   overriding procedure Function_Call
    718717     (Self : in out Visiter;
    719       Node : not null Gela.Elements.Function_Calls.Function_Call_Access)
    720    is null;
     718      Node : not null Gela.Elements.Function_Calls.Function_Call_Access);
    721719
    722720   overriding procedure Function_Declaration
     
    10091007     (Self : in out Visiter;
    10101008      Node : not null Gela.Elements.Procedure_Declarations.
    1011         Procedure_Declaration_Access)
    1012    is null;
     1009        Procedure_Declaration_Access);
    10131010
    10141011   overriding procedure Procedure_Instantiation
     
    10721069   overriding procedure Record_Aggregate
    10731070     (Self : in out Visiter;
    1074       Node : not null Gela.Elements.Record_Aggregates.Record_Aggregate_Access)
    1075    is null;
     1071      Node : not null Gela.Elements.Record_Aggregates.
     1072        Record_Aggregate_Access);
    10761073
    10771074   overriding procedure Record_Definition
     
    12601257     (Self : in out Visiter;
    12611258      Node : not null Gela.Elements.With_Clauses.With_Clause_Access);
     1259
     1260   overriding procedure Association
     1261     (Self : in out Visiter;
     1262      Node : not null Gela.Elements.Associations.Association_Access)
     1263   is
     1264      pragma Unreferenced (Node);
     1265   begin
     1266      Self.Result := A_Parameter_Association;
     1267   end Association;
    12621268
    12631269   -------------------------
     
    12991305   end Flat_Kind;
    13001306
     1307   -------------------
     1308   -- Function_Call --
     1309   -------------------
     1310
     1311   overriding procedure Function_Call
     1312     (Self : in out Visiter;
     1313      Node : not null Gela.Elements.Function_Calls.Function_Call_Access)
     1314   is
     1315      pragma Unreferenced (Node);
     1316   begin
     1317      Self.Result := A_Function_Call;
     1318   end Function_Call;
     1319
    13011320   --------------------
    13021321   -- Procedure_Body --
     
    13261345   end Procedure_Call_Statement;
    13271346
     1347   overriding procedure Procedure_Declaration
     1348     (Self : in out Visiter;
     1349      Node : not null Gela.Elements.Procedure_Declarations.
     1350        Procedure_Declaration_Access)
     1351   is
     1352      pragma Unreferenced (Node);
     1353   begin
     1354      Self.Result := A_Procedure_Declaration;
     1355   end Procedure_Declaration;
     1356
     1357   overriding procedure Record_Aggregate
     1358     (Self : in out Visiter;
     1359      Node : not null Gela.Elements.Record_Aggregates.Record_Aggregate_Access)
     1360   is
     1361      pragma Unreferenced (Node);
     1362   begin
     1363      Self.Result := A_Record_Aggregate;
     1364   end Record_Aggregate;
     1365
    13281366   ------------------------
    13291367   -- Selected_Component --
  • trunk/ada-2012/src/parser/gela-nodes-fixed_operator_symbols.adb

    r323 r324  
    2222   is
    2323      use type Gela.Lexical_Types.Symbol;
     24      Comp    : constant Gela.Compilations.Compilation_Access :=
     25        Self.Enclosing_Compilation;
     26      Token : constant Gela.Lexical_Types.Token :=
     27        Comp.Get_Token (Self.Operator_Symbol_Token);
    2428   begin
    25       if Self.Full_Name = Gela.Lexical_Types.No_Symbol then
     29      if Token.Symbol = Gela.Lexical_Types.No_Symbol then
    2630         Visiter.String_Literal (Self);
    2731      else
Note: See TracChangeset for help on using the changeset viewer.