repinfo.adb (List_Type_Info): List Small and Range for fixed-point types.

2010-09-10  Robert Dewar  <dewar@adacore.com>

	* repinfo.adb (List_Type_Info): List Small and Range for fixed-point
	types.
	* sprint.adb (Write_Ureal_With_Col_Check_Sloc): Use square brackets
	rather than parens for fixed constants.
	* sprint.ads: Use square brackets rather than parens for fixed constants
	* urealp.adb (UR_Write): Use square brackets rather than parens
	(UR_Write): Add Brackets argument
	(UR_Write): Add many more special cases to output literals
	* urealp.ads (UR_Write): Use square brackets rather than parens
	(UR_Write): Add Brackets argument

2010-09-10  Robert Dewar  <dewar@adacore.com>

	* sem_ch4.adb: Minor reformatting.

From-SVN: r164165

gcc/ada/ChangeLog

+2010-09-10  Robert Dewar  <dewar@adacore.com>
+
+	* repinfo.adb (List_Type_Info): List Small and Range for fixed-point
+	types.
+	* sprint.adb (Write_Ureal_With_Col_Check_Sloc): Use square brackets
+	rather than parens for fixed constants.
+	* sprint.ads: Use square brackets rather than parens for fixed constants
+	* urealp.adb (UR_Write): Use square brackets rather than parens
+	(UR_Write): Add Brackets argument
+	(UR_Write): Add many more special cases to output literals
+	* urealp.ads (UR_Write): Use square brackets rather than parens
+	(UR_Write): Add Brackets argument
+
+2010-09-10  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch4.adb: Minor reformatting.
+
 2010-09-10  Richard Guenther  <rguenther@suse.de>
 
 	* gcc-interface/utils.c (create_index_type): Use build_range_type.

gcc/ada/repinfo.adb

@@ -1054,6 +1054,39 @@ package body Repinfo is
       Write_Str ("'Alignment use ");
       Write_Val (Alignment (Ent));
       Write_Line (";");
+
+      --  Special stuff for fixed-point
+
+      if Is_Fixed_Point_Type (Ent) then
+
+         --  Write small (always a static constant)
+
+         Write_Str ("for ");
+         List_Name (Ent);
+         Write_Str ("'Small use ");
+         UR_Write (Small_Value (Ent));
+         Write_Line (";");
+
+         --  Write range if static
+
+         declare
+            R : constant Node_Id := Scalar_Range (Ent);
+
+         begin
+            if Nkind (Low_Bound (R)) = N_Real_Literal
+                 and then
+               Nkind (High_Bound (R)) = N_Real_Literal
+            then
+               Write_Str ("for ");
+               List_Name (Ent);
+               Write_Str ("'Range use ");
+               UR_Write (Realval (Low_Bound (R)));
+               Write_Str (" .. ");
+               UR_Write (Realval (High_Bound (R)));
+               Write_Line (";");
+            end if;
+         end;
+      end if;
    end List_Type_Info;
 
    ----------------------
@@ -1087,8 +1120,8 @@ package body Repinfo is
       --  Internal recursive routine to evaluate tree
 
       function W (Val : Uint) return Word;
-      --  Convert Val to Word, assuming Val is always in the Int range. This is
-      --  a helper function for the evaluation of bitwise expressions like
+      --  Convert Val to Word, assuming Val is always in the Int range. This
+      --  is a helper function for the evaluation of bitwise expressions like
       --  Bit_And_Expr, for which there is no direct support in uintp. Uint
       --  values out of the Int range are expected to be seen in such
       --  expressions only with overflowing byte sizes around, introducing

gcc/ada/sem_ch4.adb

@@ -269,7 +269,10 @@ package body Sem_Ch4 is
    --  the call may be overloaded with both interpretations.
 
    function Try_Object_Operation (N : Node_Id) return Boolean;
