From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 7871) id DDEAF385841A; Thu, 5 Jan 2023 14:38:50 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org DDEAF385841A DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1672929530; bh=2h1JbvKX198qeAFh8SWn+mCnihzkT+bnUpCfiTMEyfk=; h=From:To:Subject:Date:From; b=lrhpi0qoW3ECxvcmoTcBaj+gdG2+QBIJDvvBZYbHbqCWxZrw8mGEJk8+hAUidgGja hrP1kvoB4i35/4bg00ZAtvyxnVSul2b2YQOnCYTGTV1x+X5jFajj6gqEj+eFt8IZ0U tswAqtlKxeAz3ufgerPsuEUKmQ6WAaXYUcUme8WM= MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Marc Poulhi?s To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-5021] ada: INOX: prototype RFC on String Interpolation X-Act-Checkin: gcc X-Git-Author: Javier Miranda X-Git-Refname: refs/heads/master X-Git-Oldrev: e45bef1ec6712be5c4566fd0782d58d4b70b3787 X-Git-Newrev: 9ef547a7a99522db8f0f028bde8febc8f1ad8bb8 Message-Id: <20230105143850.DDEAF385841A@sourceware.org> Date: Thu, 5 Jan 2023 14:38:50 +0000 (GMT) List-Id: https://gcc.gnu.org/g:9ef547a7a99522db8f0f028bde8febc8f1ad8bb8 commit r13-5021-g9ef547a7a99522db8f0f028bde8febc8f1ad8bb8 Author: Javier Miranda 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