a-ngcoty.adb: New pragma Fast_Math

2007-12-06  Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* a-ngcoty.adb: New pragma Fast_Math

	* opt.adb: New pragma Fast_Math

	* par-prag.adb: 
	Add Implemented_By_Entry to the list of pragmas which do not require any
	special processing.
	(Favor_Top_Level): New pragma.
	New pragma Fast_Math

	* exp_attr.adb: Move Wide_[Wide_]Image routines to Exp_Imgv
	(Expand_N_Attribute_Reference, Displace_Allocator_Pointer,
	Expand_Allocator_Expression): Take into account VM_Target
	(Expand_Attribute, case 'Identity):  Handle properly the case where
	the prefix is a task interface.
	New pragma Fast_Math

	* par.adb (Next_Token_Is): New function
	(P_Pragma): Add Skipping parameter
	(U_Left_Paren): New procedure
	(U_Right_Paren): New procedure
	New pragma Fast_Math

	* par-ch10.adb (P_Subunit): Unconditional msg for missing ) after
	subunit
	New pragma Fast_Math

	* sem_prag.adb: Add significance value to table Sig_Flag for pragma
	Implemented_By_Entry.
	(Analyze_Pragma): Add case for Ada 2005 pragma Implemented_By_Entry.
	(Set_Inline_Flags): Do not try to link pragma Inline onto chain of rep
	items, since it can apply to more than one overloadable entity. Set
	new flag Has_Pragma_Inline_Always for Inline_Always case.
	(Analyze_Pragma, case Complex_Representation): Improve error message.
	(Analyze_Pragma, case Assert): When assertions are disabled build the
	rewritten code with Sloc of expression rather than pragma, so new
	warning about failing is not deleted.
	(Analyze_Pragma): Allow pragma Preelaborable_Initialization to apply to
	protected types and update error message to reflect that. Test whether
	the protected type is allowed for the pragma (an error is issued if the
	type has any entries, or components that do not have preelaborable
	initialization).
	New pragma Fast_Math
	(Analyze_Pragma, case No_Return): Handle generic instance

	* snames.h, snames.ads, snames.adb: 
	Add new predefined name for interface primitive _Disp_Requeue.
	New pragma Fast_Math

	* a-tags.ads, a-tags.adb: New calling sequence for
	String_To_Wide_[Wide_]String
	(Secondary_Tag): New subprogram.

	* exp_imgv.ads, exp_imgv.adb: Move Wide_[Wide_]Image routines here
	from Exp_Attr
	New calling sequence for String_To_Wide_[Wide_]String
	(Expand_Image_Attribute): Major rewrite. New calling sequence avoids
	the use of the secondary stack for image routines.

	* a-except-2005.adb, s-wchstw.ads, s-wchstw.adb, s-wwdenu.adb: New
	calling sequence for String_To_Wide_[Wide_]String

	* par-ch3.adb (P_Declarative_Items): Recognize use of Overriding in
	Ada 95 mode
	(P_Unknown_Discriminant_Part_Opt): Handle missing parens gracefully
	Remove Atree.Delete_Tree/Delete_Node and Nlist.Delete_List

	* par-ch6.adb (P_Subprogram): Recognize use of Overriding in Ada 95 mode
	(P_Formal_Part): Use Skipping parameter in P_Pragma call
	to improve error recovery

	* par-util.adb (Next_Token_Is): New function
	(Signal_Bad_Attribute): Use new Namet.Is_Bad_Spelling_Of function

	* par-ch2.adb (Skip_Pragma_Semicolon): Do not resynchronize to
	semicolon if missing
	(P_Pragma): Implement new Skipping parameter
	Remove Atree.Delete_Tree/Delete_Node and Nlist.Delete_List
	Fix location of flag for unrecognized pragma message

	* par-tchk.adb (U_Left_Paren): New procedure
	(U_Right_Paren): New procedure

From-SVN: r130818

1 files changed, 351 insertions, 74 deletions

diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb
index 7506620..df3d7e8 100644
--- a/gcc/ada/exp_imgv.adb
+++ b/gcc/ada/exp_imgv.adb
@@ -155,14 +155,23 @@ package body Exp_Imgv is
    -- Expand_Image_Attribute --
    ----------------------------
 
-   --  For all non-enumeration types, and for enumeration types declared
-   --  in packages Standard or System, typ'Image (Val) expands into:
+   --  For all cases other than user defined enumeration types, the scheme
+   --  is as follows. First we insert the following code:
 