-   --  Ada 2005 (AI-252): Support the object.operation notation
+   --  Ada 2005 (AI-252): Support the object.operation notation. If node N
+   --  is a call in this notation, it is transformed into a normal subprogram
+   --  call where the prefix is a parameter, and True is returned. If node
+   --  N is not of this form, it is unchanged, and False is returned.
 
    procedure wpo (T : Entity_Id);
    pragma Warnings (Off, wpo);
@@ -3392,11 +3395,11 @@ package body Sem_Ch4 is
 
       if Is_Access_Type (Prefix_Type) then
 
-         --  A RACW object can never be used as prefix of a selected
-         --  component since that means it is dereferenced without
-         --  being a controlling operand of a dispatching operation
-         --  (RM E.2.2(16/1)). Before reporting an error, we must check
-         --  whether this is actually a dispatching call in prefix form.
+         --  A RACW object can never be used as prefix of a selected component
+         --  since that means it is dereferenced without being a controlling
+         --  operand of a dispatching operation (RM E.2.2(16/1)). Before
+         --  reporting an error, we must check whether this is actually a
+         --  dispatching call in prefix form.
 
          if Is_Remote_Access_To_Class_Wide_Type (Prefix_Type)
            and then Comes_From_Source (N)
@@ -3586,8 +3589,8 @@ package body Sem_Ch4 is
                --  this case gigi generates all the checks and can find the
                --  necessary bounds information.
 
-               --  We also do not need an actual subtype for the case of
-               --  a first, last, length, or range attribute applied to a
+               --  We also do not need an actual subtype for the case of a
+               --  first, last, length, or range attribute applied to a
                --  non-packed array, since gigi can again get the bounds in
                --  these cases (gigi cannot handle the packed case, since it
                --  has the bounds of the packed array type, not the original
@@ -6146,9 +6149,10 @@ package body Sem_Ch4 is
                                                    N_Function_Call);
       Loc            : constant Source_Ptr := Sloc (N);
       Obj            : constant Node_Id    := Prefix (N);
-      Subprog        : constant Node_Id    :=
-                         Make_Identifier (Sloc (Selector_Name (N)),
-                           Chars => Chars (Selector_Name (N)));
+
+      Subprog : constant Node_Id    :=
+                  Make_Identifier (Sloc (Selector_Name (N)),
+                    Chars => Chars (Selector_Name (N)));
       --  Identifier on which possible interpretations will be collected
 
       Report_Error : Boolean := False;

gcc/ada/sprint.adb

@@ -4364,12 +4364,10 @@ package body Sprint is
    procedure Write_Ureal_With_Col_Check_Sloc (U : Ureal) is
       D : constant Uint := Denominator (U);
       N : constant Uint := Numerator (U);
-
    begin
-      Col_Check
-        (UI_Decimal_Digits_Hi (D) + UI_Decimal_Digits_Hi (N) + 4);
+      Col_Check (UI_Decimal_Digits_Hi (D) + UI_Decimal_Digits_Hi (N) + 4);
       Set_Debug_Sloc;
-      UR_Write (U);
+      UR_Write (U, Brackets => True);
    end Write_Ureal_With_Col_Check_Sloc;
 
 end Sprint;

gcc/ada/sprint.ads

@@ -76,7 +76,7 @@ package Sprint is
    --    Push exception label                %push_xxx_exception_label (label)
    --    Raise xxx error                     [xxx_error [when cond]]
    --    Raise xxx error with msg            [xxx_error [when cond], "msg"]
-   --    Rational literal                    See UR_Write for details
+   --    Rational literal                    [expression]
    --    Rem wi Treat_Fixed_As_Integer       x #rem y
    --    Reference                           expression'reference
    --    Shift nodes                         shift_name!(expr, count)

gcc/ada/urealp.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009  Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -1307,28 +1307,108 @@ package body Urealp is
    -- UR_Write --
    --------------
 
-   procedure UR_Write (Real : Ureal) is
+   procedure UR_Write (Real : Ureal; Brackets : Boolean := False) is
       Val : constant Ureal_Entry := Ureals.Table (Real);
