with Asis.Declarations; with Asis.Expressions; with Asis.Elements; with Asis.Report; with Asis.Text; with Ada.Text_IO; with Ada.Characters.Handling; package body Asis.Toolkit.ObjectAda.Elements is Debug : constant Boolean := Asis.Report.Debug ( "Asis.Toolkit.ObjectAda.Elements.Debug" ); function Enclosing_Declaration (Element : in Asis.Element) return Asis.Declaration is Parent : Asis.Declaration; begin if Debug then Ada.Text_IO.Put_Line(Item => "EncDecE:" & Asis.Declaration_Kinds'Image (Asis.Elements.Declaration_Kind(Element))); end if; Parent := Asis.Elements.Enclosing_Element(Element); if Debug then Ada.Text_IO.Put_Line(Item => "EncDecP:" & Asis.Element_Kinds'Image (Asis.Elements.Element_Kind(Parent))); end if; case Asis.Elements.Element_Kind(Parent) is when Asis.A_Declaration => return Parent; when Asis.Not_An_Element => return Parent; when others => return Enclosing_Declaration(Parent); end case; end Enclosing_Declaration; function Element_Image (Element : in Asis.Element) return String is begin case Asis.Elements.Element_Kind(Element) is when Asis.Not_An_Element => -- Nil_Element return "Nil_Element"; when Asis.A_Pragma => -- Asis.Elements return Asis.Pragma_Kinds'Image(Asis.Elements.Pragma_Kind(Element)); when Asis.A_Defining_Name => -- Asis.Declarations return Ada.Characters.Handling.To_String (Asis.Declarations.Defining_Name_Image(Element)); when Asis.A_Declaration => return Ada.Characters.Handling.To_String (Asis.Declarations.Defining_Name_Image (Asis.Declarations.Names(Element)(1))) & " " & Asis.Declaration_Kinds'Image (Asis.Elements.Declaration_Kind(Element)) & " at line" & Asis.Asis_Integer'Image(Asis.Text.First_Line_Number(Element)); when Asis.A_Definition => -- Asis.Definitions return Asis.Definition_Kinds'Image (Asis.Elements.Definition_Kind(Element)) & " at line" & Asis.Asis_Integer'Image(Asis.Text.First_Line_Number(Element)); when Asis.An_Expression => -- Asis.Expressions return Asis.Expression_Kinds'Image (Asis.Elements.Expression_Kind(Element)); when Asis.An_Association => -- Asis.Expressions return Asis.Association_Kinds'Image (Asis.Elements.Association_Kind(Element)); when Asis.A_Statement => -- Asis.Statements return Asis.Statement_Kinds'Image (Asis.Elements.Statement_Kind(Element)); when Asis.A_Path => -- Asis.Statements return Asis.Path_Kinds'Image (Asis.Elements.Path_Kind(Element)); when Asis.A_Clause => -- Asis.Clauses return Asis.Clause_Kinds'Image (Asis.Elements.Clause_Kind(Element)); when Asis.An_Exception_Handler => -- Asis.Statements return "An_Exception_Handler"; end case; end Element_Image; procedure Print_Element (Element : in Asis.Element; Verbose : in Boolean := False; span : in Boolean := True) is Elem_Kind : Asis.Element_Kinds; Pragma_Kind : Asis.Pragma_Kinds; Defining_Name_Kind : Asis.Defining_Name_Kinds; Declaration_Kind : Asis.Declaration_Kinds; Trait_Kind : Asis.Trait_Kinds; Mode_Kind : Asis.Mode_Kinds; Definition_Kind : Asis.Definition_Kinds; Type_Kind : Asis.Type_Kinds; Formal_Type_Kind : Asis.Formal_Type_Kinds; Access_Type_Kind : Asis.Access_Type_Kinds; Constraint_Kind : Asis.Constraint_Kinds; Expression_Kind : Asis.Expression_Kinds; Operator_Kind : Asis.Operator_Kinds; Association_Kind : Asis.Association_Kinds; Statement_Kind : Asis.Statement_Kinds; Path_Kind : Asis.Path_Kinds; Clause_Kind : Asis.Clause_Kinds; Rep_Clause_Kind : Asis.Representation_Clause_Kinds; use Asis; begin Elem_Kind := Asis.Elements.Element_Kind(Element); Ada.Text_IO.Put(Item => "Print_Element: "); Ada.Text_IO.Put_Line (Item => Asis.Element_Kinds'Image(Elem_Kind)); case Elem_Kind is when Asis.Not_An_Element => -- Nil_Element null; when Asis.A_Pragma => -- Asis.Elements Pragma_Kind := Asis.Elements.Pragma_Kind(Element); if Pragma_Kind = Asis.Not_A_Pragma then Ada.Text_IO.Put(Item => " >>>ERROR:"); end if; Ada.Text_IO.Put_Line (Item => " Pragma_Kind: " & Asis.Pragma_Kinds'Image(Pragma_Kind)); when Asis.A_Defining_Name => -- Asis.Declarations Defining_Name_Kind := Asis.Elements.Defining_Name_Kind(Element); if Defining_Name_Kind = Asis.Not_A_Defining_Name then Ada.Text_IO.Put(Item => " >>>ERROR:"); end if; Ada.Text_IO.Put_Line (Item => " Defining_Name_Kind: " & Asis.Defining_Name_Kinds'Image(Defining_Name_Kind)); if Defining_Name_Kind /= Asis.Not_A_Defining_Name then Ada.Text_IO.Put_Line (Item => " Defining_Name: " & Ada.Characters.Handling.To_String (Asis.Declarations.Defining_Name_Image(Element))); end if; when Asis.A_Declaration => Declaration_Kind := Asis.Elements.Declaration_Kind(Element); if Declaration_Kind = Asis.Not_A_Declaration then Ada.Text_IO.Put(Item => " >>>ERROR:"); end if; Ada.Text_IO.Put_Line (Item => " Declaration_Kind: " & Asis.Declaration_Kinds'Image(Declaration_Kind)); if Verbose then Ada.Text_IO.Put_Line (Item => " Defining_Name: " & Ada.Characters.Handling.To_String (Asis.Declarations.Defining_Name_Image (Asis.Declarations.Names(Element)(1)))); end if; Type_Kind := Asis.Elements.Type_Kind(Element); if Verbose and Type_Kind /= Asis.Not_A_Type_Definition then Ada.Text_IO.Put_Line (Item => " Type_Kind: " & Asis.Type_Kinds'Image (Asis.Elements.Type_Kind(Element))); end if; Formal_Type_Kind := Asis.Elements.Formal_Type_Kind(Element); if Verbose and Formal_Type_Kind /= Asis.Not_A_Formal_Type_Definition then Ada.Text_IO.Put_Line (Item => "Formal_Type_Kind: " & Asis.Formal_Type_Kinds'Image(Formal_Type_Kind)); end if; Trait_Kind := Asis.Elements.Trait_Kind(Element); if Trait_Kind /= Asis.Not_A_Trait then Ada.Text_IO.Put_Line (Item => " Trait_Kind: " & Asis.Trait_Kinds'Image(Trait_Kind)); end if; Mode_Kind := Asis.Elements.Mode_Kind(Element); if Mode_Kind /= Asis.Not_A_Mode then Ada.Text_IO.Put_Line (Item => " Mode_Kind: " & Asis.Mode_Kinds'Image(Mode_Kind)); end if; when Asis.A_Definition => -- Asis.Definitions Definition_Kind := Asis.Elements.Definition_Kind(Element); if Definition_Kind = Asis.Not_A_Definition then Ada.Text_IO.Put(Item => " >>>ERROR:"); end if; Ada.Text_IO.Put_Line (Item => " Definition_Kind: " & Asis.Definition_Kinds'Image(Definition_Kind)); Type_Kind := Asis.Elements.Type_Kind(Element); if Type_Kind /= Asis.Not_A_Type_Definition then Ada.Text_IO.Put_Line (Item => " Type_Kind: " & Asis.Type_Kinds'Image(Type_Kind)); end if; Formal_Type_Kind := Asis.Elements.Formal_Type_Kind(Element); if Formal_Type_Kind /= Asis.Not_A_Formal_Type_Definition then Ada.Text_IO.Put_Line (Item => " Formal_Type_Kind: " & Asis.Formal_Type_Kinds'Image(Formal_Type_Kind)); end if; Access_Type_Kind := Asis.Elements.Access_Type_Kind(Element); if Access_Type_Kind /= Asis.Not_An_Access_Type_Definition then Ada.Text_IO.Put_Line (Item => " Access_Type_Kind: " & Asis.Access_Type_Kinds'Image(Access_Type_Kind)); end if; Trait_Kind := Asis.Elements.Trait_Kind(Element); if Trait_Kind /= Asis.Not_A_Trait then Ada.Text_IO.Put_Line (Item => " Trait_Kind: " & Asis.Trait_Kinds'Image(Trait_Kind)); end if; Constraint_Kind := Asis.Elements.Constraint_Kind(Element); if Constraint_Kind /= Asis.Not_A_Constraint then Ada.Text_IO.Put_Line (Item => " Constraint_Kind: " & Asis.Constraint_Kinds'Image(Constraint_Kind)); end if; when Asis.An_Expression => -- Asis.Expressions Expression_Kind := Asis.Elements.Expression_Kind(Element); if Expression_Kind = Asis.Not_An_Expression then Ada.Text_IO.Put(Item => " >>>ERROR:"); end if; Ada.Text_IO.Put_Line (Item => " Expression_Kind: " & Asis.Expression_Kinds'Image(Expression_Kind)); case Expression_Kind is when Asis.An_Identifier | Asis.An_Enumeration_Literal | Asis.A_Character_Literal | Asis.An_Operator_Symbol => Ada.Text_IO.Put_Line (Item => " Name_Image: " & Ada.Characters.Handling.To_String (Asis.Expressions.Name_Image(Element))); Operator_Kind := Asis.Elements.Operator_Kind(Element); Ada.Text_IO.Put_Line (Item => " Operator_Kind: " & Asis.Operator_Kinds'Image(Operator_Kind)); when Asis.An_Integer_Literal | Asis.A_Real_Literal | Asis.A_String_Literal => Ada.Text_IO.Put_Line (Item => " Value_Image:" & Ada.Characters.Handling.To_String (Asis.Expressions.Value_Image(Element))); when Asis.An_Attribute_Reference => Ada.Text_IO.Put_Line (Item => " Attribute_Kind: " & Asis.Attribute_Kinds'Image (Asis.Elements.Attribute_Kind(Element))); when others => null; end case; when Asis.An_Association => -- Asis.Expressions Association_Kind := Asis.Elements.Association_Kind(Element); if Association_Kind = Asis.Not_An_Association then Ada.Text_IO.Put(Item => " >>>ERROR:"); end if; Ada.Text_IO.Put_Line (Item => " Association_Kind: " & Asis.Association_Kinds'Image(Association_Kind)); when Asis.A_Statement => -- Asis.Statements Statement_Kind := Asis.Elements.Statement_Kind(Element); if Statement_Kind = Asis.Not_A_Statement then Ada.Text_IO.Put(Item => " >>>ERROR:"); end if; Ada.Text_IO.Put_Line (Item => " Statement_Kind: " & Asis.Statement_Kinds'Image(Statement_Kind)); when Asis.A_Path => -- Asis.Statements Path_Kind := Asis.Elements.Path_Kind(Element); if Path_Kind = Asis.Not_A_Path then Ada.Text_IO.Put(Item => " >>>ERROR:"); end if; Ada.Text_IO.Put_Line (Item => " Path_Kind: " & Asis.Path_Kinds'Image(Path_Kind)); when Asis.A_Clause => -- Asis.Clauses Clause_Kind := Asis.Elements.Clause_Kind(Element); Ada.Text_IO.Put_Line (Item => " Clause_Kind: " & Asis.Clause_Kinds'Image(Clause_Kind)); case Clause_Kind is when Asis.Not_A_Clause => Ada.Text_IO.Put(Item => " >>>ERROR:"); when Asis.A_Representation_Clause => Rep_Clause_Kind := Asis.Elements.Representation_Clause_Kind(Element); Ada.Text_IO.Put_Line (Item => " Representation_Clause_Kind: " & Asis.Representation_Clause_Kinds'Image(Rep_Clause_Kind)); when others => null; end case; when Asis.An_Exception_Handler => -- Asis.Statements null; end case; if Span then Print_Span(Element); end if; end Print_Element; procedure Dump_Span (Span : Asis.Text.Span) is begin Ada.Text_IO.Put (Item => "First_Line: " & Asis.Text.Line_Number'Image(Span.First_Line)); Ada.Text_IO.Put (Item => " First_Char: " & Asis.Text.Character_Position'Image(Span.First_Column)); Ada.Text_IO.Put (Item => " Last_Line : " & Asis.Text.Line_Number'Image(Span.Last_Line)); Ada.Text_IO.Put (Item => " Last_Char : " & Asis.Text.Character_Position'Image(Span.Last_Column)); Ada.Text_IO.New_Line; end Dump_Span; procedure Print_Span (Element : Asis.Element; Verbose : Boolean := True; Show_Lines : Boolean := False; Show_Image : Boolean := False) is Span : Asis.Text.Span; begin if Verbose then Ada.Text_IO.Put (Item => "Print_Span:"); end if; Span := Asis.Text.Element_Span(Element); if Verbose then Dump_Span(Span); else -- Just print the first line Ada.Text_IO.Put (Item => "Line Number: " & Asis.Text.Line_Number'Image(Span.First_Line)); Ada.Text_IO.New_Line; end if; if Show_Image then Ada.Text_IO.Put_Line (Item => "Image Start --------------------"); Ada.Text_IO.Put_Line (Item => Ada.Characters.Handling.To_String (Asis.Text.Element_Image(Element))); Ada.Text_IO.Put_Line (Item => "Image End ----------------------"); Ada.Text_IO.New_Line; end if; if Show_Lines then declare Text : constant Asis.Text.Line_List := Asis.Text.Lines(Element); begin if not Asis.Text.Is_Nil(Text) then Ada.Text_IO.Put_Line (Item => "Lines Start --------------------"); for I in Text'Range loop if not Asis.Text.Is_Nil(Text(I)) then Ada.Text_IO.Put (Item => "Line:" & Asis.Text.Line_Number'Image(I)); Ada.Text_IO.Put_Line (Item => " Length:" & Asis.Text.Character_Position'Image (Asis.Text.Length(Text(I)))); Ada.Text_IO.Put_Line (Item => Ada.Characters.Handling.To_String (Asis.Text.Line_Image(Text(I)))); Ada.Text_IO.Put_Line (Item => "Lines Non-Comment/Comment-------"); Ada.Text_IO.Put (Item => Ada.Characters.Handling.To_String (Asis.Text.Non_Comment_Image(Text(I)))); Ada.Text_IO.Put (Item => "]["); Ada.Text_IO.Put_Line (Item => Ada.Characters.Handling.To_String (Asis.Text.Comment_Image(Text(I)))); end if; -- Test equality if I > Text'Last then if Asis.Text.Is_Equal(Text(I), Text(I+1)) and not Asis.Text.Is_Equal(Text(I), Text(I)) then Ada.Text_IO.Put (Item => "ERROR WITH LINE EQUALITY"); end if; end if; end loop; Ada.Text_IO.Put_Line (Item => "Lines End ----------------------"); else Ada.Text_IO.Put_Line (Item => "Lines Line_List Is_Nil"); end if; end; Ada.Text_IO.New_Line; end if; end Print_Span; end Asis.Toolkit.ObjectAda.Elements;