-   --     Image_xx (tp (Expr) [, pm])
+   --    Snn : String (1 .. rt'Width);
+   --    Pnn : Natural;
+   --    Image_xx (tv, Snn, Pnn [,pm]);
+   --
+   --  and then Expr is replaced by Snn (1 .. Pnn)
 
-   --  The name xx and type conversion tp (Expr) (called tv below) depend on
-   --  the root type of Expr. The argument pm is an extra type dependent
-   --  parameter only used in some cases as follows:
+   --  In the above expansion:
+
+   --    rt is the root type of the expression
+   --    tv is the expression with the value, usually a type conversion
+   --    pm is an extra parameter present in some cases
+
+   --  The following table shows tv, xx, and (if used) pm for the various
+   --  possible types of the argument:
 
    --    For types whose root type is Character
    --      xx = Character
@@ -194,57 +203,103 @@ package body Exp_Imgv is
    --      pm = Boolean, true if Ada 2005 mode, False otherwise
 
    --    For types whose root type is Wide_Wide_Character
-   --      xx = Wide_Wide_haracter
+   --      xx = Wide_Wide_Character
    --      tv = Wide_Wide_Character (Expr)
 
    --    For floating-point types
    --      xx = Floating_Point
    --      tv = Long_Long_Float (Expr)
-   --      pm = typ'Digits
+   --      pm = typ'Digits (typ = subtype of expression)
 
    --    For ordinary fixed-point types
    --      xx = Ordinary_Fixed_Point
    --      tv = Long_Long_Float (Expr)
-   --      pm = typ'Aft
+   --      pm = typ'Aft (typ = subtype of expression)
 
    --    For decimal fixed-point types with size = Integer'Size
    --      xx = Decimal
    --      tv = Integer (Expr)
-   --      pm = typ'Scale
+   --      pm = typ'Scale (typ = subtype of expression)
 
    --    For decimal fixed-point types with size > Integer'Size
    --      xx = Long_Long_Decimal
-   --      tv = Long_Long_Integer (Expr)
-   --      pm = typ'Scale
-
-   --    Note: for the decimal fixed-point type cases, the conversion is
-   --    done literally without scaling (i.e. the actual expression that
-   --    is generated is Image_xx (tp?(Expr) [, pm])
+   --      tv = Long_Long_Integer?(Expr) [convert with no scaling]
+   --      pm = typ'Scale (typ = subtype of expression)
 
    --  For enumeration types other than those declared packages Standard
-   --  or System, typ'Image (X) expands into:
+   --  or System, Snn, Pnn, are expanded as above, but the call looks like:
+
+   --    Image_Enumeration_NN (rt'Pos (X), Snn, Pnn, typS, typI'Address)
 
-   --    Image_Enumeration_NN (typ'Pos (X), typS, typI'Address)
+   --  where rt is the root type of the expression, and typS and typI are
+   --  the entities constructed as described in the spec for the procedure
+   --  Build_Enumeration_Image_Tables and NN is 32/16/8 depending on the
+   --  element type of Lit_Indexes. The rewriting of the expression to
+   --  Snn (1 .. Pnn) then occurs as in the other cases. A special case is
+   --  when pragma Discard_Names applies, in which case we replace expr by:
 
-   --  where typS and typI are the entities constructed as described in
-   --  the spec for the procedure Build_Enumeration_Image_Tables and NN
-   --  is 32/16/8 depending on the element type of Lit_Indexes.
+   --    Missing ???
 
    procedure Expand_Image_Attribute (N : Node_Id) is
-      Loc      : constant Source_Ptr := Sloc (N);
-      Exprs    : constant List_Id    := Expressions (N);
-      Pref     : constant Node_Id    := Prefix (N);
-      Ptyp     : constant Entity_Id  := Entity (Pref);
-      Rtyp     : constant Entity_Id  := Root_Type (Ptyp);
-      Expr     : constant Node_Id    := Relocate_Node (First (Exprs));
-      Imid     : RE_Id;
-      Tent     : Entity_Id;
-      Arglist  : List_Id;
-      Func     : RE_Id;
-      Ttyp     : Entity_Id;
-      Func_Ent : Entity_Id;
+      Loc       : constant Source_Ptr := Sloc (N);
+      Exprs     : constant List_Id    := Expressions (N);
+      Pref      : constant Node_Id    := Prefix (N);
+      Ptyp      : constant Entity_Id  := Entity (Pref);
+      Rtyp      : constant Entity_Id  := Root_Type (Ptyp);
+      Expr      : constant Node_Id    := Relocate_Node (First (Exprs));
+      Imid      : RE_Id;
+      Tent      : Entity_Id;
+      Ttyp      : Entity_Id;
+      Proc_Ent  : Entity_Id;
+      Enum_Case : Boolean;
+
+      Arg_List : List_Id;
+      --  List of arguments for run-time procedure call
+
+      Ins_List : List_Id;
+      --  List of actions to be inserted
+
+      Snn : constant Entity_Id :=
+              Make_Defining_Identifier (Loc,
+                Chars => New_Internal_Name ('S'));
+
+      Pnn : constant Entity_Id :=
+              Make_Defining_Identifier (Loc,
+                Chars => New_Internal_Name ('P'));
 
    begin
+      --  Build declarations of Snn and Pnn to be inserted
+
+      Ins_List := New_List (
+
+         --  Snn : String (1 .. typ'Width);
+
+         Make_Object_Declaration (Loc,
+            Defining_Identifier => Snn,
+            Object_Definition   =>
+              Make_Subtype_Indication (Loc,
+                Subtype_Mark => New_Occurrence_Of (Standard_String, Loc),
+                Constraint   =>
+                  Make_Index_Or_Discriminant_Constraint (Loc,
+                    Constraints => New_List (
+                      Make_Range (Loc,
+                        Low_Bound  => Make_Integer_Literal (Loc, 1),
+                        High_Bound =>
+                          Make_Attribute_Reference (Loc,
+                            Prefix         => New_Occurrence_Of (Rtyp, Loc),
+                            Attribute_Name => Name_Width)))))),
+
+         --  Pnn : Natural;
+
+         Make_Object_Declaration (Loc,
+           Defining_Identifier => Pnn,
+           Object_Definition   => New_Occurrence_Of (Standard_Natural, Loc)));
+
+      --  Set Imid (RE_Id of procedure to call), and Tent, target for the
+      --  type conversion of the first argument for all possibilities.
+
+      Enum_Case := False;
+
       if Rtyp = Standard_Boolean then
          Imid := RE_Image_Boolean;
          Tent := Rtyp;
@@ -315,68 +370,77 @@ package body Exp_Imgv is
                 Attribute_Name =>
                   Name_Img));
             Analyze_And_Resolve (N, Standard_String);
+            return;
 
          else
-            --  Here we get the Image of an enumeration type
+            --  Here for enumeration type case
 
             Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp)));
 
             if Ttyp = Standard_Integer_8 then