+      T   : Uint;
 
    begin
       --  If value is negative, we precede the constant by a minus sign
-      --  and add an extra layer of parentheses on the outside since the
-      --  minus sign is part of the value, not a negation operator.
 
       if Val.Negative then
-         Write_Str ("(-");
+         Write_Char ('-');
       end if;
 
+      --  Zero is zero
+
+      if Val.Num = 0 then
+         Write_Str ("0.0");
+
       --  Constants in base 10 can be written in normal Ada literal style
 
-      if Val.Rbase = 10 then
-         UI_Write (Val.Num / 10);
-         Write_Char ('.');
-         UI_Write (Val.Num mod 10);
+      elsif Val.Rbase = 10 then
 
-         if Val.Den /= 0 then
+         --  Use fixed-point format for small scaling values
+
+         if Val.Den = 0 then
+            UI_Write (Val.Num, Decimal);
+            Write_Str (".0");
+
+         elsif Val.Den = 1 then
+            UI_Write (Val.Num / 10, Decimal);
+            Write_Char ('.');
+            UI_Write (Val.Num mod 10, Decimal);
+
+         elsif Val.Den = 2 then
+            UI_Write (Val.Num / 100, Decimal);
+            Write_Char ('.');
+            UI_Write (Val.Num mod 100 / 10, Decimal);
+            UI_Write (Val.Num mod 10, Decimal);
+
+         elsif Val.Den = -1 then
+            UI_Write (Val.Num, Decimal);
+            Write_Str ("0.0");
+
+         elsif Val.Den = -2 then
+            UI_Write (Val.Num, Decimal);
+            Write_Str ("00.0");
+
+         --  Else use exponential format
+
+         else
+            UI_Write (Val.Num / 10, Decimal);
+            Write_Char ('.');
+            UI_Write (Val.Num mod 10, Decimal);
             Write_Char ('E');
-            UI_Write (1 - Val.Den);
+            UI_Write (1 - Val.Den, Decimal);
+         end if;
+
+      --  If we have a constant in a base other than 10, and the denominator
+      --  is zero, then the value is simply the numerator value, since we are
+      --  dividing by base**0, which is 1.
+
+      elsif Val.Den = 0 then
+         UI_Write (Val.Num, Decimal);
+         Write_Str (".0");
+
+      --  Small powers of 2 get written in decimal fixed-point format
+
+      elsif Val.Rbase = 2
+        and then Val.Den <= 3
+        and then Val.Den >= -16
+      then
+         if Val.Den = 1 then
+            T := Val.Num * (10/2);
+            UI_Write (T / 10, Decimal);
+            Write_Char ('.');
+            UI_Write (T mod 10, Decimal);
+
+         elsif Val.Den = 2 then
+            T := Val.Num * (100/4);
+            UI_Write (T / 100, Decimal);
+            Write_Char ('.');
+            UI_Write (T mod 100 / 10, Decimal);
+
+            if T mod 10 /= 0 then
+               UI_Write (T mod 10, Decimal);
+            end if;
+
+         elsif Val.Den = 3 then
+            T := Val.Num * (1000 / 8);
+            UI_Write (T / 1000, Decimal);
+            Write_Char ('.');
+            UI_Write (T mod 1000 / 100, Decimal);
+
+            if T mod 100 /= 0 then
+               UI_Write (T mod 100 / 10, Decimal);
+
+               if T mod 10 /= 0 then
+                  UI_Write (T mod 10, Decimal);
+               end if;
+            end if;
+
+         else
+            UI_Write (Val.Num * (Uint_2 ** (-Val.Den)), Decimal);
+            Write_Str (".0");
          end if;
 
       --  Constants in a base other than 10 can still be easily written
@@ -1343,48 +1423,60 @@ package body Urealp is
       --  of the following forms, depending on the sign of the number
       --  and the sign of the exponent (= minus denominator value)
 
