mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-24 20:01:19 +08:00
* pprint.ads, pprint.adb: New.
From-SVN: r192909
This commit is contained in:
Arnaud Charlet
Arnaud Charlet
parent
df65258575
commit
1f41ed06b4
@ -1,3 +1,7 @@
|
||||
2012-10-29 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* pprint.ads, pprint.adb: New.
|
||||
|
||||
2012-10-23 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* system-linux-mipsel.ads (Stack_Check_Probes): Set to True.
|
||||
|
||||
682
gcc/ada/pprint.adb
Normal file
682
gcc/ada/pprint.adb
Normal file
@ -0,0 +1,682 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- P P R I N T --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2008-2012, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
||||
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||
-- 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 COPYING3. If not, go to --
|
||||
-- http://www.gnu.org/licenses for a complete copy of the license. --
|
||||
-- --
|
||||
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Atree; use Atree;
|
||||
with Einfo; use Einfo;
|
||||
with Namet; use Namet;
|
||||
with Nlists; use Nlists;
|
||||
with Opt; use Opt;
|
||||
with Sinfo; use Sinfo;
|
||||
with Sinput; use Sinput;
|
||||
with Snames; use Snames;
|
||||
with Uintp; use Uintp;
|
||||
|
||||
package body Pprint is
|
||||
|
||||
List_Name_Count : Integer := 0;
|
||||
-- Counter used to prevent infinite recursion while computing name of
|
||||
-- complex expressions.
|
||||
|
||||
----------------------
|
||||
-- Expression_Image --
|
||||
----------------------
|
||||
|
||||
function Expression_Image (Expr : Node_Id; Default : String)
|
||||
return String is
|
||||
Left : Node_Id := Original_Node (Expr);
|
||||
Right : Node_Id := Original_Node (Expr);
|
||||
From_Source : constant Boolean :=
|
||||
Comes_From_Source (Expr) and then not Opt.Debug_Generated_Code;
|
||||
Append_Paren : Boolean := False;
|
||||
|
||||
function Expr_Name
|
||||
(Expr : Node_Id;
|
||||
Take_Prefix : Boolean := True;
|
||||
Expand_Type : Boolean := True) return String;
|
||||
-- Return string corresponding to Expr. If no string can be extracted,
|
||||
-- return "...". If Take_Prefix is True, go back to prefix when needed,
|
||||
-- otherwise only consider the right-hand side of an expression. If
|
||||
-- Expand_Type is True and Expr is a type, try to expand Expr (an
|
||||
-- internally generated type) into a user understandable name.
|
||||
|
||||
Max_List : constant := 3;
|
||||
-- Limit number of list elements to dump
|
||||
|
||||
Max_Expr_Elements : constant := 24;
|
||||
-- Limit number of elements in an expression for use by Expr_Name
|
||||
|
||||
Num_Elements : Natural := 0;
|
||||
-- Current number of elements processed by Expr_Name
|
||||
|
||||
function List_Name
|
||||
(List : Node_Id;
|
||||
Add_Space : Boolean := True;
|
||||
Add_Paren : Boolean := True) return String;
|
||||
-- Return a string corresponding to List
|
||||
|
||||
function List_Name
|
||||
(List : Node_Id;
|
||||
Add_Space : Boolean := True;
|
||||
Add_Paren : Boolean := True) return String
|
||||
is
|
||||
function Internal_List_Name
|
||||
(List : Node_Id;
|
||||
First : Boolean := True;
|
||||
Add_Space : Boolean := True;
|
||||
Add_Paren : Boolean := True;
|
||||
Num : Natural := 1) return String;
|
||||
|
||||
------------------------
|
||||
-- Internal_List_Name --
|
||||
------------------------
|
||||
|
||||
function Internal_List_Name
|
||||
(List : Node_Id;
|
||||
First : Boolean := True;
|
||||
Add_Space : Boolean := True;
|
||||
Add_Paren : Boolean := True;
|
||||
Num : Natural := 1) return String
|
||||
is
|
||||
function Prepend (S : String) return String;
|
||||
|
||||
-------------
|
||||
-- Prepend --
|
||||
-------------
|
||||
|
||||
function Prepend (S : String) return String is
|
||||
begin
|
||||
if Add_Space then
|
||||
if Add_Paren then
|
||||
return " (" & S;
|
||||
else
|
||||
return ' ' & S;
|
||||
end if;
|
||||
elsif Add_Paren then
|
||||
return '(' & S;
|
||||
else
|
||||
return S;
|
||||
end if;
|
||||
end Prepend;
|
||||
|
||||
-- Start of processing for Internal_List_Name
|
||||
|
||||
begin
|
||||
if not Present (List) then
|
||||
if First or else not Add_Paren then
|
||||
return "";
|
||||
else
|
||||
return ")";
|
||||
end if;
|
||||
elsif Num > Max_List then
|
||||
if Add_Paren then
|
||||
return ", ...)";
|
||||
else
|
||||
return ", ...";
|
||||
end if;
|
||||
end if;
|
||||
|
||||
if First then
|
||||
return Prepend
|
||||
(Expr_Name (List)
|
||||
& Internal_List_Name (Next (List),
|
||||
First => False,
|
||||
Add_Paren => Add_Paren,
|
||||
Num => Num + 1));
|
||||
else
|
||||
return ", " & Expr_Name (List) &
|
||||
Internal_List_Name
|
||||
(Next (List),
|
||||
First => False,
|
||||
Add_Paren => Add_Paren,
|
||||
Num => Num + 1);
|
||||
end if;
|
||||
end Internal_List_Name;
|
||||
|
||||
-- Start of processing for List_Name
|
||||
|
||||
begin
|
||||
-- Prevent infinite recursion by limiting depth to 3
|
||||
|
||||
if List_Name_Count > 3 then
|
||||
return "...";
|
||||
end if;
|
||||
|
||||
List_Name_Count := List_Name_Count + 1;
|
||||
declare
|
||||
Result : constant String :=
|
||||
Internal_List_Name
|
||||
(List, Add_Space => Add_Space, Add_Paren => Add_Paren);
|
||||
begin
|
||||
List_Name_Count := List_Name_Count - 1;
|
||||
return Result;
|
||||
end;
|
||||
end List_Name;
|
||||
|
||||
---------------
|
||||
-- Expr_Name --
|
||||
---------------
|
||||
|
||||
function Expr_Name
|
||||
(Expr : Node_Id;
|
||||
Take_Prefix : Boolean := True;
|
||||
Expand_Type : Boolean := True) return String
|
||||
is
|
||||
begin
|
||||
Num_Elements := Num_Elements + 1;
|
||||
|
||||
if Num_Elements > Max_Expr_Elements then
|
||||
return "...";
|
||||
end if;
|
||||
|
||||
case Nkind (Expr) is
|
||||
when N_Defining_Identifier | N_Identifier =>
|
||||
return Ident_Image (Expr, Expression_Image.Expr, Expand_Type);
|
||||
|
||||
when N_Character_Literal =>
|
||||
declare
|
||||
Char : constant Int :=
|
||||
UI_To_Int (Char_Literal_Value (Expr));
|
||||
begin
|
||||
if Char in 32 .. 127 then
|
||||
return "'" & Character'Val (Char) & "'";
|
||||
else
|
||||
UI_Image (Char_Literal_Value (Expr));
|
||||
return "'\" & UI_Image_Buffer (1 .. UI_Image_Length)
|
||||
& "'";
|
||||
end if;
|
||||
end;
|
||||
|
||||
when N_Integer_Literal =>
|
||||
UI_Image (Intval (Expr));
|
||||
return UI_Image_Buffer (1 .. UI_Image_Length);
|
||||
|
||||
when N_Real_Literal =>
|
||||
return Real_Image (Realval (Expr));
|
||||
|
||||
when N_String_Literal =>
|
||||
return String_Image (Strval (Expr));
|
||||
|
||||
when N_Allocator =>
|
||||
return "new " & Expr_Name (Expression (Expr));
|
||||
|
||||
when N_Aggregate =>
|
||||
if Present (Sinfo.Expressions (Expr)) then
|
||||
return List_Name
|
||||
(First (Sinfo.Expressions (Expr)), Add_Space => False);
|
||||
|
||||
elsif Null_Record_Present (Expr) then
|
||||
return ("(null record)");
|
||||
|
||||
else
|
||||
return List_Name
|
||||
(First (Component_Associations (Expr)),
|
||||
Add_Space => False, Add_Paren => False);
|
||||
end if;
|
||||
|
||||
when N_Extension_Aggregate =>
|
||||
return "(" & Expr_Name (Ancestor_Part (Expr)) &
|
||||
" with " &
|
||||
List_Name (First (Sinfo.Expressions (Expr)),
|
||||
Add_Space => False, Add_Paren => False) &
|
||||
")";
|
||||
|
||||
when N_Attribute_Reference =>
|
||||
if Take_Prefix then
|
||||
declare
|
||||
Str : constant String := Expr_Name (Prefix (Expr))
|
||||
& "'" & Get_Name_String (Attribute_Name (Expr));
|
||||
Id : constant Attribute_Id :=
|
||||
Get_Attribute_Id (Attribute_Name (Expr));
|
||||
Ranges : List_Id;
|
||||
N : Node_Id;
|
||||
|
||||
begin
|
||||
if (Id = Attribute_First or else Id = Attribute_Last)
|
||||
and then Str (Str'First) = '$'
|
||||
then
|
||||
N := Associated_Node_For_Itype (Etype (Prefix (Expr)));
|
||||
|
||||
if Present (N) then
|
||||
if Nkind (N) = N_Full_Type_Declaration then
|
||||
N := Type_Definition (N);
|
||||
end if;
|
||||
|
||||
if Nkind (N) = N_Subtype_Declaration then
|
||||
Ranges := Constraints (Constraint
|
||||
(Subtype_Indication (N)));
|
||||
|
||||
if List_Length (Ranges) = 1
|
||||
and then Nkind_In
|
||||
(First (Ranges),
|
||||
N_Range,
|
||||
N_Real_Range_Specification,
|
||||
N_Signed_Integer_Type_Definition)
|
||||
then
|
||||
if Id = Attribute_First then
|
||||
return Expression_Image
|
||||
(Low_Bound (First (Ranges)), Str);
|
||||
else
|
||||
return Expression_Image
|
||||
(High_Bound (First (Ranges)), Str);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
return Str;
|
||||
end;
|
||||
else
|
||||
return "'" & Get_Name_String (Attribute_Name (Expr));
|
||||
end if;
|
||||
|
||||
when N_Explicit_Dereference =>
|
||||
if Take_Prefix then
|
||||
return Expr_Name (Prefix (Expr)) & ".all";
|
||||
else
|
||||
return ".all";
|
||||
end if;
|
||||
|
||||
when N_Expanded_Name | N_Selected_Component =>
|
||||
if Take_Prefix then
|
||||
return Expr_Name (Prefix (Expr))
|
||||
& "." & Expr_Name (Selector_Name (Expr));
|
||||
else
|
||||
return "." & Expr_Name (Selector_Name (Expr));
|
||||
end if;
|
||||
|
||||
when N_Component_Association =>
|
||||
return "("
|
||||
& List_Name (First (Choices (Expr)),
|
||||
Add_Space => False, Add_Paren => False)
|
||||
& " => " & Expr_Name (Expression (Expr)) & ")";
|
||||
|
||||
when N_If_Expression =>
|
||||
declare
|
||||
N : constant Node_Id := First (Sinfo.Expressions (Expr));
|
||||
begin
|
||||
return "if " & Expr_Name (N) & " then " &
|
||||
Expr_Name (Next (N)) & " else " &
|
||||
Expr_Name (Next (Next (N)));
|
||||
end;
|
||||
|
||||
when N_Qualified_Expression =>
|
||||
declare
|
||||
Mark : constant String :=
|
||||
Expr_Name (Subtype_Mark (Expr), Expand_Type => False);
|
||||
Str : constant String := Expr_Name (Expression (Expr));
|
||||
begin
|
||||
if Str (Str'First) = '(' and then Str (Str'Last) = ')' then
|
||||
return Mark & "'" & Str;
|
||||
else
|
||||
return Mark & "'(" & Str & ")";
|
||||
end if;
|
||||
end;
|
||||
|
||||
when N_Unchecked_Expression | N_Expression_With_Actions =>
|
||||
return Expr_Name (Expression (Expr));
|
||||
|
||||
when N_Raise_Constraint_Error =>
|
||||
if Present (Condition (Expr)) then
|
||||
return "[constraint_error when " &
|
||||
Expr_Name (Condition (Expr)) & "]";
|
||||
else
|
||||
return "[constraint_error]";
|
||||
end if;
|
||||
|
||||
when N_Raise_Program_Error =>
|
||||
if Present (Condition (Expr)) then
|
||||
return "[program_error when " &
|
||||
Expr_Name (Condition (Expr)) & "]";
|
||||
else
|
||||
return "[program_error]";
|
||||
end if;
|
||||
|
||||
when N_Range =>
|
||||
return Expr_Name (Low_Bound (Expr)) & ".." &
|
||||
Expr_Name (High_Bound (Expr));
|
||||
|
||||
when N_Slice =>
|
||||
return Expr_Name (Prefix (Expr)) & " (" &
|
||||
Expr_Name (Discrete_Range (Expr)) & ")";
|
||||
|
||||
when N_And_Then =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " and then " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_In =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " in " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Not_In =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " not in " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Or_Else =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " or else " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_And =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " and " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Or =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " or " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Xor =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " xor " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Eq =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " = " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Ne =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " /= " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Lt =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " < " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Le =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " <= " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Gt =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " > " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Ge =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " >= " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Add =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " + " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Subtract =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " - " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Multiply =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " * " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Divide =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " / " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Mod =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " mod " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Rem =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " rem " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Expon =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " ** " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Shift_Left =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " << " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Shift_Right | N_Op_Shift_Right_Arithmetic =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " >> " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Concat =>
|
||||
return Expr_Name (Left_Opnd (Expr)) & " & " &
|
||||
Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Plus =>
|
||||
return "+" & Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Minus =>
|
||||
return "-" & Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Abs =>
|
||||
return "abs " & Expr_Name (Right_Opnd (Expr));
|
||||
|
||||
when N_Op_Not =>
|
||||
return "not (" & Expr_Name (Right_Opnd (Expr)) & ")";
|
||||
|
||||
when N_Parameter_Association =>
|
||||
return Expr_Name (Explicit_Actual_Parameter (Expr));
|
||||
|
||||
when N_Type_Conversion | N_Unchecked_Type_Conversion =>
|
||||
|
||||
-- Most conversions are not very interesting (used inside
|
||||
-- expanded checks to convert to larger ranges), so skip them.
|
||||
|
||||
return Expr_Name (Expression (Expr));
|
||||
|
||||
when N_Indexed_Component =>
|
||||
if Take_Prefix then
|
||||
return Expr_Name (Prefix (Expr)) &
|
||||
List_Name (First (Sinfo.Expressions (Expr)));
|
||||
else
|
||||
return List_Name (First (Sinfo.Expressions (Expr)));
|
||||
end if;
|
||||
|
||||
when N_Function_Call =>
|
||||
|
||||
-- If Default = "", it means we're expanding the name of
|
||||
-- a gnat temporary (and not really a function call), so add
|
||||
-- parentheses around function call to mark it specially.
|
||||
|
||||
if Default = "" then
|
||||
return '(' & Expr_Name (Name (Expr)) &
|
||||
List_Name (First (Sinfo.Parameter_Associations (Expr))) &
|
||||
')';
|
||||
else
|
||||
return Expr_Name (Name (Expr)) &
|
||||
List_Name (First (Sinfo.Parameter_Associations (Expr)));
|
||||
end if;
|
||||
|
||||
when N_Null =>
|
||||
return "null";
|
||||
|
||||
when N_Others_Choice =>
|
||||
return "others";
|
||||
|
||||
when others =>
|
||||
return "...";
|
||||
end case;
|
||||
end Expr_Name;
|
||||
|
||||
-- Start of processing for Expression_Name
|
||||
|
||||
begin
|
||||
if not From_Source then
|
||||
declare
|
||||
S : constant String := Expr_Name (Expr);
|
||||
begin
|
||||
if S = "..." then
|
||||
return Default;
|
||||
else
|
||||
return S;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- Compute left (start) and right (end) slocs for the expression
|
||||
-- Consider using Sinput.Sloc_Range instead, except that it does not
|
||||
-- work properly currently???
|
||||
|
||||
loop
|
||||
case Nkind (Left) is
|
||||
when N_Binary_Op | N_Membership_Test |
|
||||
N_And_Then | N_Or_Else =>
|
||||
Left := Original_Node (Left_Opnd (Left));
|
||||
|
||||
when N_Attribute_Reference | N_Expanded_Name |
|
||||
N_Explicit_Dereference | N_Indexed_Component |
|
||||
N_Reference | N_Selected_Component |
|
||||
N_Slice =>
|
||||
Left := Original_Node (Prefix (Left));
|
||||
|
||||
when N_Designator | N_Defining_Program_Unit_Name |
|
||||
N_Function_Call =>
|
||||
Left := Original_Node (Name (Left));
|
||||
|
||||
when N_Range =>
|
||||
Left := Original_Node (Low_Bound (Left));
|
||||
|
||||
when N_Type_Conversion =>
|
||||
Left := Original_Node (Subtype_Mark (Left));
|
||||
|
||||
-- For any other item, quit loop
|
||||
|
||||
when others =>
|
||||
exit;
|
||||
end case;
|
||||
end loop;
|
||||
|
||||
loop
|
||||
case Nkind (Right) is
|
||||
when N_Op | N_Membership_Test |
|
||||
N_And_Then | N_Or_Else =>
|
||||
Right := Original_Node (Right_Opnd (Right));
|
||||
|
||||
when N_Selected_Component | N_Expanded_Name =>
|
||||
Right := Original_Node (Selector_Name (Right));
|
||||
|
||||
when N_Designator =>
|
||||
Right := Original_Node (Identifier (Right));
|
||||
|
||||
when N_Defining_Program_Unit_Name =>
|
||||
Right := Original_Node (Defining_Identifier (Right));
|
||||
|
||||
when N_Range =>
|
||||
Right := Original_Node (High_Bound (Right));
|
||||
|
||||
when N_Parameter_Association =>
|
||||
Right := Original_Node (Explicit_Actual_Parameter (Right));
|
||||
|
||||
when N_Indexed_Component =>
|
||||
Right := Original_Node (Last (Sinfo.Expressions (Right)));
|
||||
Append_Paren := True;
|
||||
|
||||
when N_Function_Call =>
|
||||
if Present (Sinfo.Parameter_Associations (Right)) then
|
||||
Right :=
|
||||
Original_Node
|
||||
(Last (Sinfo.Parameter_Associations (Right)));
|
||||
Append_Paren := True;
|
||||
|
||||
-- Quit loop if no named associations
|
||||
|
||||
else
|
||||
exit;
|
||||
end if;
|
||||
|
||||
-- For all other items, quit the loop
|
||||
|
||||
when others =>
|
||||
exit;
|
||||
end case;
|
||||
end loop;
|
||||
|
||||
declare
|
||||
Scn : Source_Ptr := Original_Location (Sloc (Left));
|
||||
Src : constant Source_Buffer_Ptr :=
|
||||
Source_Text (Get_Source_File_Index (Scn));
|
||||
End_Sloc : constant Source_Ptr :=
|
||||
Original_Location (Sloc (Right));
|
||||
|
||||
begin
|
||||
if Scn > End_Sloc then
|
||||
return Default;
|
||||
end if;
|
||||
|
||||
declare
|
||||
Buffer : String (1 .. Natural (End_Sloc - Scn));
|
||||
Skipping_Comment : Boolean := False;
|
||||
Underscore : Boolean := False;
|
||||
Index : Natural := 0;
|
||||
|
||||
begin
|
||||
if Right /= Expr then
|
||||
while Scn < End_Sloc loop
|
||||
case Src (Scn) is
|
||||
when ' ' | ASCII.HT =>
|
||||
if not Skipping_Comment and then not Underscore then
|
||||
Underscore := True;
|
||||
Index := Index + 1;
|
||||
Buffer (Index) := ' ';
|
||||
end if;
|
||||
|
||||
-- CR/LF/FF is the end of any comment
|
||||
|
||||
when ASCII.LF | ASCII.CR | ASCII.FF =>
|
||||
Skipping_Comment := False;
|
||||
|
||||
when others =>
|
||||
Underscore := False;
|
||||
|
||||
if not Skipping_Comment then
|
||||
|
||||
-- Ignore comment
|
||||
|
||||
if Src (Scn) = '-' and then Src (Scn + 1) = '-' then
|
||||
Skipping_Comment := True;
|
||||
|
||||
else
|
||||
Index := Index + 1;
|
||||
Buffer (Index) := Src (Scn);
|
||||
end if;
|
||||
end if;
|
||||
end case;
|
||||
|
||||
Scn := Scn + 1;
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
if Index < 1 then
|
||||
declare
|
||||
S : constant String := Expr_Name (Right);
|
||||
begin
|
||||
if S = "..." then
|
||||
return Default;
|
||||
else
|
||||
return S;
|
||||
end if;
|
||||
end;
|
||||
|
||||
elsif Append_Paren then
|
||||
return Buffer (1 .. Index) & Expr_Name (Right, False) & ')';
|
||||
|
||||
else
|
||||
return Buffer (1 .. Index) & Expr_Name (Right, False);
|
||||
end if;
|
||||
end;
|
||||
end;
|
||||
end Expression_Image;
|
||||
|
||||
end Pprint;
|
||||
60
gcc/ada/pprint.ads
Normal file
60
gcc/ada/pprint.ads
Normal file
@ -0,0 +1,60 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- P P R I N T --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2008-2012, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
||||
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||
-- 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 COPYING3. If not, go to --
|
||||
-- http://www.gnu.org/licenses for a complete copy of the license. --
|
||||
-- --
|
||||
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This package (pretty print) contains a routine for printing an expression
|
||||
-- given its node in the syntax tree. Contrarily to the Sprint package, this
|
||||
-- routine tries to obtain "pretty" output that can be used for e.g. error
|
||||
-- messages.
|
||||
|
||||
with Types; use Types;
|
||||
with Urealp; use Urealp;
|
||||
|
||||
package Pprint is
|
||||
|
||||
generic
|
||||
|
||||
-- ??? The generic parameters should be removed.
|
||||
|
||||
with function Real_Image (U : Ureal) return String;
|
||||
with function String_Image (S : String_Id) return String;
|
||||
with function Ident_Image (Expr : Node_Id;
|
||||
Orig_Expr : Node_Id;
|
||||
Expand_Type : Boolean)
|
||||
return String;
|
||||
-- Will be called for printing N_Identifier and N_Defining_Identifier
|
||||
-- nodes
|
||||
-- ??? Expand_Type argument should be removed
|
||||
|
||||
function Expression_Image (Expr : Node_Id;
|
||||
Default : String)
|
||||
return String;
|
||||
-- Given a Node for an expression, return a String that is meaningful for
|
||||
-- the programmer. If the expression comes from source, it is copied from
|
||||
-- there.
|
||||
-- Subexpressions outside of the maximum depth (3), the maximal number of
|
||||
-- accepted nodes (24), and the maximal number of list elements (3), are
|
||||
-- replaced by the default string.
|
||||
|
||||
end Pprint;
|
||||
Loading…
x
Reference in New Issue
Block a user