-               Func := RE_Image_Enumeration_8;
+               Imid := RE_Image_Enumeration_8;
             elsif Ttyp = Standard_Integer_16  then
-               Func := RE_Image_Enumeration_16;
+               Imid := RE_Image_Enumeration_16;
             else
-               Func := RE_Image_Enumeration_32;
+               Imid := RE_Image_Enumeration_32;
             end if;
 
-            --  Apply a validity check, since it is a bit drastic to
-            --  get a completely junk image value for an invalid value.
+            --  Apply a validity check, since it is a bit drastic to get a
+            --  completely junk image value for an invalid value.
 
             if not Expr_Known_Valid (Expr) then
                Insert_Valid_Check (Expr);
             end if;
 
-            Rewrite (N,
-              Make_Function_Call (Loc,
-                Name => New_Occurrence_Of (RTE (Func), Loc),
-                Parameter_Associations => New_List (
-                  Make_Attribute_Reference (Loc,
-                    Attribute_Name => Name_Pos,
-                    Prefix         => New_Occurrence_Of (Ptyp, Loc),
-                    Expressions    => New_List (Expr)),
-                  New_Occurrence_Of (Lit_Strings (Rtyp), Loc),
-                  Make_Attribute_Reference (Loc,
-                    Prefix => New_Occurrence_Of (Lit_Indexes (Rtyp), Loc),
-                    Attribute_Name => Name_Address))));
-
-            Analyze_And_Resolve (N, Standard_String);
+            Enum_Case := True;
          end if;
+      end if;
 