-      --    (numerator.0*base**exponent)
-      --    (numerator.0*base**(-exponent))
+      --    numerator.0*base**exponent
+      --    numerator.0*base**-exponent
+
+      --  And of course an exponent of 0 can be omitted
 
       elsif Val.Rbase /= 0 then
-         Write_Char ('(');
+         if Brackets then
+            Write_Char ('[');
+         end if;
+
          UI_Write (Val.Num, Decimal);
-         Write_Str (".0*");
-         Write_Int (Val.Rbase);
-         Write_Str ("**");
+         Write_Str (".0");
 
-         if Val.Den <= 0 then
-            UI_Write (-Val.Den, Decimal);
+         if Val.Den /= 0 then
+            Write_Char ('*');
+            Write_Int (Val.Rbase);
+            Write_Str ("**");
 
-         else
-            Write_Str ("(-");
-            UI_Write (Val.Den, Decimal);
-            Write_Char (')');
+            if Val.Den <= 0 then
+               UI_Write (-Val.Den, Decimal);
+            else
+               Write_Str ("(-");
+               UI_Write (Val.Den, Decimal);
+               Write_Char (')');
+            end if;
          end if;
 
-         Write_Char (')');
+         if Brackets then
+            Write_Char (']');
+         end if;
 
-      --  Rational constants with a denominator of 1 can be written as
-      --  a real literal for the numerator integer.
+      --  Rationals where numerator is divisible by denominator can be output
+      --  as literals after we do the division. This includes the common case
+      --  where the denominator is 1.
 
-      elsif Val.Den = 1 then
-         UI_Write (Val.Num, Decimal);
+      elsif Val.Num mod Val.Den = 0 then
+         UI_Write (Val.Num / Val.Den, Decimal);
          Write_Str (".0");
 
-      --  Non-based (rational) constants are written in (num/den) style
+      --  Other non-based (rational) constants are written in num/den style
 
       else
-         Write_Char ('(');
+         if Brackets then
+            Write_Char ('[');
+         end if;
+
          UI_Write (Val.Num, Decimal);
          Write_Str (".0/");
          UI_Write (Val.Den, Decimal);
-         Write_Str (".0)");
-      end if;
-
-      --  Add trailing paren for negative values
+         Write_Str (".0");
 
-      if Val.Negative then
-         Write_Char (')');
+         if Brackets then
+            Write_Char (']');
+         end if;
       end if;
    end UR_Write;
 

gcc/ada/urealp.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009  Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -264,14 +264,17 @@ package Urealp is
    function UR_Is_Positive (Real : Ureal) return Boolean;
    --  Test if real value is greater than zero
 
-   procedure UR_Write (Real : Ureal);
-   --  Writes value of Real to standard output. Used only for debugging and
-   --  tree/source output. If the result is easily representable as a standard
-   --  Ada literal, it will be given that way, but as a result of evaluation
-   --  of static expressions, it is possible to generate constants (e.g. 1/13)
-   --  which have no such representation. In such cases (and in cases where it
-   --  is too much work to figure out the Ada literal), the string that is
-   --  output is of the form [numerator/denominator].
+   procedure UR_Write (Real : Ureal; Brackets : Boolean := False);
+   --  Writes value of Real to standard output. Used for debugging and
+   --  tree/source output, and also for -gnatR representation output. If the
+   --  result is easily representable as a standard Ada literal, it will be
+   --  given that way, but as a result of evaluation of static expressions, it
+   --  is possible to generate constants (e.g. 1/13) which have no such
+   --  representation. In such cases (and in cases where it is too much work to
+   --  figure out the Ada literal), the string that is output is of the form
+   --  of some expression such as integer/integer, or integer*integer**integer.
+   --  In the case where an expression is output, if Brackets is set to True,
+   --  the expression is surrounded by square brackets.
 
    procedure pr (Real : Ureal);
    pragma Export (Ada, pr);