public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-5021] ada: INOX: prototype RFC on String Interpolation
@ 2023-01-05 14:38 Marc Poulhi?s
0 siblings, 0 replies; only message in thread
From: Marc Poulhi?s @ 2023-01-05 14:38 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:9ef547a7a99522db8f0f028bde8febc8f1ad8bb8
commit r13-5021-g9ef547a7a99522db8f0f028bde8febc8f1ad8bb8
Author: Javier Miranda <miranda@adacore.com>
Date: Fri Nov 4 13:22:05 2022 +0000
ada: INOX: prototype RFC on String Interpolation
This patch incorporates a prototype for a new string literal syntax
which supports the use of "string interpolation," where the names
of variables or expressions can be used directly within the string
literal, such that the value of the variable or the expression is
"interpolated" directly into the value of the enclosing string
upon use at run-time.
gcc/ada/
* scans.ads (Tok_Left_Curly_Bracket, Tok_Right_Curly_Bracket)
(Tok_Left_Interpolated_String): Placed in no category since they
don't fit well in the existing categories. Fix typo in comment.
(Inside_Interpolated_String_Literal): New scan state variable.
* scng.adb (Slit): Scan interpolated string literals,
continuations of interpolated string literals and escaped
characters found in interpolated string literals.
(Scan): Handle consecutive interpolated expressions. Handle ending
delimiter placed immediately after an interpolated expression.
Handle string literal placed after interpolated expression. Handle
left and right curly brackets; when extensions are not allowed
they are treated as left and right paren; when extensions are
allowed they are handled as delimiters of interpolated string
literals.
* sinfo.ads (N_Interpolated_String_Literal): New node.
* gen_il-gen-gen_nodes.adb (N_Interpolated_String_Literal): Define
N_String_Literal node.
* gen_il-types.ads (Opt_Type_Enum): Define N_String_Literal as
concrete node type.
* par-ch2.adb (P_Interpolated_String_Literal): New subprogram.
* par-ch4.adb (P_Simple_Expression): Handle '}' as expression
terminator when scanning an interpolated expression; disable error
recovery machinery for binary operator when we are processing an
interpolated string literal and reach the expression terminator
'}'.
(P_Primary): Call P_Interpolated_String_Literal when the opening
interpolated-string-literal delimiter is found (that is, the left
curly bracket '{').
* par-tchk.adb (T_Right_Curly_Bracket): New subprogram.
* par.adb (P_Interpolated_String_Literal): New declaration.
(T_Right_Curly_Bracket): New declaration.
* sem.adb (Analyze): Call Analyze_Interpolated_String_Literal.
* sem_ch2.ads (Analyze_Interpolated_String_Literal): New
subprogram
* sem_ch2.adb (Analyze_Interpolated_String_Literal): Likewise.
* sem_util.adb (Is_User_Defined_Literal): Complete mapping of
literal aspects adding that interpolated string literals have no
correspondence with any aspect.
* sem_res.adb (Resolve_Interpolated_String_Literal): New
subprogram.
(Has_Applicable_User_Defined_Literal): Complete mapping of literal
aspects adding that interpolated string literals have no
correspondency with any aspect.
* expander.adb (Expand): Add call to
Expand_N_Interpolated_String_Literal.
* exp_util.adb (Insert_Actions): Handle
N_Interpolated_String_Literal nodes; that is, continue climbing.
* exp_ch2.ads (Expand_N_Interpolated_String_Literal): New
subprogram.
* exp_ch2.adb (Expand_N_Interpolated_String_Literal): Likewise.
* exp_put_image.adb (Build_Elementary_Put_Image_Call): Add missing
conversion to force dispatching call. Required to handle calls to
descendants.
(Build_String_Put_Image_Call): Do not output string delimiters
when the put_image call is part of an interpolated string literal.
* rtsfind.ads (RTU_Id): Add RE_Set_Trim_Leading_Spaces.
* sprint.adb (Sprint_Node): Output interpolated string contents.
* libgnat/a-stbubo.adb (Get_UTF_8): Add default value for
Trim_Leading_White_Spaces component in aggregate.
(Buffer_Type_Implementation): Update Trim_Leading_White_Spaces.
* libgnat/a-stbuun.adb (Get_UTF_8): Likewise.
(Buffer_Type_Implementation): Likewise.
* libgnat/a-sttebu.ads (Set_Trim_Leading_Spaces): New subprogram.
(Trim_Leading_Spaces): New subprogram.
(Root_Buffer_Type): Adding Trim_Leading_While_Spaces component.
* libgnat/a-sttebu.adb (procedure Set_Trim_Leading_Spaces): New
subprogram.
(Trim_Leading_Space): New subprogram.
(Put_UTF_8): Handle Trim_Leading_White_Spaces.
(New_Line): Likewise.
* libgnat/s-putima.ads (Put_Image_String): Adding formal
(with_delimiters).
(Put_Image_Wide_String): Likewise.
(Put_Image_Wide_Wide_String): Likewise.
* libgnat/s-putima.adb (Put_Image_String): Adding support for new
formal.
(Put_Image_Wide_String): Likewise.
(Put_Image_Wide_Wide_String): Likewise.
Diff:
---
gcc/ada/exp_ch2.adb | 117 +++++++++++++++++++++++++++++++++
gcc/ada/exp_ch2.ads | 7 +-
gcc/ada/exp_put_image.adb | 43 ++++++++++---
gcc/ada/exp_util.adb | 1 +
gcc/ada/expander.adb | 3 +
gcc/ada/gen_il-gen-gen_nodes.adb | 3 +
gcc/ada/gen_il-types.ads | 1 +
gcc/ada/libgnat/a-stbubo.adb | 19 ++++--
gcc/ada/libgnat/a-stbuun.adb | 68 +++++++++++++-------
gcc/ada/libgnat/a-sttebu.adb | 22 ++++++-
gcc/ada/libgnat/a-sttebu.ads | 16 +++++
gcc/ada/libgnat/s-putima.adb | 50 ++++++++++----
gcc/ada/libgnat/s-putima.ads | 16 ++++-
gcc/ada/par-ch2.adb | 73 +++++++++++++++++++++
gcc/ada/par-ch4.adb | 16 +++++
gcc/ada/par-tchk.adb | 14 ++++
gcc/ada/par.adb | 4 ++
gcc/ada/rtsfind.ads | 2 +
gcc/ada/scans.ads | 14 +++-
gcc/ada/scng.adb | 136 +++++++++++++++++++++++++++++++++++++--
gcc/ada/sem.adb | 3 +
gcc/ada/sem_ch2.adb | 19 ++++++
gcc/ada/sem_ch2.ads | 11 ++--
gcc/ada/sem_res.adb | 42 +++++++++++-
gcc/ada/sem_util.adb | 7 +-
gcc/ada/sinfo.ads | 27 ++++++++
gcc/ada/sprint.adb | 32 +++++++++
27 files changed, 689 insertions(+), 77 deletions(-)
diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb
index 8f97b438203..f5cebb7c07b 100644
--- a/gcc/ada/exp_ch2.adb
+++ b/gcc/ada/exp_ch2.adb
@@ -23,6 +23,7 @@
-- --
------------------------------------------------------------------------------
+with Aspects; use Aspects;
with Atree; use Atree;
with Checks; use Checks;
with Debug; use Debug;
@@ -34,9 +35,11 @@ with Exp_Smem; use Exp_Smem;
with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
with Namet; use Namet;
+with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
with Output; use Output;
+with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
@@ -47,6 +50,7 @@ with Sinfo.Nodes; use Sinfo.Nodes;
with Sinfo.Utils; use Sinfo.Utils;
with Sinput; use Sinput;
with Snames; use Snames;
+with Stand;
with Tbuild; use Tbuild;
package body Exp_Ch2 is
@@ -711,4 +715,117 @@ package body Exp_Ch2 is
Analyze_And_Resolve (N, T);
end Expand_Renaming;
+ ------------------------------------------
+ -- Expand_N_Interpolated_String_Literal --
+ ------------------------------------------
+
+ procedure Expand_N_Interpolated_String_Literal (N : Node_Id) is
+
+ function Build_Interpolated_String_Image (N : Node_Id) return Node_Id;
+ -- Build the following Expression_With_Actions node:
+ -- do
+ -- Sink : Buffer;
+ -- [ Set_Trim_Leading_Spaces (Sink); ]
+ -- Type'Put_Image (Sink, X);
+ -- { [ Set_Trim_Leading_Spaces (Sink); ]
+ -- Type'Put_Image (Sink, X); }
+ -- Result : constant String := Get (Sink);
+ -- Destroy (Sink);
+ -- in Result end
+
+ -------------------------------------
+ -- Build_Interpolated_String_Image --
+ -------------------------------------
+
+ function Build_Interpolated_String_Image (N : Node_Id) return Node_Id
+ is
+ Loc : constant Source_Ptr := Sloc (N);
+ Sink_Entity : constant Entity_Id := Make_Temporary (Loc, 'S');
+ Sink_Decl : constant Node_Id :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Sink_Entity,
+ Object_Definition =>
+ New_Occurrence_Of (RTE (RE_Buffer_Type), Loc));
+
+ Get_Id : constant RE_Id :=
+ (if Etype (N) = Stand.Standard_String then
+ RE_Get
+ elsif Etype (N) = Stand.Standard_Wide_String then
+ RE_Wide_Get
+ else
+ RE_Wide_Wide_Get);
+
+ Result_Entity : constant Entity_Id := Make_Temporary (Loc, 'R');
+ Result_Decl : constant Node_Id :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Result_Entity,
+ Object_Definition =>
+ New_Occurrence_Of (Etype (N), Loc),
+ Expression =>
+ Make_Function_Call (Loc,
+ Name => New_Occurrence_Of (RTE (Get_Id), Loc),
+ Parameter_Associations => New_List (
+ New_Occurrence_Of (Sink_Entity, Loc))));
+
+ Actions : constant List_Id := New_List;
+ Elem_Typ : Entity_Id;
+ Str_Elem : Node_Id;
+
+ begin
+ pragma Assert (Etype (N) /= Stand.Any_String);
+
+ Append_To (Actions, Sink_Decl);
+
+ Str_Elem := First (Expressions (N));
+ while Present (Str_Elem) loop
+ Elem_Typ := Etype (Str_Elem);
+
+ -- If the type is numeric or has a specified Integer_Literal or
+ -- Real_Literal aspect, then prior to invoking Put_Image, the
+ -- Trim_Leading_Spaces flag is set on the text buffer.
+
+ if Is_Numeric_Type (Underlying_Type (Elem_Typ))
+ or else Has_Aspect (Elem_Typ, Aspect_Integer_Literal)
+ or else Has_Aspect (Elem_Typ, Aspect_Real_Literal)
+ then
+ Append_To (Actions,
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Occurrence_Of
+ (RTE (RE_Set_Trim_Leading_Spaces), Loc),
+ Parameter_Associations => New_List (
+ Convert_To (RTE (RE_Root_Buffer_Type),
+ New_Occurrence_Of (Sink_Entity, Loc)),
+ New_Occurrence_Of (Stand.Standard_True, Loc))));
+ end if;
+
+ Append_To (Actions,
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Elem_Typ, Loc),
+ Attribute_Name => Name_Put_Image,
+ Expressions => New_List (
+ New_Occurrence_Of (Sink_Entity, Loc),
+ Duplicate_Subexpr (Str_Elem))));
+
+ Next (Str_Elem);
+ end loop;
+
+ Append_To (Actions, Result_Decl);
+
+ return Make_Expression_With_Actions (Loc,
+ Actions => Actions,
+ Expression => New_Occurrence_Of (Result_Entity, Loc));
+ end Build_Interpolated_String_Image;
+
+ -- Local variables
+
+ Typ : constant Entity_Id := Etype (N);
+
+ -- Start of processing for Expand_N_Interpolated_String_Literal
+
+ begin
+ Rewrite (N, Build_Interpolated_String_Image (N));
+ Analyze_And_Resolve (N, Typ);
+ end Expand_N_Interpolated_String_Literal;
+
end Exp_Ch2;
diff --git a/gcc/ada/exp_ch2.ads b/gcc/ada/exp_ch2.ads
index 8845aa7a775..40df79c2a6e 100644
--- a/gcc/ada/exp_ch2.ads
+++ b/gcc/ada/exp_ch2.ads
@@ -28,8 +28,9 @@
with Types; use Types;
package Exp_Ch2 is
- procedure Expand_N_Expanded_Name (N : Node_Id);
- procedure Expand_N_Identifier (N : Node_Id);
- procedure Expand_N_Real_Literal (N : Node_Id);
+ procedure Expand_N_Expanded_Name (N : Node_Id);
+ procedure Expand_N_Identifier (N : Node_Id);
+ procedure Expand_N_Interpolated_String_Literal (N : Node_Id);
+ procedure Expand_N_Real_Literal (N : Node_Id);
end Exp_Ch2;
diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index eaedebe4001..9c2554fa1e9 100644
--- a/gcc/ada/exp_put_image.adb
+++ b/gcc/ada/exp_put_image.adb
@@ -338,7 +338,8 @@ package body Exp_Put_Image is
-- For other elementary types, generate:
--
- -- Wide_Wide_Put (Sink, U_Type'Wide_Wide_Image (Item));
+ -- Wide_Wide_Put (Root_Buffer_Type'Class (Sink),
+ -- U_Type'Wide_Wide_Image (Item));
--
-- It would be more elegant to do it the other way around (define
-- '[[Wide_]Wide_]Image in terms of 'Put_Image). But this is easier
@@ -362,13 +363,23 @@ package body Exp_Put_Image is
Prefix => New_Occurrence_Of (U_Type, Loc),
Attribute_Name => Name_Wide_Wide_Image,
Expressions => New_List (Relocate_Node (Item)));
+ Sink_Exp : constant Node_Id :=
+ Make_Type_Conversion (Loc,
+ Subtype_Mark =>
+ New_Occurrence_Of
+ (Class_Wide_Type (RTE (RE_Root_Buffer_Type)), Loc),
+ Expression => Relocate_Node (Sink));
Put_Call : constant Node_Id :=
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Wide_Wide_Put), Loc),
Parameter_Associations => New_List
- (Relocate_Node (Sink), Image));
+ (Sink_Exp, Image));
begin
+ -- We have built a dispatching call to handle calls to
+ -- descendants (since they are not available through rtsfind).
+ -- Further details available in the body of Put_String_Exp.
+
return Put_Call;
end;
end if;
@@ -427,12 +438,28 @@ package body Exp_Put_Image is
(Etype (Next_Formal (First_Formal (Libent))),
Relocate_Node (Item));
begin
- return
- Make_Procedure_Call_Statement (Loc,
- Name => New_Occurrence_Of (Libent, Loc),
- Parameter_Associations => New_List (
- Relocate_Node (Sink),
- Conv));
+ -- Do not output string delimiters if this is part of an
+ -- interpolated string literal.
+
+ if Nkind (Parent (N)) = N_Expression_With_Actions
+ and then Nkind (Original_Node (Parent (N)))
+ = N_Interpolated_String_Literal
+ then
+ return
+ Make_Procedure_Call_Statement (Loc,
+ Name => New_Occurrence_Of (Libent, Loc),
+ Parameter_Associations => New_List (
+ Relocate_Node (Sink),
+ Conv,
+ New_Occurrence_Of (Stand.Standard_False, Loc)));
+ else
+ return
+ Make_Procedure_Call_Statement (Loc,
+ Name => New_Occurrence_Of (Libent, Loc),
+ Parameter_Associations => New_List (
+ Relocate_Node (Sink),
+ Conv));
+ end if;
end;
end Build_String_Put_Image_Call;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index c8829cac85a..74cd99cade2 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -7913,6 +7913,7 @@ package body Exp_Util is
| N_Indexed_Component
| N_Integer_Literal
| N_Iterator_Specification
+ | N_Interpolated_String_Literal
| N_Itype_Reference
| N_Label
| N_Loop_Parameter_Specification
diff --git a/gcc/ada/expander.adb b/gcc/ada/expander.adb
index 13ec86967a2..4687cedc99d 100644
--- a/gcc/ada/expander.adb
+++ b/gcc/ada/expander.adb
@@ -515,6 +515,9 @@ package body Expander is
when N_Variant_Part =>
Expand_N_Variant_Part (N);
+ when N_Interpolated_String_Literal =>
+ Expand_N_Interpolated_String_Literal (N);
+
-- For all other node kinds, no expansion activity required
when others =>
diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb
index ec0eba74d06..fa73b6fecc1 100644
--- a/gcc/ada/gen_il-gen-gen_nodes.adb
+++ b/gcc/ada/gen_il-gen-gen_nodes.adb
@@ -441,6 +441,9 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sm (Has_Wide_Character, Flag),
Sm (Has_Wide_Wide_Character, Flag)));
+ Cc (N_Interpolated_String_Literal, N_Numeric_Or_String_Literal,
+ (Sy (Expressions, List_Id, Default_No_List)));
+
Cc (N_Explicit_Dereference, N_Subexpr,
(Sy (Prefix, Node_Id),
Sm (Actual_Designated_Subtype, Node_Id),
diff --git a/gcc/ada/gen_il-types.ads b/gcc/ada/gen_il-types.ads
index ca85ecf384c..8634a05cd4f 100644
--- a/gcc/ada/gen_il-types.ads
+++ b/gcc/ada/gen_il-types.ads
@@ -250,6 +250,7 @@ package Gen_IL.Types is
N_Expression_With_Actions,
N_If_Expression,
N_Indexed_Component,
+ N_Interpolated_String_Literal,
N_Null,
N_Qualified_Expression,
N_Quantified_Expression,
diff --git a/gcc/ada/libgnat/a-stbubo.adb b/gcc/ada/libgnat/a-stbubo.adb
index 3e941b89520..3f4bd90e31f 100644
--- a/gcc/ada/libgnat/a-stbubo.adb
+++ b/gcc/ada/libgnat/a-stbubo.adb
@@ -29,6 +29,7 @@
-- --
------------------------------------------------------------------------------
+with Ada.Characters.Handling;
with Ada.Strings.UTF_Encoding.Conversions;
with Ada.Strings.UTF_Encoding.Strings;
with Ada.Strings.UTF_Encoding.Wide_Strings;
@@ -91,9 +92,16 @@ package body Ada.Strings.Text_Buffers.Bounded is
-- forget to add corresponding assignment statement below.
Dummy : array (1 .. 0) of Buffer_Type (0) :=
[others =>
- (Max_Characters => 0, Chars => <>, Indentation => <>,
- Indent_Pending => <>, UTF_8_Length => <>, UTF_8_Column => <>,
- All_7_Bits => <>, All_8_Bits => <>, Truncated => <>)];
+ (Max_Characters => 0,
+ Chars => <>,
+ Indentation => <>,
+ Indent_Pending => <>,
+ UTF_8_Length => <>,
+ UTF_8_Column => <>,
+ Trim_Leading_White_Spaces => <>,
+ All_7_Bits => <>,
+ All_8_Bits => <>,
+ Truncated => <>)];
begin
Buffer.Indentation := Defaulted.Indentation;
Buffer.Indent_Pending := Defaulted.Indent_Pending;
@@ -131,7 +139,10 @@ package body Ada.Strings.Text_Buffers.Bounded is
return;
end if;
- Buffer.All_7_Bits := @ and then Character'Pos (Char) < 128;
+ Buffer.All_7_Bits :=
+ @ and then Character'Pos (Char) < 128;
+ Buffer.Trim_Leading_White_Spaces :=
+ @ and then Characters.Handling.Is_Space (Char);
Buffer.UTF_8_Length := @ + 1;
Buffer.UTF_8_Column := @ + 1;
diff --git a/gcc/ada/libgnat/a-stbuun.adb b/gcc/ada/libgnat/a-stbuun.adb
index eabcad1b628..54449fb9033 100644
--- a/gcc/ada/libgnat/a-stbuun.adb
+++ b/gcc/ada/libgnat/a-stbuun.adb
@@ -29,6 +29,7 @@
-- --
------------------------------------------------------------------------------
+with Ada.Characters.Handling;
with Ada.Unchecked_Deallocation;
with Ada.Strings.UTF_Encoding.Conversions;
with Ada.Strings.UTF_Encoding.Strings;
@@ -104,9 +105,15 @@ package body Ada.Strings.Text_Buffers.Unbounded is
-- forget to add corresponding assignment statement below.
Dummy : array (1 .. 0) of Buffer_Type :=
[others =>
- (Indentation => <>, Indent_Pending => <>, UTF_8_Length => <>,
- UTF_8_Column => <>, All_7_Bits => <>, All_8_Bits => <>,
- List => <>, Last_Used => <>)];
+ (Indentation => <>,
+ Indent_Pending => <>,
+ UTF_8_Length => <>,
+ UTF_8_Column => <>,
+ All_7_Bits => <>,
+ All_8_Bits => <>,
+ Trim_Leading_White_Spaces => <>,
+ List => <>,
+ Last_Used => <>)];
begin
Buffer.Indentation := Defaulted.Indentation;
Buffer.Indent_Pending := Defaulted.Indent_Pending;
@@ -140,28 +147,41 @@ package body Ada.Strings.Text_Buffers.Unbounded is
procedure Buffer_Type_Implementation (Buffer : in out Buffer_Type) is
begin
for Char of Item loop
- Buffer.All_7_Bits := @ and then Character'Pos (Char) < 128;
-
- if Buffer.Last_Used = Buffer.List.Current_Chunk.Length then
- -- Current chunk is full; allocate a new one with doubled size
-
- declare
- Cc : Chunk renames Buffer.List.Current_Chunk.all;
- Max : constant Positive := Integer'Last / 2;
- Length : constant Natural :=
- Integer'Min (Max, 2 * Cc.Length);
- begin
- pragma Assert (Cc.Next = null);
- Cc.Next := new Chunk (Length => Length);
- Buffer.List.Current_Chunk := Cc.Next;
- Buffer.Last_Used := 0;
- end;
- end if;
- Buffer.UTF_8_Length := @ + 1;
- Buffer.UTF_8_Column := @ + 1;
- Buffer.Last_Used := @ + 1;
- Buffer.List.Current_Chunk.Chars (Buffer.Last_Used) := Char;
+ -- The Trim_Leading_Space flag, which can be set prior to calling
+ -- any of the Put operations, which will cause white space
+ -- characters to be discarded by any Put operation until a
+ -- non-white-space character is encountered, at which point
+ -- the flag will be reset.
+
+ if not Buffer.Trim_Leading_White_Spaces
+ or else not Characters.Handling.Is_Space (Char)
+ then
+ Buffer.All_7_Bits := @ and then Character'Pos (Char) < 128;
+ Buffer.Trim_Leading_White_Spaces := False;
+
+ if Buffer.Last_Used = Buffer.List.Current_Chunk.Length then
+ -- Current chunk is full; allocate a new one with doubled
+ -- size
+
+ declare
+ Cc : Chunk renames Buffer.List.Current_Chunk.all;
+ Max : constant Positive := Integer'Last / 2;
+ Length : constant Natural :=
+ Integer'Min (Max, 2 * Cc.Length);
+ begin
+ pragma Assert (Cc.Next = null);
+ Cc.Next := new Chunk (Length => Length);
+ Buffer.List.Current_Chunk := Cc.Next;
+ Buffer.Last_Used := 0;
+ end;
+ end if;
+
+ Buffer.UTF_8_Length := @ + 1;
+ Buffer.UTF_8_Column := @ + 1;
+ Buffer.Last_Used := @ + 1;
+ Buffer.List.Current_Chunk.Chars (Buffer.Last_Used) := Char;
+ end if;
end loop;
end Buffer_Type_Implementation;
begin
diff --git a/gcc/ada/libgnat/a-sttebu.adb b/gcc/ada/libgnat/a-sttebu.adb
index acca2923443..182c1310bde 100644
--- a/gcc/ada/libgnat/a-sttebu.adb
+++ b/gcc/ada/libgnat/a-sttebu.adb
@@ -54,6 +54,19 @@ package body Ada.Strings.Text_Buffers is
Buffer.Indentation := @ - Natural (Amount);
end Decrease_Indent;
+ procedure Set_Trim_Leading_Spaces
+ (Buffer : in out Root_Buffer_Type;
+ Trim : Boolean := True) is
+ begin
+ Buffer.Trim_Leading_White_Spaces := Trim;
+ end Set_Trim_Leading_Spaces;
+
+ function Trim_Leading_Spaces
+ (Buffer : Root_Buffer_Type) return Boolean is
+ begin
+ return Buffer.Trim_Leading_White_Spaces;
+ end Trim_Leading_Spaces;
+
package body Output_Mapping is
-- Implement indentation in Put_UTF_8 and New_Line.
-- Implement other output procedures using Put_UTF_8.
@@ -91,7 +104,9 @@ package body Ada.Strings.Text_Buffers is
return;
end if;
- if Buffer.Indent_Pending then
+ if Buffer.Indent_Pending
+ and then not Buffer.Trim_Leading_White_Spaces
+ then
Buffer.Indent_Pending := False;
if Buffer.Indentation > 0 then
Put_UTF_8_Implementation
@@ -113,8 +128,9 @@ package body Ada.Strings.Text_Buffers is
begin
Buffer.Indent_Pending := False; -- just for a moment
Put (Buffer, [ASCII.LF]);
- Buffer.Indent_Pending := True;
- Buffer.UTF_8_Column := 1;
+ Buffer.Indent_Pending := True;
+ Buffer.UTF_8_Column := 1;
+ Buffer.Trim_Leading_White_Spaces := False;
end New_Line;
end Output_Mapping;
diff --git a/gcc/ada/libgnat/a-sttebu.ads b/gcc/ada/libgnat/a-sttebu.ads
index 39144a6b2fe..a97477dec5d 100644
--- a/gcc/ada/libgnat/a-sttebu.ads
+++ b/gcc/ada/libgnat/a-sttebu.ads
@@ -64,6 +64,16 @@ is
Post'Class => Current_Indent (Buffer) =
Current_Indent (Buffer)'Old - Amount;
+ procedure Set_Trim_Leading_Spaces
+ (Buffer : in out Root_Buffer_Type;
+ Trim : Boolean := True) with
+ Post => Trim_Leading_Spaces (Buffer) = Trim,
+ Inline => True;
+
+ function Trim_Leading_Spaces
+ (Buffer : Root_Buffer_Type) return Boolean
+ with Inline;
+
private
type Root_Buffer_Type is abstract tagged limited record
@@ -85,6 +95,12 @@ private
All_8_Bits : Boolean := True;
-- True if all characters seen so far fit in 8 bits
+ Trim_Leading_White_Spaces : Boolean := False;
+ -- Flag set prior to calling any of the Put operations, which will
+ -- cause white space characters to be discarded by any Put operation
+ -- until a non-white-space character is encountered, at which point
+ -- the flag will be reset.
+
end record;
generic
diff --git a/gcc/ada/libgnat/s-putima.adb b/gcc/ada/libgnat/s-putima.adb
index 10d8b8475ea..d3261fd389a 100644
--- a/gcc/ada/libgnat/s-putima.adb
+++ b/gcc/ada/libgnat/s-putima.adb
@@ -174,41 +174,67 @@ package body System.Put_Images is
Thin_Instance (S, X, "access protected subprogram");
end Put_Image_Access_Prot_Subp;
- procedure Put_Image_String (S : in out Sink'Class; X : String) is
+ procedure Put_Image_String
+ (S : in out Sink'Class;
+ X : String;
+ With_Delimiters : Boolean := True) is
begin
- Put_UTF_8 (S, """");
+ if With_Delimiters then
+ Put_UTF_8 (S, """");
+ end if;
+
for C of X loop
- if C = '"' then
+ if C = '"' and then With_Delimiters then
Put_UTF_8 (S, """");
end if;
Put_Character (S, C);
end loop;
- Put_UTF_8 (S, """");
+
+ if With_Delimiters then
+ Put_UTF_8 (S, """");
+ end if;
end Put_Image_String;
- procedure Put_Image_Wide_String (S : in out Sink'Class; X : Wide_String) is
+ procedure Put_Image_Wide_String
+ (S : in out Sink'Class;
+ X : Wide_String;
+ With_Delimiters : Boolean := True) is
begin
- Put_UTF_8 (S, """");
+ if With_Delimiters then
+ Put_UTF_8 (S, """");
+ end if;
+
for C of X loop
- if C = '"' then
+ if C = '"' and then With_Delimiters then
Put_UTF_8 (S, """");
end if;
Put_Wide_Character (S, C);
end loop;
- Put_UTF_8 (S, """");
+
+ if With_Delimiters then
+ Put_UTF_8 (S, """");
+ end if;
end Put_Image_Wide_String;
procedure Put_Image_Wide_Wide_String
- (S : in out Sink'Class; X : Wide_Wide_String) is
+ (S : in out Sink'Class;
+ X : Wide_Wide_String;
+ With_Delimiters : Boolean := True) is
begin
- Put_UTF_8 (S, """");
+ if With_Delimiters then
+ Put_UTF_8 (S, """");
+ end if;
+
for C of X loop
- if C = '"' then
+ if C = '"' and then With_Delimiters then
Put_UTF_8 (S, """");
end if;
Put_Wide_Wide_Character (S, C);
end loop;
- Put_UTF_8 (S, """");
+
+ if With_Delimiters then
+ Put_UTF_8 (S, """");
+ end if;
end Put_Image_Wide_Wide_String;
procedure Array_Before (S : in out Sink'Class) is
diff --git a/gcc/ada/libgnat/s-putima.ads b/gcc/ada/libgnat/s-putima.ads
index b51e6a90e46..1bcec3113d8 100644
--- a/gcc/ada/libgnat/s-putima.ads
+++ b/gcc/ada/libgnat/s-putima.ads
@@ -84,10 +84,20 @@ package System.Put_Images with Pure is
(S : in out Sink'Class; X : Thin_Pointer);
-- For access-to-protected-subprogram types
- procedure Put_Image_String (S : in out Sink'Class; X : String);
- procedure Put_Image_Wide_String (S : in out Sink'Class; X : Wide_String);
+ procedure Put_Image_String
+ (S : in out Sink'Class;
+ X : String;
+ With_Delimiters : Boolean := True);
+
+ procedure Put_Image_Wide_String
+ (S : in out Sink'Class;
+ X : Wide_String;
+ With_Delimiters : Boolean := True);
+
procedure Put_Image_Wide_Wide_String
- (S : in out Sink'Class; X : Wide_Wide_String);
+ (S : in out Sink'Class;
+ X : Wide_Wide_String;
+ With_Delimiters : Boolean := True);
procedure Array_Before (S : in out Sink'Class);
procedure Array_Between (S : in out Sink'Class);
diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb
index 060bb410978..3d369baa760 100644
--- a/gcc/ada/par-ch2.adb
+++ b/gcc/ada/par-ch2.adb
@@ -199,6 +199,79 @@ package body Ch2 is
-- Handled by scanner as part of string literal handling (see 2.4)
+ ---------------------------------------
+ -- 2.6 Interpolated String Literal --
+ ---------------------------------------
+
+ -- INTERPOLATED_STRING_LITERAL ::=
+ -- 'f' "{INTERPOLATED_STRING_ELEMENT}" {
+ -- "{INTERPOLATED_STRING_ELEMENT}" }
+
+ -- INTERPOLATED_STRING_ELEMENT ::=
+ -- ESCAPED_CHARACTER | INTERPOLATED_EXPRESSION
+ -- | non_quotation_mark_non_left_brace_GRAPHIC_CHARACTER
+
+ -- ESCAPED_CHARACTER ::= '\GRAPHIC_CHARACTER'
+
+ -- INTERPOLATED_EXPRESSION ::= '{' EXPRESSION '}'
+
+ -- Interpolated string element and escaped character rules are handled by
+ -- scanner as part of string literal handling.
+
+ -----------------------------------
+ -- P_Interpolated_String_Literal --
+ -----------------------------------
+
+ function P_Interpolated_String_Literal return Node_Id is
+ Elements_List : constant List_Id := New_List;
+ NL_Node : Node_Id;
+ String_Node : Node_Id;
+
+ begin
+ String_Node := New_Node (N_Interpolated_String_Literal, Token_Ptr);
+ Inside_Interpolated_String_Literal := True;
+
+ Scan; -- past 'f'
+
+ if Token /= Tok_String_Literal then
+ Error_Msg_SC ("string literal expected");
+
+ else
+ Append_To (Elements_List, Token_Node);
+ Scan; -- past string_literal
+
+ while Token in Tok_Left_Curly_Bracket | Tok_String_Literal loop
+
+ -- Interpolated expression
+
+ if Token = Tok_Left_Curly_Bracket then
+ Scan; -- past '{'
+ Append_To (Elements_List, P_Expression);
+ T_Right_Curly_Bracket;
+ else
+ if Prev_Token = Tok_String_Literal then
+ NL_Node := New_Node (N_String_Literal, Token_Ptr);
+ Set_Has_Wide_Character (NL_Node, False);
+ Set_Has_Wide_Wide_Character (NL_Node, False);
+
+ Start_String;
+ Store_String_Char (Get_Char_Code (ASCII.LF));
+ Set_Strval (NL_Node, End_String);
+ Append_To (Elements_List, NL_Node);
+ end if;
+
+ Append_To (Elements_List, Token_Node);
+ Scan; -- past string_literal
+ end if;
+ end loop;
+ end if;
+
+ Inside_Interpolated_String_Literal := False;
+ Set_Expressions (String_Node, Elements_List);
+
+ return String_Node;
+ end P_Interpolated_String_Literal;
+
------------------
-- 2.7 Comment --
------------------
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index 82b09b29bea..f5a34ec7e9f 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -2319,6 +2319,14 @@ package body Ch4 is
if Token in Token_Class_Sterm then
null;
+ -- Handle '}' as expression terminator of an interpolated
+ -- expression.
+
+ elsif Inside_Interpolated_String_Literal
+ and then Token = Tok_Right_Curly_Bracket
+ then
+ null;
+
-- If we do not have an expression terminator, then complete the
-- scan of a simple expression. This code duplicates the code
-- found in P_Term and P_Factor.
@@ -2557,8 +2565,13 @@ package body Ch4 is
-- an expression terminator, and is not in Token_Class_Sterm, but
-- in this special case we know that the expression is complete.
+ -- We disable this error recovery machinery when we are processing an
+ -- interpolated string and we reach the expression terminator '}'.
+
if not Token_Is_At_Start_Of_Line
and then Token not in Token_Class_Sterm
+ and then not (Inside_Interpolated_String_Literal
+ and then Token = Tok_Right_Curly_Bracket)
then
-- Normally the right error message is indeed that we expected a
-- binary operator, but in the case of being between a right and left
@@ -2851,6 +2864,9 @@ package body Ch4 is
when Tok_Left_Bracket =>
return P_Aggregate;
+ when Tok_Left_Interpolated_String =>
+ return P_Interpolated_String_Literal;
+
-- Allocator
when Tok_New =>
diff --git a/gcc/ada/par-tchk.adb b/gcc/ada/par-tchk.adb
index 3989cd25015..24ab75b1229 100644
--- a/gcc/ada/par-tchk.adb
+++ b/gcc/ada/par-tchk.adb
@@ -402,6 +402,20 @@ package body Tchk is
Check_Token (Tok_Record, AP);
end T_Record;
+ ---------------------------
+ -- T_Right_Curly_Bracket --
+ ---------------------------
+
+ procedure T_Right_Curly_Bracket is
+ begin
+ if Token = Tok_Right_Curly_Bracket then
+ Scan;
+ else
+ Error_Msg_AP
+ ("|missing ""'}'""");
+ end if;
+ end T_Right_Curly_Bracket;
+
---------------------
-- T_Right_Bracket --
---------------------
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index 01e3c4b1a4f..5fbdbbd02eb 100644
--- a/gcc/ada/par.adb
+++ b/gcc/ada/par.adb
@@ -48,6 +48,7 @@ with Sinfo; use Sinfo;
with Sinfo.Nodes; use Sinfo.Nodes;
with Sinfo.Utils; use Sinfo.Utils;
with Snames; use Snames;
+with Stringt; use Stringt;
with Style;
with Stylesw; use Stylesw;
with Table;
@@ -652,6 +653,8 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
-- if either this is the first occurrence of misuse of this identifier,
-- or if Force_Msg is True.
+ function P_Interpolated_String_Literal return Node_Id;
+
function P_Pragmas_Opt return List_Id;
-- This function scans for a sequence of pragmas in other than a
-- declaration sequence or statement sequence context. All pragmas
@@ -1238,6 +1241,7 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
procedure T_Range;
procedure T_Record;
procedure T_Right_Bracket;
+ procedure T_Right_Curly_Bracket;
procedure T_Right_Paren;
procedure T_Semicolon;
procedure T_Then;
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index ce49e2df149..86dbb622d64 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -605,6 +605,7 @@ package Rtsfind is
RE_Root_Buffer_Type, -- Ada.Strings.Text_Buffers
RE_Put_UTF_8, -- Ada.Strings.Text_Buffers
+ RE_Set_Trim_Leading_Spaces, -- Ada.Strings.Text_Buffers
RE_Wide_Wide_Put, -- Ada.Strings.Text_Buffers
RE_Buffer_Type, -- Ada.Strings.Text_Buffers.Unbounded
@@ -2243,6 +2244,7 @@ package Rtsfind is
RE_Root_Buffer_Type => Ada_Strings_Text_Buffers,
RE_Put_UTF_8 => Ada_Strings_Text_Buffers,
+ RE_Set_Trim_Leading_Spaces => Ada_Strings_Text_Buffers,
RE_Wide_Wide_Put => Ada_Strings_Text_Buffers,
RE_Buffer_Type => Ada_Strings_Text_Buffers_Unbounded,
diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads
index ddb4c3efb72..c59ff189048 100644
--- a/gcc/ada/scans.ads
+++ b/gcc/ada/scans.ads
@@ -84,12 +84,19 @@ package Scans is
-- Ada 2022 introduces square brackets as delimiters for array and
-- container aggregates.
- Tok_Raise, -- RAISE
+ -- The left delimiter token of interpolated strings, and tokens { and }
+ -- of interpolated expressions are currently placed in no category since
+ -- they don't fit well in the existing categories.
+
+ Tok_Left_Interpolated_String, -- f"
+ Tok_Left_Curly_Bracket, -- {
+ Tok_Raise, -- RAISE
+ Tok_Right_Curly_Bracket, -- }
Tok_Dot, -- . Namext
Tok_Apostrophe, -- ' Namext
- Tok_Left_Bracket, -- [ Namest
+ Tok_Left_Bracket, -- [ Namext
Tok_Left_Paren, -- ( Namext, Consk
Tok_Delta, -- DELTA Atkwd, Sterm, Consk
@@ -475,6 +482,9 @@ package Scans is
-- or aspect. Used to allow/require nonstandard style rules for =>+ with
-- -gnatyt.
+ Inside_Interpolated_String_Literal : Boolean := False;
+ -- True while parsing an interpolated string literal
+
Inside_If_Expression : Nat := 0;
-- This is a counter that is set non-zero while scanning out an if
-- expression (incremented on entry, decremented on exit). It is used to
diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb
index b6698a67363..0ee71fbf043 100644
--- a/gcc/ada/scng.adb
+++ b/gcc/ada/scng.adb
@@ -1077,8 +1077,20 @@ package body Scng is
String_Start := Scan_Ptr;
- Delimiter := Source (Scan_Ptr);
- Accumulate_Checksum (Delimiter);
+ -- Continuation of interpolated string literal
+
+ if Inside_Interpolated_String_Literal
+ and then Prev_Token = Tok_Right_Curly_Bracket
+ then
+ Scan_Ptr := Scan_Ptr - 1;
+ Delimiter := '"';
+
+ -- Common case
+
+ else
+ Delimiter := Source (Scan_Ptr);
+ Accumulate_Checksum (Delimiter);
+ end if;
Start_String;
Wide_Character_Found := False;
@@ -1094,6 +1106,15 @@ package body Scng is
Accumulate_Checksum (C);
Scan_Ptr := Scan_Ptr + 1;
exit when Source (Scan_Ptr) /= Delimiter;
+
+ -- Unlike normal string literals, doubled delimiter has no
+ -- special significance in interpolated string literals.
+
+ if Inside_Interpolated_String_Literal then
+ Error_Msg_S
+ ("double quotations not allowed in interpolated string");
+ end if;
+
Code := Get_Char_Code (C);
Accumulate_Checksum (C);
Scan_Ptr := Scan_Ptr + 1;
@@ -1105,6 +1126,40 @@ package body Scng is
Code := Get_Char_Code (C);
Scan_Ptr := Scan_Ptr + 1;
+ -- Found interpolated expression
+
+ elsif Inside_Interpolated_String_Literal
+ and then C = '{'
+ then
+ Accumulate_Checksum (C);
+ exit;
+
+ -- Escaped character in interpolated string literal
+
+ elsif Inside_Interpolated_String_Literal
+ and then C = '\'
+ then
+ Accumulate_Checksum (C);
+ Scan_Ptr := Scan_Ptr + 1;
+ C := Source (Scan_Ptr);
+ Accumulate_Checksum (C);
+ Scan_Ptr := Scan_Ptr + 1;
+
+ case C is
+ when 'a' => Code := Get_Char_Code (ASCII.BEL);
+ when 'b' => Code := Get_Char_Code (ASCII.BS);
+ when 'f' => Code := Get_Char_Code (ASCII.FF);
+ when 'n' => Code := Get_Char_Code (ASCII.LF);
+ when 'r' => Code := Get_Char_Code (ASCII.CR);
+ when 't' => Code := Get_Char_Code (ASCII.HT);
+ when 'v' => Code := Get_Char_Code (ASCII.VT);
+ when '0' => Code := Get_Char_Code (ASCII.NUL);
+ when '\' | '"' | '{' | '}'
+ => Code := Get_Char_Code (C);
+ when others =>
+ Error_Msg_S ("illegal escaped character");
+ end case;
+
elsif Start_Of_Wide_Character then
Wptr := Scan_Ptr;
Scan_Wide (Source, Scan_Ptr, Code, Err);
@@ -1234,6 +1289,29 @@ package body Scng is
Prev_Token_Ptr := Token_Ptr;
Token_Name := Error_Name;
+ if Inside_Interpolated_String_Literal
+ and then Prev_Token = Tok_Right_Curly_Bracket
+ then
+ -- Consecutive interpolated expressions
+
+ if Source (Scan_Ptr) = '{' then
+ null;
+
+ -- Ending delimiter placed immediately after interpolated expression
+
+ elsif Source (Scan_Ptr) = '"' then
+ Scan_Ptr := Scan_Ptr + 1;
+ Prev_Token := Tok_String_Literal;
+
+ -- String literal placed after interpolated expression
+
+ else
+ Slit;
+ Post_Scan;
+ return;
+ end if;
+ end if;
+
-- The following loop runs more than once only if a format effector
-- (tab, vertical tab, form feed, line feed, carriage return) is
-- encountered and skipped, or some error situation, such as an
@@ -1448,12 +1526,20 @@ package body Scng is
return;
end if;
- -- Left brace
+ -- Left curly bracket, treated as right paren but proper delimiter
+ -- of interpolated string literals when all extensions are allowed.
when '{' =>
- Error_Msg_S ("illegal character, replaced by ""(""");
- Scan_Ptr := Scan_Ptr + 1;
- Token := Tok_Left_Paren;
+ if All_Extensions_Allowed then
+ Scan_Ptr := Scan_Ptr + 1;
+ Token := Tok_Left_Curly_Bracket;
+
+ else
+ Error_Msg_S ("illegal character, replaced by ""(""");
+ Scan_Ptr := Scan_Ptr + 1;
+ Token := Tok_Left_Paren;
+ end if;
+
return;
-- Comma
@@ -1863,7 +1949,7 @@ package body Scng is
-- Right bracket or right brace, treated as right paren but proper
-- aggregate delimiter in Ada 2022.
- when ']' | '}' =>
+ when ']' =>
if Ada_Version >= Ada_2022 then
Token := Tok_Right_Bracket;
@@ -1875,6 +1961,21 @@ package body Scng is
Scan_Ptr := Scan_Ptr + 1;
return;
+ -- Right curly bracket, treated as right paren but proper delimiter
+ -- of interpolated string literals when all extensions are allowed.
+
+ when '}' =>
+ if All_Extensions_Allowed then
+ Token := Tok_Right_Curly_Bracket;
+
+ else
+ Error_Msg_S ("illegal character, replaced by "")""");
+ Token := Tok_Right_Paren;
+ end if;
+
+ Scan_Ptr := Scan_Ptr + 1;
+ return;
+
-- Slash (can be division operator or first character of not equal)
when '/' =>
@@ -2024,6 +2125,16 @@ package body Scng is
-- Lower case letters
when 'a' .. 'z' =>
+ if All_Extensions_Allowed
+ and then Source (Scan_Ptr) = 'f'
+ and then Source (Scan_Ptr + 1) = '"'
+ then
+ Scan_Ptr := Scan_Ptr + 1;
+ Accumulate_Checksum (Source (Scan_Ptr));
+ Token := Tok_Left_Interpolated_String;
+ return;
+ end if;
+
Name_Len := 1;
Underline_Found := False;
Name_Buffer (1) := Source (Scan_Ptr);
@@ -2034,6 +2145,17 @@ package body Scng is
-- Upper case letters
when 'A' .. 'Z' =>
+ if All_Extensions_Allowed
+ and then Source (Scan_Ptr) = 'F'
+ and then Source (Scan_Ptr + 1) = '"'
+ then
+ Error_Msg_S
+ ("delimiter of interpolated string must be in lowercase");
+ Scan_Ptr := Scan_Ptr + 1;
+ Token := Tok_Left_Interpolated_String;
+ return;
+ end if;
+
Token_Contains_Uppercase := True;
Name_Len := 1;
Underline_Found := False;
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 6c1e9d7eb01..42dca131ddc 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -557,6 +557,9 @@ package body Sem is
when N_String_Literal =>
Analyze_String_Literal (N);
+ when N_Interpolated_String_Literal =>
+ Analyze_Interpolated_String_Literal (N);
+
when N_Subprogram_Body =>
Analyze_Subprogram_Body (N);
diff --git a/gcc/ada/sem_ch2.adb b/gcc/ada/sem_ch2.adb
index 6b84af4ceda..69a65c481be 100644
--- a/gcc/ada/sem_ch2.adb
+++ b/gcc/ada/sem_ch2.adb
@@ -28,9 +28,11 @@ with Einfo; use Einfo;
with Einfo.Utils; use Einfo.Utils;
with Ghost; use Ghost;
with Namet; use Namet;
+with Nlists; use Nlists;
with Opt; use Opt;
with Restrict; use Restrict;
with Rident; use Rident;
+with Sem; use Sem;
with Sem_Ch8; use Sem_Ch8;
with Sem_Dim; use Sem_Dim;
with Sinfo; use Sinfo;
@@ -119,6 +121,23 @@ package body Sem_Ch2 is
Set_Is_Static_Expression (N);
end Analyze_Integer_Literal;
+ -----------------------------------------
+ -- Analyze_Interpolated_String_Literal --
+ -----------------------------------------
+
+ procedure Analyze_Interpolated_String_Literal (N : Node_Id) is
+ Str_Elem : Node_Id;
+
+ begin
+ Set_Etype (N, Any_String);
+
+ Str_Elem := First (Expressions (N));
+ while Present (Str_Elem) loop
+ Analyze (Str_Elem);
+ Next (Str_Elem);
+ end loop;
+ end Analyze_Interpolated_String_Literal;
+
--------------------------
-- Analyze_Real_Literal --
--------------------------
diff --git a/gcc/ada/sem_ch2.ads b/gcc/ada/sem_ch2.ads
index a199fef3072..fb64a334992 100644
--- a/gcc/ada/sem_ch2.ads
+++ b/gcc/ada/sem_ch2.ads
@@ -27,11 +27,12 @@ with Types; use Types;
package Sem_Ch2 is
- procedure Analyze_Character_Literal (N : Node_Id);
- procedure Analyze_Identifier (N : Node_Id);
- procedure Analyze_Integer_Literal (N : Node_Id);
- procedure Analyze_Real_Literal (N : Node_Id);
- procedure Analyze_String_Literal (N : Node_Id);
+ procedure Analyze_Character_Literal (N : Node_Id);
+ procedure Analyze_Identifier (N : Node_Id);
+ procedure Analyze_Integer_Literal (N : Node_Id);
+ procedure Analyze_Interpolated_String_Literal (N : Node_Id);
+ procedure Analyze_Real_Literal (N : Node_Id);
+ procedure Analyze_String_Literal (N : Node_Id);
private
pragma Inline (Analyze_Character_Literal);
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 348d272a399..9fcbba7384e 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -212,6 +212,9 @@ package body Sem_Res is
procedure Resolve_Generalized_Indexing (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Indexed_Component (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Integer_Literal (N : Node_Id; Typ : Entity_Id);
+ procedure Resolve_Interpolated_String_Literal
+ (N : Node_Id;
+ Typ : Entity_Id);
procedure Resolve_Logical_Op (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Membership_Op (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Null (N : Node_Id; Typ : Entity_Id);
@@ -449,9 +452,10 @@ package body Sem_Res is
Loc : constant Source_Ptr := Sloc (N);
Literal_Aspect_Map :
constant array (N_Numeric_Or_String_Literal) of Aspect_Id :=
- (N_Integer_Literal => Aspect_Integer_Literal,
- N_Real_Literal => Aspect_Real_Literal,
- N_String_Literal => Aspect_String_Literal);
+ (N_Integer_Literal => Aspect_Integer_Literal,
+ N_Interpolated_String_Literal => No_Aspect,
+ N_Real_Literal => Aspect_Real_Literal,
+ N_String_Literal => Aspect_String_Literal);
Named_Number_Aspect_Map : constant array (Named_Kind) of Aspect_Id :=
(E_Named_Integer => Aspect_Integer_Literal,
@@ -3437,6 +3441,9 @@ package body Sem_Res is
when N_String_Literal =>
Resolve_String_Literal (N, Ctx_Type);
+ when N_Interpolated_String_Literal =>
+ Resolve_Interpolated_String_Literal (N, Ctx_Type);
+
when N_Target_Name =>
Resolve_Target_Name (N, Ctx_Type);
@@ -9672,6 +9679,35 @@ package body Sem_Res is
Eval_Integer_Literal (N);
end Resolve_Integer_Literal;
+ -----------------------------------------
+ -- Resolve_Interpolated_String_Literal --
+ -----------------------------------------
+
+ procedure Resolve_Interpolated_String_Literal (N : Node_Id; Typ : Entity_Id)
+ is
+ Str_Elem : Node_Id;
+
+ begin
+ Str_Elem := First (Expressions (N));
+ pragma Assert (Nkind (Str_Elem) = N_String_Literal);
+
+ while Present (Str_Elem) loop
+
+ -- Resolve string elements using the context type; for interpolated
+ -- expressions there is no need to check if their type has a suitable
+ -- image function because under Ada 2022 all the types have such
+ -- function available.
+
+ if Etype (Str_Elem) = Any_String then
+ Resolve (Str_Elem, Typ);
+ end if;
+
+ Next (Str_Elem);
+ end loop;
+
+ Set_Etype (N, Typ);
+ end Resolve_Interpolated_String_Literal;
+
--------------------------------
-- Resolve_Intrinsic_Operator --
--------------------------------
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index a05ac74d35f..934979e17ab 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -20785,9 +20785,10 @@ package body Sem_Util is
is
Literal_Aspect_Map :
constant array (N_Numeric_Or_String_Literal) of Aspect_Id :=
- (N_Integer_Literal => Aspect_Integer_Literal,
- N_Real_Literal => Aspect_Real_Literal,
- N_String_Literal => Aspect_String_Literal);
+ (N_Integer_Literal => Aspect_Integer_Literal,
+ N_Interpolated_String_Literal => No_Aspect,
+ N_Real_Literal => Aspect_Real_Literal,
+ N_String_Literal => Aspect_String_Literal);
begin
-- Return True when N is either a literal or a named number and the
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 104ee663c0e..722e6d4e929 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -2618,6 +2618,33 @@ package Sinfo is
-- Is_Folded_In_Parser
-- plus fields for expression
+ ---------------------------------------
+ -- 2.6 Interpolated String Literal --
+ ---------------------------------------
+
+ -- INTERPOLATED_STRING_LITERAL ::=
+ -- '{' "{INTERPOLATED_STRING_ELEMENT}" {
+ -- "{INTERPOLATED_STRING_ELEMENT}" } '}'
+
+ -- INTERPOLATED_STRING_ELEMENT ::=
+ -- ESCAPED_CHARACTER | INTERPOLATED_EXPRESSION
+ -- | non_quotation_mark_non_left_brace_GRAPHIC_CHARACTER
+
+ -- ESCAPED_CHARACTER ::= '\GRAPHIC_CHARACTER'
+
+ -- INTERPOLATED_EXPRESSION ::= '{' EXPRESSION '}'
+
+ -- Most of these syntax rules are omitted as tree nodes to simplify
+ -- semantic processing. The scanner handles escaped characters as part
+ -- of processing an interpolated string literal, and the parser stores
+ -- in the Expressions field of this node a list containing the sequence
+ -- of string literals and the roots of the interpolated expressions.
+
+ -- N_Interpolated_String_Literal
+ -- Sloc points to literal
+ -- Expressions
+ -- plus fields for expression
+
------------------
-- 2.7 Comment --
------------------
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index 0f292c870b8..19a9a43c426 100644
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -3313,6 +3313,38 @@ package body Sprint is
Set_Debug_Sloc;
Write_String_Table_Entry (Strval (Node));
+ when N_Interpolated_String_Literal =>
+ Write_Char ('{');
+
+ declare
+ Str_Elem : Node_Id := First (Expressions (Node));
+ Is_First : Boolean := True;
+
+ begin
+ while Present (Str_Elem) loop
+ if not Is_First then
+ Write_Str (" & ");
+ end if;
+
+ if Nkind (Str_Elem) = N_String_Literal then
+ Sprint_Node (Str_Elem);
+
+ else
+ Write_Char ('"');
+ Write_Char ('{');
+ Sprint_Node (Str_Elem);
+ Write_Char ('}');
+ Write_Char ('"');
+ end if;
+
+ Is_First := False;
+
+ Next (Str_Elem);
+ end loop;
+ end;
+
+ Write_Char ('}');
+
when N_Subprogram_Body =>
-- Output extra blank line unless we are in freeze actions
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-01-05 14:38 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-01-05 14:38 [gcc r13-5021] ada: INOX: prototype RFC on String Interpolation Marc Poulhi?s
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).