-         return;
+      --  Build first argument for call
+
+      if Enum_Case then
+         Arg_List := New_List (
+           Make_Attribute_Reference (Loc,
+             Attribute_Name => Name_Pos,
+             Prefix         => New_Occurrence_Of (Ptyp, Loc),
+             Expressions    => New_List (Expr)));
+
+      else
+         Arg_List := New_List (Convert_To (Tent, Expr));
       end if;
 
-      --  If we fall through, we have one of the cases that is handled by
-      --  calling one of the System.Img_xx routines and Imid is set to the
-      --  RE_Id for the function to be called.
+      --  Append Snn, Pnn arguments
 
-      Func_Ent := RTE (Imid);
+      Append_To (Arg_List, New_Occurrence_Of (Snn, Loc));
+      Append_To (Arg_List, New_Occurrence_Of (Pnn, Loc));
 
-      --  If the function entity is empty, that means we have a case in
+      --  Get entity of procedure to call
+
+      Proc_Ent := RTE (Imid);
+
+      --  If the procedure entity is empty, that means we have a case in
       --  no run time mode where the operation is not allowed, and an
       --  appropriate diagnostic has already been issued.
 
-      if No (Func_Ent) then
+      if No (Proc_Ent) then
          return;
       end if;
 
-      --  Otherwise prepare arguments for run-time call
+      --  Otherwise complete preparation of arguments for run-time call
 
-      Arglist := New_List (Convert_To (Tent, Relocate_Node (Expr)));
+      --  Add extra arguments for Enumeration case
+
+      if Enum_Case then
+         Append_To (Arg_List, New_Occurrence_Of (Lit_Strings (Rtyp), Loc));
+         Append_To (Arg_List,
+           Make_Attribute_Reference (Loc,
+             Prefix         => New_Occurrence_Of (Lit_Indexes (Rtyp), Loc),
+             Attribute_Name => Name_Address));
 
       --  For floating-point types, append Digits argument
 
