------------------------------------------------------------------------------ -- -- -- DISPLAY_SOURCE COMPONENTS -- -- -- -- I M A G E _ T R A V -- -- -- -- B o d y -- -- -- -- $Revision: 1.9 $ -- -- -- Copyright (c) 1995-2002, Free Software Foundation, Inc. -- -- -- -- Display_Source is free software; you can redistribute it and/or modify it-- -- under terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. Display_Source is distributed in the hope that it will be use- -- -- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- -- -- CHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -- -- Public License for more details. You should have received a copy of the -- -- GNU General Public License distributed with GNAT; see file COPYING. If -- -- not, write to the Free Software Foundation, 59 Temple Place Suite 330, -- -- Boston, MA 02111-1307, USA. -- -- -- -- Display_Source is distributed as a part of the ASIS implementation for -- -- GNAT (ASIS-for-GNAT). -- -- -- -- The original version of Display_Source has been developed by -- -- Jean-Charles Marteau and Serge Reboul, ENSIMAG High School Graduates -- -- (Computer sciences) Grenoble, France in Sema Group Grenoble, France. -- -- -- -- Display_Source is now maintained by Ada Core Technologies Inc -- -- (http://www.gnat.com). -- ------------------------------------------------------------------------------ ----------------------------------------------------------------- -- This package is part of the ASIS application display_source -- ----------------------------------------------------------------- -- -- In that application, each element is displayed, so we have -- always a detailed display of each element (which can have a -- cost in performance, because we call Asis queries on every -- element). In fact it would be possible to have a global -- display of the elements whose sub-elements didn't undergo -- any special treatment (in Pre-Source). -- -- Changing that would imply to have a more complex structure -- (in State parameter), probably with a stack. We would push -- the elements in Pre_Image and pop them in Post_Image. -- Moreover we would need to keep in memory for each pushed -- element the list of the children already passed without any -- special treatment (In order to be able to display them -- separately if one of their siblings had a special treatment) -- -- But in fact i prefered to keep something simple because the -- gain in performance is not obvious. -- with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Text_IO; with Asis.Text; with Asis.Elements; with Asis.Expressions; with Global_Info; use Global_Info; package body Image_Trav is use Asis; -- to make all the literals from Element classification hierarchy -- directly visible -- Increment_Source_Position and Decrement_Source_Position are used by -- span operations "-" and "/". As you can imagine, those functions add -- of substract one char to a position in the source (line, column). -- It takes into account the length of the lines, so if you are at the -- end of a line, the next position is the first character of the next -- line, and if you are at the beginning of a line, the previous character -- is the last character of the previous line. -- Pre-condition : the incrementation is possible .. -- (i.e we are not at the last character of the last line ...) procedure Increment_Source_Position (Line : in out Asis.Text.Line_Number; Char : in out Asis.Text.Character_Position; Element : Asis.Element); procedure Increment_Source_Position (Line : in out Asis.Text.Line_Number; Char : in out Asis.Text.Character_Position; Element : Asis.Element) is List : Asis.Text.Line_List := Asis.Text.Lines (Element, Line, Line); begin if List'Length /= 0 then if Asis.Text.Length (List (List'First)) >= Char then Char := Char + 1; else -- normaly that is ok, in that case .... Line := Line + 1; Char := 1; end if; end if; exception when others => Ada.Text_IO.Put_Line ("exception raised in Increment_Source_Position"); raise; end Increment_Source_Position; -- There is no condition here, if the position is the begining of the file, -- then the position returned is the same. procedure Decrement_Source_Position (Line : in out Asis.Text.Line_Number; Char : in out Asis.Text.Character_Position; Element : Asis.Element); procedure Decrement_Source_Position (Line : in out Asis.Text.Line_Number; Char : in out Asis.Text.Character_Position; Element : Asis.Element) is begin if Char /= 1 then Char := Char - 1; else if Line /= 1 then Line := Line - 1; declare List : Asis.Text.Line_List := Asis.Text.Lines (Element, Line, Line); begin if List'Length /= 0 then Char := Asis.Text.Length (List (List'First)); end if; end; end if; end if; exception when others => Ada.Text_IO.Put_Line ("exception raised in Decrement_Source_Position"); raise; end Decrement_Source_Position; -- Outputs the text corresponding to the given span and elements. -- Modify State.Last_Printed_Span, when the given span is has been output -- (ie when it's not a Nil_Span). -- Output_span is the only function with Pre_Image that outputs text. procedure Output_Span (The_Span : Asis.Text.Span; State : in out Info_Image; Element : Asis.Element); procedure Output_Span (The_Span : Asis.Text.Span; State : in out Info_Image; Element : Asis.Element) is -- Line_Im is here to handle the With_Comments thing. -- (see Info_Image in image_trav.ads) function Line_Im (Line : Asis.Text.Line) return String; function Line_Im (Line : Asis.Text.Line) return String is -- ??? begin if State.With_Comments then return To_String (Asis.Text.Line_Image (Line)); -- ??? else return To_String (Asis.Text.Non_Comment_Image (Line)); end if; end Line_Im; begin -- if the span is nil, nothing to do. if Asis.Text."=" (The_Span, Asis.Text.Nil_Span) then return; end if; declare -- we get the lines : List : Asis.Text.Line_List := Asis.Text.Lines (Element, The_Span); begin -- and we print them one by one for I in List'Range loop declare Text : String := Line_Im (List (I)); begin if I = List'First then if List'Length = 1 then Ada.Text_IO.Put (Text); else Ada.Text_IO.Put_Line (Text); end if; elsif I = List'Last then Ada.Text_IO.Put (Text); else Ada.Text_IO.Put_Line (Text); end if; State.Horizontal_Position := Text'Length; end; end loop; State.Last_Printed_Span := The_Span; end; exception when others => Ada.Text_IO.Put_Line ("exception raised in Output_Span"); raise; end Output_Span; -- In Pre_Image you can do what you want in order to do your -- particular application. -- When you decide that an element will take care of its display on its -- own, you just have to print the span : -- Element_Span (Element) - Last_Printed_Span -- which is the span between the last span the application has displayed -- and the span corresponding to the element ... -- and put State.Last_Printed_Span := Element_Span (Span); procedure Pre_Image (Element : in Asis.Element; Control : in out Asis.Traverse_Control; State : in out Info_Image) is -- Definition of an operation between Spans ... -- Like the standard minus, you put the higher argument as the -- left parameter (higher for a span means that it denotes -- a text window that is after ...) -- The result is : -- - The Span that is between the 2 spans given if they -- are in the correct order. -- - The Nil_Span if Right is higher than Left. -- -- example : -- -- ----- -- | | -- ----- -- ----- -- | | -- => | | -- | | -- ----- -- ----- -- | | -- ----- function "-" (Left, Right : Asis.Text.Span) return Asis.Text.Span; function "-" (Left, Right : Asis.Text.Span) return Asis.Text.Span is Tmp : Asis.Text.Span; begin -- setting the first position if Asis.Text."=" (Right, Asis.Text.Nil_Span) then Tmp.First_Line := 1; Tmp.First_Column := 1; else Tmp.First_Line := Right.Last_Line; Tmp.First_Column := Right.Last_Column; Increment_Source_Position (Tmp.First_Line, Tmp.First_Column, Element); end if; -- setting the last position Tmp.Last_Line := Left.First_Line; Tmp.Last_Column := Left.First_Column; Decrement_Source_Position (Tmp.Last_Line, Tmp.Last_Column, Element); -- before returning we check that the span is correct if (Tmp.First_Line < Tmp.Last_Line) or (Tmp.First_Line = Tmp.Last_Line and Tmp.First_Column <= Tmp.Last_Column) then return Tmp; else return Asis.Text.Nil_Span; end if; exception when others => Ada.Text_IO.Put_Line ("exception raised in ""-"""); raise; end "-"; -- returns a string that helps to indent when you replace -- something with something else that has several lines ... function Indentation return String; function Indentation return String is Result : String (1 .. State.Horizontal_Position) := (others => ' '); begin return Result; end Indentation; -- the procedure Display_Before, updates the output so that -- all the text before the first character of the image of -- the current element is displayed. procedure Display_Before; procedure Display_Before is begin Output_Span ((Asis.Text.Element_Span (Element) - State.Last_Printed_Span), State, Element); exception when others => Ada.Text_IO.Put_Line ("exception raised in Display_Before"); raise; end Display_Before; -- the procedure Dont_Display make it so everything is like if -- the current element had been displayed except the displaying -- in itself ... -- It's important to notice that it sets the control to -- Abandon_Children procedure Dont_Display; procedure Dont_Display is Elem_Span : Asis.Text.Span := Asis.Text.Element_Span (Element); begin State.Handled_In_Pre := True; Control := Asis.Abandon_Children; State.Last_Printed_Span := Elem_Span; exception when others => Ada.Text_IO.Put_Line ("exception raised in Dont_Display"); raise; end Dont_Display; -- the procedure Display_Now is like Dont_Display, but it displays the -- element. -- It's important to notice that it sets the control to -- Abandon_Children procedure Display_Now; pragma Unreferenced (Display_Now); procedure Display_Now is Elem_Span : Asis.Text.Span := Asis.Text.Element_Span (Element); begin State.Handled_In_Pre := True; Control := Asis.Abandon_Children; Output_Span (Elem_Span, State, Element); end Display_Now; begin -- In this function, the program tests if you've got the expected -- element kind, and if so you can choose for instance : -- - to display the element on your own (modify) -- - not to display the element (skip it) -- - comment it .. or whatever ... -- -- Before that, you say that you want the text before the element -- to be displayed by calling the Display_before procedure. -- Then you can call the Dont_Display procedure that indicates -- you don't want the element to be displayed in Post-Source. -- This procedure sets State.Handled_In_Pre to True, and -- Control to Asis.Abandon_Children, this way -- the next called funtion is Post_Image of the same element which -- uses the boolean Handled_In_Pre immediately ... -- The example here is an application where we want to suppress -- inline pragmas (that can be because we want to reduce exec size. -- (I didn't check it does, it's just an example ... :)) -- there is also some operations on Unknown pragmas : -- for example : -- pragma Bonjour; -- pragma Hello; -- pragma Hello ("master"); -- pragma Hello (1); -- pragma Hello (2.3E32); -- pragma Hello ('U'); -- pragma Hello (A); -- pragma Hello ('U', "Me"); -- pragma Hello ((1 => 2, others => 3)); -- pragma HeLlO; -- -- becomes : -- -- pragma Bonjour; -- Ada.Text_IO.Put_Line ("Hello default !"); -- Ada.Text_IO.Put_Line -- I wanted to show that we can pass a line -- ("Hello "master" !"); -- Ada.Text_IO.Put_Line -- I wanted to show that we can pass a line -- ("Hello 1 !"); -- Ada.Text_IO.Put_Line -- I wanted to show that we can pass a line -- ("Hello 2.3E32 !"); -- Ada.Text_IO.Put_Line ("Hello 'U' !"); -- Ada.Text_IO.Put_Line ("Hello A !"); -- Ada.Text_IO.Put_Line -- ("I can't say hello to more than one parameter at once."); -- Ada.Text_IO.Put_Line ("I don't say hello to such parameter"); -- -- pragma HeLlO; -- the pragma 'Pre-Compilation' works only if we are in mode -- Image_And_Example, if not, the source is displayed as is. if The_Mode /= Image_And_Example then return; end if; case Asis.Elements.Element_Kind (Element) is when A_Pragma => case Asis.Elements.Pragma_Kind (Element) is when An_Inline_Pragma => Display_Before; Dont_Display; -- we display nothing because we want to suppress them ... when An_Unknown_Pragma => Display_Before; -- We check that we have the correct pragma -- if we want to be case unsensitive, we need -- to make an unsensitive case test. if To_String (Asis.Elements.Pragma_Name_Image (Element)) = String'("Hello") then Dont_Display; -- to say that we'll do by ourselves declare -- we get the parameter list Param : Asis.Association_List := Asis.Elements.Pragma_Argument_Associations (Element); Expr : Asis.Element; begin if Param'Length = 0 then -- if no parameter, then we do the default Ada.Text_IO.Put ("Ada.Text_IO.Put_Line (""Hello default !"");"); elsif Param'Length = 1 then -- if there is one parameter, we get its value -- (named parameter form could be handled getting -- the Formal_Parameter of the association) Expr := Asis.Expressions.Actual_Parameter (Param (Param'First)); -- depending on the kind of expression we do -- different things case Asis.Elements.Expression_Kind (Expr) is when An_Identifier | An_Operator_Symbol | A_Character_Literal | An_Enumeration_Literal => Ada.Text_IO.Put ("Ada.Text_IO.Put_Line (""Hello " & To_String (Asis.Expressions.Name_Image (Expr)) & " !"");"); when An_Integer_Literal | A_Real_Literal | A_String_Literal => Ada.Text_IO.Put_Line ("Ada.Text_IO.Put_Line "& "-- I wanted to show that "& "we can pass a line"); Ada.Text_IO.Put (Indentation & " (""Hello " & To_String (Asis.Expressions.Value_Image (Expr)) & " !"");"); when others => -- Some expression kinds are very -- complicated we handle here only simple -- expressions Ada.Text_IO.Put ("Ada.Text_IO.Put_Line "& "(""I don't say hello "& "to such parameter"");"); end case; else -- if there is more than one parameter, -- it is an error Ada.Text_IO.Put ("Ada.Text_IO.Put_Line "& "(""I can't say hello to more than one "& "parameter at once."");"); end if; end; else -- When it is an unknown unknown pragma -- (when it is different from "Hello") -- we comment it ... -- notice that there is no Dont_Display here Ada.Text_IO.Put ("-- "); end if; when others => null; end case; when others => null; end case; end Pre_Image; ----------------------------------------- -- Post_Image has a simple function : -- -- it displays elements from the last -- -- span to the end of the element. -- ----------------------------------------- procedure Post_Image (Element : in Asis.Element; Control : in out Asis.Traverse_Control; State : in out Info_Image) is pragma Unreferenced (Control); -- Definition of an operation between Spans ... -- Like the standard minus, you put the higher argument as the -- left parameter (higher for a span means that it denotes -- a text window that is after ...) -- The result is : -- - The union of the Left span and of the span corresponding -- to the space between the 2 spans if they -- are in the correct order. -- - The Nil_Span if Right is higher than Left. -- -- example : -- -- ----- -- | | -- ----- -- ----- -- | | -- => | | -- | | -- ----- | | -- | | | | -- ----- ----- function "/" (Left, Right : Asis.Text.Span) return Asis.Text.Span; function "/" (Left, Right : Asis.Text.Span) return Asis.Text.Span is Tmp : Asis.Text.Span; begin -- setting the first position if Asis.Text."=" (Right, Asis.Text.Nil_Span) then Tmp.First_Line := 1; Tmp.First_Column := 1; else Tmp.First_Line := Right.Last_Line; Tmp.First_Column := Right.Last_Column; Increment_Source_Position (Tmp.First_Line, Tmp.First_Column, Element); end if; -- setting the last position Tmp.Last_Line := Left.Last_Line; Tmp.Last_Column := Left.Last_Column; -- before returning we check that the span is correct if (Tmp.First_Line < Tmp.Last_Line) or (Tmp.First_Line = Tmp.Last_Line and Tmp.First_Column <= Tmp.Last_Column) then return Tmp; else return Asis.Text.Nil_Span; end if; end "/"; Tmp_Span : Asis.Text.Span := Asis.Text.Nil_Span; begin -- if the element has already been displayed in Pre_Image if State.Handled_In_Pre then State.Handled_In_Pre := False; return; end if; if State.Finishing_Traversal then -- we use this value for terminate to say that we must display -- everything now .... Tmp_Span := Asis.Text.Compilation_Span (Element) / State.Last_Printed_Span; else Tmp_Span := Asis.Text.Element_Span (Element) / State.Last_Printed_Span; end if; Output_Span (Tmp_Span, State, Element); end Post_Image; procedure Initiate_Image (Element : in Asis.Element; Control : in out Asis.Traverse_Control; State : in out Info_Image) is begin pragma Unreferenced (Control); State.An_Element := Element; exception when others => Ada.Text_IO.Put_Line ("exception raised in Initiate_Image"); raise; end Initiate_Image; procedure Terminate_Image (Control : in out Asis.Traverse_Control; State : in out Info_Image) is begin State.Finishing_Traversal := True; Post_Image (State.An_Element, Control, State); exception when others => Ada.Text_IO.Put_Line ("exception raised in Terminate_Image"); raise; end Terminate_Image; end Image_Trav;