Changeset 369


Ignore:
Timestamp:
Jan 4, 2015, 2:36:02 PM (6 years ago)
Author:
Maxim Reznik
Message:

Add more implementations for ASIS adapter

Location:
trunk/ada-2012/src/asis
Files:
2 edited

Legend:

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

    r324 r369  
    1414
    1515with Gela.Compilations;
    16 
    1716with Gela.Element_Visiters;
     17with Gela.Elements.Component_Declarations;
     18with Gela.Elements.Component_Definitions;
     19with Gela.Elements.Declarative_Items;
    1820with Gela.Elements.Defining_Identifiers;
    1921with Gela.Elements.Defining_Program_Unit_Names;
     22with Gela.Elements.Discriminant_Specifications;
    2023with Gela.Elements.Entry_Bodies;
     24with Gela.Elements.Formal_Object_Declarations;
    2125with Gela.Elements.Function_Bodies;
     26with Gela.Elements.Object_Declarations;
     27with Gela.Elements.Object_Definitions;
     28with Gela.Elements.Object_Renaming_Declarations;
    2229with Gela.Elements.Package_Bodies;
    2330with Gela.Elements.Parameter_Specifications;
    2431with Gela.Elements.Procedure_Bodies;
    2532with Gela.Elements.Procedure_Declarations;
     33with Gela.Elements.Protected_Definitions;
     34with Gela.Elements.Single_Protected_Declarations;
     35with Gela.Elements.Single_Task_Declarations;
     36with Gela.Elements.Statements;
     37with Gela.Elements.Subtype_Mark_Or_Access_Definitions;
    2638with Gela.Elements.Task_Bodies;
    27 with Gela.Elements.Statements;
     39with Gela.Elements.Task_Definitions;
    2840with Gela.Lexical_Types;
    2941
     
    5466   is
    5567      pragma Unreferenced (Include_Pragmas);
     68
     69      package Get is
     70         type Visiter is new Gela.Element_Visiters.Visiter with record
     71            Result : Gela.Elements.Declarative_Items.
     72              Declarative_Item_Sequence_Access;
     73         end record;
     74
     75         overriding procedure Entry_Body
     76           (Self : in out Visiter;
     77            Node : not null Gela.Elements.Entry_Bodies.Entry_Body_Access);
     78
     79         overriding procedure Function_Body
     80           (Self : in out Visiter;
     81            Node : not null Gela.Elements.Function_Bodies.
     82              Function_Body_Access);
     83
     84         overriding procedure Package_Body
     85           (Self : in out Visiter;
     86            Node : not null Gela.Elements.Package_Bodies.Package_Body_Access);
     87
     88         overriding procedure Procedure_Body
     89           (Self : in out Visiter;
     90            Node : not null Gela.Elements.Procedure_Bodies.
     91              Procedure_Body_Access);
     92
     93         overriding procedure Task_Body
     94           (Self : in out Visiter;
     95            Node : not null Gela.Elements.Task_Bodies.Task_Body_Access);
     96
     97      end Get;
     98
     99      package body Get is
     100
     101         overriding procedure Entry_Body
     102           (Self : in out Visiter;
     103            Node : not null Gela.Elements.Entry_Bodies.Entry_Body_Access) is
     104         begin
     105            Self.Result := Node.Body_Declarative_Items;
     106         end Entry_Body;
     107
     108         overriding procedure Function_Body
     109           (Self : in out Visiter;
     110            Node : not null Gela.Elements.Function_Bodies.
     111              Function_Body_Access) is
     112         begin
     113            Self.Result := Node.Body_Declarative_Items;
     114         end Function_Body;
     115
     116         overriding procedure Package_Body
     117           (Self : in out Visiter;
     118            Node : not null Gela.Elements.Package_Bodies.Package_Body_Access)
     119         is
     120         begin
     121            Self.Result := Node.Body_Declarative_Items;
     122         end Package_Body;
     123
     124         overriding procedure Procedure_Body
     125           (Self : in out Visiter;
     126            Node : not null Gela.Elements.Procedure_Bodies.
     127              Procedure_Body_Access) is
     128         begin
     129            Self.Result := Node.Body_Declarative_Items;
     130         end Procedure_Body;
     131
     132         overriding procedure Task_Body
     133           (Self : in out Visiter;
     134            Node : not null Gela.Elements.Task_Bodies.Task_Body_Access) is
     135         begin
     136            Self.Result := Node.Body_Declarative_Items;
     137         end Task_Body;
     138
     139      end Get;
     140
     141      V : Get.Visiter;
     142      Result : Gela.Elements.Element_Sequence_Access;
    56143   begin
    57144      Check_Nil_Element (Declaration, "Body_Declarative_Items");
    58       Raise_Not_Implemented ("");
    59       return Nil_Element_List;
     145      Declaration.Data.Visit (V);
     146      Result := Gela.Elements.Element_Sequence_Access (V.Result);
     147
     148      return Asis.To_List (Result);
    60149   end Body_Declarative_Items;
    61150
     
    878967         end record;
    879968
     969         overriding procedure Object_Declaration
     970           (Self : in out Visiter;
     971            Node : not null Gela.Elements.Object_Declarations.
     972              Object_Declaration_Access);
     973
    880974         overriding procedure Procedure_Body
    881975           (Self : in out Visiter;
     
    891985
    892986      package body Get is
     987
     988         overriding procedure Object_Declaration
     989           (Self : in out Visiter;
     990            Node : not null Gela.Elements.Object_Declarations.
     991              Object_Declaration_Access)
     992         is
     993            Names : constant Gela.Elements.Defining_Identifiers.
     994              Defining_Identifier_Sequence_Access := Node.Names;
     995         begin
     996            Self.Names := Gela.Elements.Element_Sequence_Access (Names);
     997         end Object_Declaration;
    893998
    894999         overriding procedure Procedure_Body
     
    9751080
    9761081   function Object_Declaration_Subtype
    977      (Declaration : in Asis.Declaration)
    978       return Asis.Definition is
     1082     (Declaration : in Asis.Declaration) return Asis.Definition
     1083   is
     1084
     1085      package Get is
     1086         type Visiter is new Gela.Element_Visiters.Visiter with record
     1087            Result : Gela.Elements.Element_Access;
     1088         end record;
     1089
     1090         overriding procedure Component_Declaration
     1091           (Self : in out Visiter;
     1092            Node : not null Gela.Elements.Component_Declarations.
     1093              Component_Declaration_Access);
     1094
     1095         overriding procedure Discriminant_Specification
     1096           (Self : in out Visiter;
     1097            Node : not null Gela.Elements.Discriminant_Specifications.
     1098              Discriminant_Specification_Access);
     1099
     1100         overriding procedure Formal_Object_Declaration
     1101           (Self : in out Visiter;
     1102            Node : not null Gela.Elements.Formal_Object_Declarations.
     1103              Formal_Object_Declaration_Access);
     1104
     1105         overriding procedure Object_Declaration
     1106           (Self : in out Visiter;
     1107            Node : not null Gela.Elements.Object_Declarations.
     1108              Object_Declaration_Access);
     1109
     1110         overriding procedure Object_Renaming_Declaration
     1111           (Self : in out Visiter;
     1112            Node : not null Gela.Elements.Object_Renaming_Declarations.
     1113              Object_Renaming_Declaration_Access);
     1114
     1115         overriding procedure Parameter_Specification
     1116           (Self : in out Visiter;
     1117            Node : not null Gela.Elements.Parameter_Specifications.
     1118              Parameter_Specification_Access);
     1119
     1120         overriding procedure Single_Protected_Declaration
     1121           (Self : in out Visiter;
     1122            Node : not null Gela.Elements.Single_Protected_Declarations.
     1123              Single_Protected_Declaration_Access);
     1124
     1125         overriding procedure Single_Task_Declaration
     1126           (Self : in out Visiter;
     1127            Node : not null Gela.Elements.Single_Task_Declarations.
     1128              Single_Task_Declaration_Access);
     1129      end Get;
     1130
     1131      package body Get is
     1132
     1133         overriding procedure Component_Declaration
     1134           (Self : in out Visiter;
     1135            Node : not null Gela.Elements.Component_Declarations.
     1136              Component_Declaration_Access)
     1137         is
     1138            X : constant Gela.Elements.Component_Definitions.
     1139              Component_Definition_Access := Node.Object_Declaration_Subtype;
     1140         begin
     1141            Self.Result := Gela.Elements.Element_Access (X);
     1142         end Component_Declaration;
     1143
     1144         overriding procedure Discriminant_Specification
     1145           (Self : in out Visiter;
     1146            Node : not null Gela.Elements.Discriminant_Specifications.
     1147              Discriminant_Specification_Access)
     1148         is
     1149            X : constant Gela.Elements.Subtype_Mark_Or_Access_Definitions.
     1150              Subtype_Mark_Or_Access_Definition_Access :=
     1151                Node.Object_Declaration_Subtype;
     1152         begin
     1153            Self.Result := Gela.Elements.Element_Access (X);
     1154         end Discriminant_Specification;
     1155
     1156         overriding procedure Formal_Object_Declaration
     1157           (Self : in out Visiter;
     1158            Node : not null Gela.Elements.Formal_Object_Declarations.
     1159              Formal_Object_Declaration_Access)
     1160         is
     1161            X : constant Gela.Elements.Subtype_Mark_Or_Access_Definitions.
     1162              Subtype_Mark_Or_Access_Definition_Access :=
     1163                Node.Object_Declaration_Subtype;
     1164         begin
     1165            Self.Result := Gela.Elements.Element_Access (X);
     1166         end Formal_Object_Declaration;
     1167
     1168         overriding procedure Object_Declaration
     1169           (Self : in out Visiter;
     1170            Node : not null Gela.Elements.Object_Declarations.
     1171              Object_Declaration_Access)
     1172         is
     1173            X : constant Gela.Elements.Object_Definitions.
     1174              Object_Definition_Access := Node.Object_Declaration_Subtype;
     1175         begin
     1176            Self.Result := Gela.Elements.Element_Access (X);
     1177         end Object_Declaration;
     1178
     1179         overriding procedure Object_Renaming_Declaration
     1180           (Self : in out Visiter;
     1181            Node : not null Gela.Elements.Object_Renaming_Declarations.
     1182              Object_Renaming_Declaration_Access)
     1183         is
     1184            X : constant Gela.Elements.Subtype_Mark_Or_Access_Definitions.
     1185              Subtype_Mark_Or_Access_Definition_Access :=
     1186                Node.Object_Declaration_Subtype;
     1187         begin
     1188            Self.Result := Gela.Elements.Element_Access (X);
     1189         end Object_Renaming_Declaration;
     1190
     1191         overriding procedure Parameter_Specification
     1192           (Self : in out Visiter;
     1193            Node : not null Gela.Elements.Parameter_Specifications.
     1194              Parameter_Specification_Access)
     1195         is
     1196            X : constant Gela.Elements.Subtype_Mark_Or_Access_Definitions.
     1197              Subtype_Mark_Or_Access_Definition_Access :=
     1198                Node.Object_Declaration_Subtype;
     1199         begin
     1200            Self.Result := Gela.Elements.Element_Access (X);
     1201         end Parameter_Specification;
     1202
     1203         overriding procedure Single_Protected_Declaration
     1204           (Self : in out Visiter;
     1205            Node : not null Gela.Elements.Single_Protected_Declarations.
     1206              Single_Protected_Declaration_Access)
     1207         is
     1208            X : constant Gela.Elements.Protected_Definitions.
     1209              Protected_Definition_Access := Node.Object_Declaration_Subtype;
     1210         begin
     1211            Self.Result := Gela.Elements.Element_Access (X);
     1212         end Single_Protected_Declaration;
     1213
     1214         overriding procedure Single_Task_Declaration
     1215           (Self : in out Visiter;
     1216            Node : not null Gela.Elements.Single_Task_Declarations.
     1217              Single_Task_Declaration_Access)
     1218         is
     1219            X : constant Gela.Elements.Task_Definitions.
     1220              Task_Definition_Access := Node.Object_Declaration_Subtype;
     1221         begin
     1222            Self.Result := Gela.Elements.Element_Access (X);
     1223         end Single_Task_Declaration;
     1224
     1225      end Get;
     1226
     1227      V : Get.Visiter;
    9791228   begin
    9801229      Check_Nil_Element (Declaration, "Object_Declaration_Subtype");
    981       Raise_Not_Implemented ("");
    982       return Nil_Element;
     1230      Declaration.Data.Visit (V);
     1231
     1232      return (Data => V.Result);
    9831233   end Object_Declaration_Subtype;
    9841234
  • trunk/ada-2012/src/asis/asis-definitions.adb

    r340 r369  
    1010--  Procedural wrapper over Object-Oriented ASIS implementation
    1111
     12with Gela.Element_Visiters;
     13with Gela.Elements.Constraints;
     14with Gela.Elements.Simple_Expression_Range_Drs;
     15with Gela.Elements.Simple_Expressions;
     16with Gela.Elements.Subtype_Indications;
     17
    1218package body Asis.Definitions is
    1319
     
    534540
    535541   function Subtype_Constraint
    536      (Definition : in Asis.Definition)
    537       return Asis.Constraint
    538    is
     542     (Definition : in Asis.Definition) return Asis.Constraint
     543   is
     544      package Get is
     545         type Visiter is new Gela.Element_Visiters.Visiter with record
     546            Result : Gela.Elements.Element_Access;
     547         end record;
     548
     549         overriding procedure Subtype_Indication
     550           (Self : in out Visiter;
     551            Node : not null Gela.Elements.Subtype_Indications.
     552              Subtype_Indication_Access);
     553      end Get;
     554
     555      package body Get is
     556
     557         overriding procedure Subtype_Indication
     558           (Self : in out Visiter;
     559            Node : not null Gela.Elements.Subtype_Indications.
     560              Subtype_Indication_Access)
     561         is
     562            X : constant Gela.Elements.Constraints.Constraint_Access :=
     563              Node.Subtype_Constraint;
     564         begin
     565            Self.Result := Gela.Elements.Element_Access (X);
     566         end Subtype_Indication;
     567      end Get;
     568
     569      V : Get.Visiter;
    539570   begin
    540571      Check_Nil_Element (Definition, "Subtype_Constraint");
    541       Raise_Not_Implemented ("");
    542       return Asis.Nil_Element;
     572      Definition.Data.Visit (V);
     573
     574      return (Data => V.Result);
    543575   end Subtype_Constraint;
    544576
     
    565597      return Asis.Expression
    566598   is
     599      package Get is
     600         type Visiter is new Gela.Element_Visiters.Visiter with record
     601            Result : Gela.Elements.Element_Access;
     602         end record;
     603
     604         overriding procedure Simple_Expression_Range_Dr
     605           (Self : in out Visiter;
     606            Node : not null Gela.Elements.Simple_Expression_Range_Drs.
     607              Simple_Expression_Range_Dr_Access);
     608      end Get;
     609
     610      package body Get is
     611
     612         overriding procedure Simple_Expression_Range_Dr
     613           (Self : in out Visiter;
     614            Node : not null Gela.Elements.Simple_Expression_Range_Drs.
     615              Simple_Expression_Range_Dr_Access)
     616         is
     617            X : constant Gela.Elements.Simple_Expressions.
     618              Simple_Expression_Access := Node.Upper_Bound;
     619         begin
     620            Self.Result := Gela.Elements.Element_Access (X);
     621         end Simple_Expression_Range_Dr;
     622      end Get;
     623
     624      V : Get.Visiter;
    567625   begin
    568626      Check_Nil_Element (Constraint, "Upper_Bound");
    569       Raise_Not_Implemented ("");
    570       return Asis.Nil_Element;
     627      Constraint.Data.Visit (V);
     628
     629      return (Data => V.Result);
    571630   end Upper_Bound;
    572631
Note: See TracChangeset for help on using the changeset viewer.