-      if Is_Floating_Point_Type (Rtyp) then
-         Append_To (Arglist,
+      elsif Is_Floating_Point_Type (Rtyp) then
+         Append_To (Arg_List,
            Make_Attribute_Reference (Loc,
              Prefix         => New_Reference_To (Ptyp, Loc),
              Attribute_Name => Name_Digits));
@@ -384,7 +448,7 @@ package body Exp_Imgv is
       --  For ordinary fixed-point types, append Aft parameter
 
       elsif Is_Ordinary_Fixed_Point_Type (Rtyp) then
-         Append_To (Arglist,
+         Append_To (Arg_List,
            Make_Attribute_Reference (Loc,
              Prefix         => New_Reference_To (Ptyp, Loc),
              Attribute_Name => Name_Aft));
@@ -392,27 +456,45 @@ package body Exp_Imgv is
       --  For decimal, append Scale and also set to do literal conversion
 
       elsif Is_Decimal_Fixed_Point_Type (Rtyp) then
-         Append_To (Arglist,
+         Append_To (Arg_List,
            Make_Attribute_Reference (Loc,
              Prefix => New_Reference_To (Ptyp, Loc),
              Attribute_Name => Name_Scale));
 
-         Set_Conversion_OK (First (Arglist));
-         Set_Etype (First (Arglist), Tent);
+         Set_Conversion_OK (First (Arg_List));
+         Set_Etype (First (Arg_List), Tent);
 
          --  For Wide_Character, append Ada 2005 indication
 
       elsif Rtyp = Standard_Wide_Character then
-         Append_To (Arglist,
+         Append_To (Arg_List,
            New_Reference_To (Boolean_Literals (Ada_Version >= Ada_05), Loc));
       end if;
 
-      Rewrite (N,
-        Make_Function_Call (Loc,
-          Name => New_Reference_To (Func_Ent, Loc),
-          Parameter_Associations => Arglist));
+      --  Now append the procedure call to the insert list
+
+      Append_To (Ins_List,
+         Make_Procedure_Call_Statement (Loc,
+          Name                   => New_Reference_To (Proc_Ent, Loc),
+          Parameter_Associations => Arg_List));
+
+      --  Insert declarations of Snn, Pnn, and the procedure call. We suppress
+      --  checks because we are sure that everything is in range at this stage.
+
+      Insert_Actions (N, Ins_List, Suppress => All_Checks);
+
+      --  Final step is to rewrite the expression as a slice and analyze,
+      --  again with no checks, since we are sure that everything is OK.
 
-      Analyze_And_Resolve (N, Standard_String);
+      Rewrite (N,
+        Make_Slice (Loc,
+          Prefix         => New_Occurrence_Of (Snn, Loc),
+          Discrete_Range =>
+            Make_Range (Loc,
+              Low_Bound  => Make_Integer_Literal (Loc, 1),
+              High_Bound => New_Occurrence_Of (Pnn, Loc))));
+
+      Analyze_And_Resolve (N, Standard_String, Suppress => All_Checks);
    end Expand_Image_Attribute;
 
    ----------------------------
@@ -662,6 +744,201 @@ package body Exp_Imgv is
       Analyze_And_Resolve (N, Btyp);
    end Expand_Value_Attribute;
 
+   ---------------------------------
+   -- Expand_Wide_Image_Attribute --
+   ---------------------------------
+
+   --  We expand typ'Wide_Image (X) as follows. First we insert this code:
+
+   --    Rnn : Wide_String (1 .. rt'Wide_Width);
+   --    Lnn : Natural;
+   --    String_To_Wide_String
+   --      (typ'Image (Expr), Rnn, Lnn, Wide_Character_Encoding_Method);
+
+   --  where rt is the root type of the prefix type
+
+   --  Now we replace the Wide_Image reference by
+
+   --    Rnn (1 .. Lnn)
+
+   --  This works in all cases because String_To_Wide_String converts any
+   --  wide character escape sequences resulting from the Image call to the
+   --  proper Wide_Character equivalent
+
+   --  not quite right for typ = Wide_Character ???
+
+   procedure Expand_Wide_Image_Attribute (N : Node_Id) is
+      Loc  : constant Source_Ptr := Sloc (N);
+      Rtyp : constant Entity_Id  := Root_Type (Entity (Prefix (N)));
+
+      Rnn : constant Entity_Id :=
+              Make_Defining_Identifier (Loc,
+                Chars => New_Internal_Name ('S'));
+
+      Lnn : constant Entity_Id :=
+              Make_Defining_Identifier (Loc,
+                Chars => New_Internal_Name ('P'));
+
+   begin
+      Insert_Actions (N, New_List (
+
+         --  Rnn : Wide_String (1 .. base_typ'Width);
+
+         Make_Object_Declaration (Loc,
+            Defining_Identifier => Rnn,
+            Object_Definition   =>
+              Make_Subtype_Indication (Loc,
+                Subtype_Mark =>
+                  New_Occurrence_Of (Standard_Wide_String, Loc),
+                Constraint   =>
+                  Make_Index_Or_Discriminant_Constraint (Loc,
+                    Constraints => New_List (
+                      Make_Range (Loc,
+                        Low_Bound  => Make_Integer_Literal (Loc, 1),
+                        High_Bound =>
+                          Make_Attribute_Reference (Loc,
+                            Prefix         => New_Occurrence_Of (Rtyp, Loc),
+                            Attribute_Name => Name_Wide_Width)))))),
+
+         --  Lnn : Natural;
+
+         Make_Object_Declaration (Loc,
+           Defining_Identifier => Lnn,
+           Object_Definition   => New_Occurrence_Of (Standard_Natural, Loc)),
+
+         --    String_To_Wide_String
+         --      (typ'Image (X), Rnn, Lnn, Wide_Character_Encoding_Method);
+
+         Make_Procedure_Call_Statement (Loc,
+           Name =>
+             New_Reference_To (RTE (RE_String_To_Wide_String), Loc),
+
+           Parameter_Associations => New_List (
+             Make_Attribute_Reference (Loc,
+               Prefix         => Prefix (N),
+               Attribute_Name => Name_Image,
+               Expressions    => Expressions (N)),
+             New_Reference_To (Rnn, Loc),
+             New_Reference_To (Lnn, Loc),
+             Make_Integer_Literal (Loc,
+               Intval => Int (Wide_Character_Encoding_Method))))),
+
+         --  Suppress checks because we know everything is properly in range
+
+         Suppress => All_Checks);
+
+      --  Final step is to rewrite the expression as a slice and analyze,
+      --  again with no checks, since we are sure that everything is OK.
+
+      Rewrite (N,
+        Make_Slice (Loc,
+          Prefix         => New_Occurrence_Of (Rnn, Loc),
+          Discrete_Range =>
+            Make_Range (Loc,
+              Low_Bound  => Make_Integer_Literal (Loc, 1),
+              High_Bound => New_Occurrence_Of (Lnn, Loc))));
+
+      Analyze_And_Resolve (N, Standard_Wide_String, Suppress => All_Checks);
+   end Expand_Wide_Image_Attribute;
+
+   --------------------------------------
+   -- Expand_Wide_Wide_Image_Attribute --
+   --------------------------------------
+
+   --  We expand typ'Wide_Wide_Image (X) as follows. First we insert this code:
+
+   --    Rnn : Wide_Wide_String (1 .. rt'Wide_Wide_Width);
+   --    Lnn : Natural;
+   --    String_To_Wide_Wide_String
+   --      (typ'Image (Expr), Rnn, Lnn, Wide_Character_Encoding_Method);
+
+   --  where rt is the root type of the prefix type
+
+   --  Now we replace the Wide_Wide_Image reference by
+
+   --    Rnn (1 .. Lnn)
+
+   --  This works in all cases because String_To_Wide_Wide_String converts any
+   --  wide character escape sequences resulting from the Image call to the
+   --  proper Wide_Wide_Character equivalent
+
+   --  not quite right for typ = Wide_Wide_Character ???
+
+   procedure Expand_Wide_Wide_Image_Attribute (N : Node_Id) is
+      Loc  : constant Source_Ptr := Sloc (N);
+      Rtyp : constant Entity_Id  := Root_Type (Entity (Prefix (N)));
+
+      Rnn : constant Entity_Id :=
+              Make_Defining_Identifier (Loc,
+                Chars => New_Internal_Name ('S'));
+
+      Lnn : constant Entity_Id :=
+              Make_Defining_Identifier (Loc,
+                Chars => New_Internal_Name ('P'));
+
+   begin
+      Insert_Actions (N, New_List (
+
+         --  Rnn : Wide_Wide_String (1 .. rt'Wide_Wide_Width);
+
+         Make_Object_Declaration (Loc,
+            Defining_Identifier => Rnn,
+            Object_Definition   =>
+              Make_Subtype_Indication (Loc,
+                Subtype_Mark =>
+                  New_Occurrence_Of (Standard_Wide_Wide_String, Loc),
+                Constraint   =>
+                  Make_Index_Or_Discriminant_Constraint (Loc,
+                    Constraints => New_List (
+                      Make_Range (Loc,
+                        Low_Bound  => Make_Integer_Literal (Loc, 1),
+                        High_Bound =>
+                          Make_Attribute_Reference (Loc,
+                            Prefix         => New_Occurrence_Of (Rtyp, Loc),
+                            Attribute_Name => Name_Wide_Wide_Width)))))),
+
+         --  Lnn : Natural;
+
+         Make_Object_Declaration (Loc,
+           Defining_Identifier => Lnn,
+           Object_Definition   => New_Occurrence_Of (Standard_Natural, Loc)),
+
+         --    String_To_Wide_Wide_String
+         --      (typ'Image (X), Rnn, Lnn, Wide_Character_Encoding_Method);
+
+         Make_Procedure_Call_Statement (Loc,
+           Name =>
+             New_Reference_To (RTE (RE_String_To_Wide_Wide_String), Loc),
+
+           Parameter_Associations => New_List (
+             Make_Attribute_Reference (Loc,
+               Prefix         => Prefix (N),
+               Attribute_Name => Name_Image,
+               Expressions    => Expressions (N)),
+             New_Reference_To (Rnn, Loc),
+             New_Reference_To (Lnn, Loc),
+             Make_Integer_Literal (Loc,
+               Intval => Int (Wide_Character_Encoding_Method))))),
+
+         --  Suppress checks because we know everything is properly in range
+
+         Suppress => All_Checks);
+
+      --  Final step is to rewrite the expression as a slice and analyze,
+      --  again with no checks, since we are sure that everything is OK.
+
+      Rewrite (N,
+        Make_Slice (Loc,
+          Prefix         => New_Occurrence_Of (Rnn, Loc),
+          Discrete_Range =>
+            Make_Range (Loc,
+              Low_Bound  => Make_Integer_Literal (Loc, 1),
+              High_Bound => New_Occurrence_Of (Lnn, Loc))));
+
+      Analyze_And_Resolve
+        (N, Standard_Wide_Wide_String, Suppress => All_Checks);
+   end Expand_Wide_Wide_Image_Attribute;
+
    ----------------------------
    -- Expand_Width_Attribute --
    ----------------------------