New Language: Ada

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@45956 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 943 insertions, 0 deletions

diff --git a/gcc/ada/prj-strt.adb b/gcc/ada/prj-strt.adb
new file mode 100644
index 00000000000..790c632c2cf
--- /dev/null
+++ b/gcc/ada/prj-strt.adb
@@ -0,0 +1,943 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             P R J . S T R T                              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision: 1.12 $
+--                                                                          --
+--             Copyright (C) 2001 Free Software Foundation, Inc.            --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Errout;    use Errout;
+with Prj.Attr;  use Prj.Attr;
+with Prj.Tree;  use Prj.Tree;
+with Scans;     use Scans;
+with Sinfo;     use Sinfo;
+with Stringt;   use Stringt;
+with Table;
+with Types;     use Types;
+
+package body Prj.Strt is
+
+   Initial_Size : constant := 8;
+
+   type Name_Location is record
+      Name     : Name_Id := No_Name;
+      Location : Source_Ptr := No_Location;
+   end record;
+   --  Store the identifier and the location of a simple name
+
+   type Name_Range is range 0 .. 3;
+   subtype Name_Index is Name_Range range 1 .. Name_Range'Last;
+   --  A Name may contain up to 3 simple names
+
+   type Names is array (Name_Index) of Name_Location;
+   --  Used to store 1 to 3 simple_names. 2 simple names are for
+   --  <project>.<package>, <project>.<variable> or <package>.<variable>.
+   --  3 simple names are for <project>.<package>.<variable>.
+
+   type Choice_String is record
+      The_String : String_Id;
+      Already_Used : Boolean := False;
+   end record;
+   --  The string of a case label, and an indication that it has already
+   --  been used (to avoid duplicate case labels).
+
+   Choices_Initial   : constant := 10;
+   Choices_Increment : constant := 10;
+
+   Choice_Node_Low_Bound  : constant := 0;
+   Choice_Node_High_Bound : constant := 099_999_999; --  In practice, infinite
+
+   type Choice_Node_Id is
+     range Choice_Node_Low_Bound .. Choice_Node_High_Bound;
+
+   First_Choice_Node_Id : constant Choice_Node_Id :=
+     Choice_Node_Low_Bound;
+
+   Empty_Choice : constant Choice_Node_Id :=
+     Choice_Node_Low_Bound;
+
+   First_Choice_Id : constant Choice_Node_Id := First_Choice_Node_Id + 1;
+
+   package Choices is
+      new Table.Table (Table_Component_Type => Choice_String,
+                       Table_Index_Type     => Choice_Node_Id,
+                       Table_Low_Bound      => First_Choice_Node_Id,
+                       Table_Initial        => Choices_Initial,
+                       Table_Increment      => Choices_Increment,
+                       Table_Name           => "Prj.Strt.Choices");
+   --  Used to store the case labels and check that there is no duplicate.
+
+   package Choice_Lasts is
+      new Table.Table (Table_Component_Type => Choice_Node_Id,
+                       Table_Index_Type     => Nat,
+                       Table_Low_Bound      => 1,
+                       Table_Initial        => 3,
+                       Table_Increment      => 3,
+                       Table_Name           => "Prj.Strt.Choice_Lasts");
+   --  Used to store the indices of the choices in table Choices,
+   --  to distinguish nested case constructions.
+
+   Choice_First : Choice_Node_Id := 0;
+   --  Index in table Choices of the first case label of the current
+   --  case construction.
+   --  0 means no current case construction.
+
+   procedure Add (This_String : String_Id);
+   --  Add a string to the case label list, indicating that it has not
+   --  yet been used.
+
+   procedure External_Reference (External_Value : out Project_Node_Id);
+   --  Parse an external reference. Current token is "external".
+
+   procedure Attribute_Reference
+     (Reference       : out Project_Node_Id;
+      First_Attribute : Attribute_Node_Id;
+      Current_Project : Project_Node_Id;
+      Current_Package : Project_Node_Id);
+   --  Parse an attribute reference. Current token is an apostrophe.
+
+   procedure Terms
+     (Term            : out Project_Node_Id;
+      Expr_Kind       : in out Variable_Kind;
+      Current_Project : Project_Node_Id;
+      Current_Package : Project_Node_Id);
+   --  Recursive procedure to parse one term or several terms concatenated
+   --  using "&".
+
+   ---------
+   -- Add --
+   ---------
+
+   procedure Add (This_String : String_Id) is
+   begin
+      Choices.Increment_Last;
+      Choices.Table (Choices.Last) :=
+        (The_String   => This_String,
+         Already_Used => False);
+   end Add;
+
+   -------------------------
+   -- Attribute_Reference --
+   -------------------------
+
+   procedure Attribute_Reference
+     (Reference       : out Project_Node_Id;
+      First_Attribute : Attribute_Node_Id;
+      Current_Project : Project_Node_Id;
+      Current_Package : Project_Node_Id)
+   is
+      Current_Attribute : Attribute_Node_Id := First_Attribute;
+
+   begin
+      Reference :=  Default_Project_Node (Of_Kind => N_Attribute_Reference);
+      Set_Location_Of (Reference, To => Token_Ptr);
+      Scan; -- past apostrophe
+      Expect (Tok_Identifier, "Identifier");
+
+      if Token = Tok_Identifier then
+         Set_Name_Of (Reference, To => Token_Name);
+
+         while Current_Attribute /= Empty_Attribute
+           and then
+             Attributes.Table (Current_Attribute).Name /= Token_Name
+         loop
+            Current_Attribute := Attributes.Table (Current_Attribute).Next;
+         end loop;
+
+         if Current_Attribute = Empty_Attribute then
+            Error_Msg ("unknown attribute", Token_Ptr);
+            Reference := Empty_Node;
+
+         elsif
+           Attributes.Table (Current_Attribute).Kind_2 = Associative_Array
+         then
+            Error_Msg
+              ("associative array attribute cannot be referenced",
+               Token_Ptr);
+            Reference := Empty_Node;
+
+         else
+            Set_Project_Node_Of (Reference, To => Current_Project);
+            Set_Package_Node_Of (Reference, To => Current_Package);
+            Set_Expression_Kind_Of
+              (Reference, To => Attributes.Table (Current_Attribute).Kind_1);
+            Scan;
+         end if;
+      end if;
+   end Attribute_Reference;
+
+   ---------------------------
+   -- End_Case_Construction --
+   ---------------------------
+
+   procedure End_Case_Construction is
+   begin
+      if Choice_Lasts.Last = 1 then
+         Choice_Lasts.Set_Last (0);
+         Choices.Set_Last (First_Choice_Node_Id);
+         Choice_First := 0;
+
+      elsif Choice_Lasts.Last = 2 then
+         Choice_Lasts.Set_Last (1);
+         Choices.Set_Last (Choice_Lasts.Table (1));
+         Choice_First := 1;
+
+      else
+         Choice_Lasts.Decrement_Last;
+         Choices.Set_Last (Choice_Lasts.Table (Choice_Lasts.Last));
+         Choice_First := Choice_Lasts.Table (Choice_Lasts.Last - 1) + 1;
+      end if;
+   end End_Case_Construction;
+
+   ------------------------
+   -- External_Reference --
+   ------------------------
+
+   procedure External_Reference (External_Value : out Project_Node_Id) is
+      Field_Id : Project_Node_Id := Empty_Node;
+
+   begin
+      External_Value :=
+        Default_Project_Node (Of_Kind       => N_External_Value,
+                              And_Expr_Kind => Single);
+      Set_Location_Of (External_Value, To => Token_Ptr);
+
+      --  The current token is External
+
+      --  Get the left parenthesis
+
+      Scan;
+      Expect (Tok_Left_Paren, "(");
+
+      --  Scan past the left parenthesis
+
+      if Token = Tok_Left_Paren then
+         Scan;
+      end if;
+
+      --  Get the name of the external reference
+
+      Expect (Tok_String_Literal, "literal string");
+
+      if Token = Tok_String_Literal then
+         Field_Id :=
+           Default_Project_Node (Of_Kind       => N_Literal_String,
+                                 And_Expr_Kind => Single);
+         Set_String_Value_Of (Field_Id, To => Strval (Token_Node));
+         Set_External_Reference_Of (External_Value, To => Field_Id);
+
+         --  Scan past the first argument
+
+         Scan;
+
+         case Token is
+
+            when Tok_Right_Paren =>
+
+               --  Scan past the right parenthesis
+               Scan;
+
+            when Tok_Comma =>
+
+               --  Scan past the comma
+
+               Scan;
+
+               Expect (Tok_String_Literal, "literal string");
+
+               --  Get the default
+
+               if Token = Tok_String_Literal then
+                  Field_Id :=
+                    Default_Project_Node (Of_Kind       => N_Literal_String,
+                                          And_Expr_Kind => Single);
+                  Set_String_Value_Of (Field_Id, To => Strval (Token_Node));
+                  Set_External_Default_Of (External_Value, To => Field_Id);
+                  Scan;
+                  Expect (Tok_Right_Paren, ")");
+               end if;
+
+               --  Scan past the right parenthesis
+               if Token = Tok_Right_Paren then
+                  Scan;
+               end if;
+
+            when others =>
+               Error_Msg ("',' or ')' expected", Token_Ptr);
+         end case;
+      end if;
+   end External_Reference;
+
+   -----------------------
+   -- Parse_Choice_List --
+   -----------------------
+
+   procedure Parse_Choice_List (First_Choice : out Project_Node_Id) is
+      Current_Choice : Project_Node_Id := Empty_Node;
+      Next_Choice    : Project_Node_Id := Empty_Node;
+      Choice_String  : String_Id       := No_String;
+      Found          : Boolean         := False;
+
+   begin
+      First_Choice :=
+        Default_Project_Node (Of_Kind       => N_Literal_String,
+                              And_Expr_Kind => Single);
+      Current_Choice := First_Choice;
+
+      loop
+         Expect (Tok_String_Literal, "literal string");
+         exit when Token /= Tok_String_Literal;
+         Set_Location_Of (Current_Choice, To => Token_Ptr);
+         Choice_String := Strval (Token_Node);
+         Set_String_Value_Of (Current_Choice, To => Choice_String);
+
+         Found := False;
+         for Choice in Choice_First .. Choices.Last loop
+            if String_Equal (Choices.Table (Choice).The_String,
+                             Choice_String)
+            then
+               Found := True;
+
+               if Choices.Table (Choice).Already_Used then
+                  Error_Msg ("duplicate case label", Token_Ptr);
+               else
+                  Choices.Table (Choice).Already_Used := True;
+               end if;
+
+               exit;
+            end if;
+         end loop;
+
+         if not Found then
+            Error_Msg ("illegal case label", Token_Ptr);
+         end if;
+
+         Scan;
+
+         if Token = Tok_Vertical_Bar then
+            Next_Choice :=
+              Default_Project_Node (Of_Kind       => N_Literal_String,
+                                    And_Expr_Kind => Single);
+            Set_Next_Literal_String (Current_Choice, To => Next_Choice);
+            Current_Choice := Next_Choice;
+            Scan;
+         else
+            exit;
+         end if;
+      end loop;
+   end Parse_Choice_List;
+
+   ----------------------
+   -- Parse_Expression --
+   ----------------------
+
+   procedure Parse_Expression
+     (Expression      : out Project_Node_Id;
+      Current_Project : Project_Node_Id;
+      Current_Package : Project_Node_Id)
+   is
+      First_Term      : Project_Node_Id := Empty_Node;
+      Expression_Kind : Variable_Kind := Undefined;
+
+   begin
+      Expression := Default_Project_Node (Of_Kind => N_Expression);
+      Set_Location_Of (Expression, To => Token_Ptr);
+      Terms (Term            => First_Term,
+             Expr_Kind       => Expression_Kind,
+             Current_Project => Current_Project,
+             Current_Package => Current_Package);
+      Set_First_Term (Expression, To => First_Term);
+      Set_Expression_Kind_Of (Expression, To => Expression_Kind);
+   end Parse_Expression;
+
+   ----------------------------
+   -- Parse_String_Type_List --
+   ----------------------------
+
+   procedure Parse_String_Type_List (First_String : out Project_Node_Id) is
+      Last_String  : Project_Node_Id := Empty_Node;
+      Next_String  : Project_Node_Id := Empty_Node;
+      String_Value : String_Id := No_String;
+
+   begin
+      First_String :=
+        Default_Project_Node (Of_Kind       => N_Literal_String,
+                              And_Expr_Kind => Single);
+      Last_String := First_String;
+
+      loop
+         Expect (Tok_String_Literal, "literal string");
+         exit when Token /= Tok_String_Literal;
+         String_Value := Strval (Token_Node);
+         Set_String_Value_Of (Last_String, To => String_Value);
+         Set_Location_Of (Last_String, To => Token_Ptr);
+
+         declare
+            Current : Project_Node_Id := First_String;
+
+         begin
+            while Current /= Last_String loop
+               if String_Equal (String_Value_Of (Current), String_Value) then
+                  Error_Msg ("duplicate value in type", Token_Ptr);
+                  exit;
+               end if;
+
+               Current := Next_Literal_String (Current);
+            end loop;
+         end;
+
+         Scan;
+
+         if Token /= Tok_Comma then
+            exit;
+
+         else
+            Next_String :=
+              Default_Project_Node (Of_Kind       => N_Literal_String,
+                                    And_Expr_Kind => Single);
+            Set_Next_Literal_String (Last_String, To => Next_String);
+            Last_String := Next_String;
+            Scan;
+         end if;
+      end loop;
+   end Parse_String_Type_List;
+
+   ------------------------------
+   -- Parse_Variable_Reference --
+   ------------------------------
+
+   procedure Parse_Variable_Reference
+     (Variable        : out Project_Node_Id;
+      Current_Project : Project_Node_Id;
+      Current_Package : Project_Node_Id)
+   is
+      The_Names        : Names;
+      Last_Name        : Name_Range := 0;
+      Current_Variable : Project_Node_Id := Empty_Node;
+
+      The_Package : Project_Node_Id := Current_Package;
+      The_Project : Project_Node_Id := Current_Project;
+
+      Specified_Project : Project_Node_Id   := Empty_Node;
+      Specified_Package : Project_Node_Id   := Empty_Node;
+      Look_For_Variable : Boolean           := True;
+      First_Attribute   : Attribute_Node_Id := Empty_Attribute;
+      Variable_Name     : Name_Id;
+
+   begin
+      for Index in The_Names'Range loop
+         Expect (Tok_Identifier, "identifier");
+
+         if Token /= Tok_Identifier then
+            Look_For_Variable := False;
+            exit;
+         end if;
+
+         Last_Name := Last_Name + 1;
+         The_Names (Last_Name) :=
+           (Name     => Token_Name,
+            Location => Token_Ptr);
+         Scan;
+         exit when Token /= Tok_Dot;
+         Scan;
+      end loop;
+
+      if Look_For_Variable then
+         if Token = Tok_Apostrophe then
+
+            --  Attribute reference
+
+            case Last_Name is
+               when 0 =>
+
+                  --  Cannot happen
+
+                  null;
+
+               when 1 =>
+                  for Index in Package_First .. Package_Attributes.Last loop
+                     if Package_Attributes.Table (Index).Name =
+                                                      The_Names (1).Name
+                     then
+                        First_Attribute :=
+                          Package_Attributes.Table (Index).First_Attribute;
+                        exit;
+                     end if;
+                  end loop;
+
+                  if First_Attribute /= Empty_Attribute then
+                     The_Package := First_Package_Of (Current_Project);
+                     while The_Package /= Empty_Node
+                       and then Name_Of (The_Package) /= The_Names (1).Name
+                     loop
+                        The_Package := Next_Package_In_Project (The_Package);
+                     end loop;
+
+                     if The_Package = Empty_Node then
+                        Error_Msg ("package not yet defined",
+                                   The_Names (1).Location);
+                     end if;
+
+                  else
+                     First_Attribute := Attribute_First;
+                     The_Package     := Empty_Node;
+
+                     declare
+                        The_Project_Name_And_Node :
+                          constant Tree_Private_Part.Project_Name_And_Node :=
+                            Tree_Private_Part.Projects_Htable.Get
+                                                          (The_Names (1).Name);
+
+                        use Tree_Private_Part;
+
+                     begin
+                        if The_Project_Name_And_Node =
+                                   Tree_Private_Part.No_Project_Name_And_Node
+                        then
+                           Error_Msg ("unknown project",
+                                      The_Names (1).Location);
+                        else
+                           The_Project := The_Project_Name_And_Node.Node;
+                        end if;
+                     end;
+                  end if;
+
+               when 2 =>
+                  declare
+                     With_Clause : Project_Node_Id :=
+                                     First_With_Clause_Of (Current_Project);
+
+                  begin
+                     while With_Clause /= Empty_Node loop
+                        The_Project := Project_Node_Of (With_Clause);
+                        exit when Name_Of (The_Project) = The_Names (1).Name;
+                        With_Clause := Next_With_Clause_Of (With_Clause);
+                     end loop;
+
+                     if With_Clause = Empty_Node then
+                        Error_Msg ("unknown project",
+                                   The_Names (1).Location);
+                        The_Project := Empty_Node;
+                        The_Package := Empty_Node;
+                        First_Attribute := Attribute_First;
+
+                     else
+                        The_Package := First_Package_Of (The_Project);
+                        while The_Package /= Empty_Node
+                          and then Name_Of (The_Package) /= The_Names (2).Name
+                        loop
+                           The_Package :=
+                             Next_Package_In_Project (The_Package);
+                        end loop;
+
+                        if The_Package = Empty_Node then
+                           Error_Msg ("package not declared in project",
+                                      The_Names (2).Location);
+                           First_Attribute := Attribute_First;
+
+                        else
+                           First_Attribute :=
+                             Package_Attributes.Table
+                             (Package_Id_Of (The_Package)).First_Attribute;
+                        end if;
+                     end if;
+                  end;
+
+               when 3 =>
+                  Error_Msg
+                    ("too many single names for an attribute reference",
+                     The_Names (1).Location);
+                  Scan;
+                  Variable := Empty_Node;
+                  return;
+            end case;
+
+            Attribute_Reference
+              (Variable,
+               Current_Project => The_Project,
+               Current_Package => The_Package,
+               First_Attribute => First_Attribute);
+            return;
+         end if;
+      end if;
+
+      Variable :=
+        Default_Project_Node (Of_Kind => N_Variable_Reference);
+
+      if Look_For_Variable then
+         case Last_Name is
+            when 0 =>
+
+               --  Cannot happen
+
+               null;
+
+            when 1 =>
+               Set_Name_Of (Variable, To => The_Names (1).Name);
+
+            --  Header comment needed ???
+
+            when 2 =>
+               Set_Name_Of (Variable, To => The_Names (2).Name);
+               The_Package := First_Package_Of (Current_Project);
+
+               while The_Package /= Empty_Node
+                 and then Name_Of (The_Package) /= The_Names (1).Name
+               loop
+                  The_Package := Next_Package_In_Project (The_Package);
+               end loop;
+
+               if The_Package /= Empty_Node then
+                  Specified_Package := The_Package;
+                  The_Project := Empty_Node;
+
+               else
+                  declare
+                     With_Clause : Project_Node_Id :=
+                                     First_With_Clause_Of (Current_Project);
+
+                  begin
+                     while With_Clause /= Empty_Node loop
+                        The_Project := Project_Node_Of (With_Clause);
+                        exit when Name_Of (The_Project) = The_Names (1).Name;
+                        With_Clause := Next_With_Clause_Of (With_Clause);
+                     end loop;
+
+                     if With_Clause = Empty_Node then
+                        The_Project :=
+                          Modified_Project_Of
+                                 (Project_Declaration_Of (Current_Project));
+
+                        if The_Project /= Empty_Node
+                          and then
+                            Name_Of (The_Project) /= The_Names (1).Name
+                        then
+                           The_Project := Empty_Node;
+                        end if;
+                     end if;
+
+                     if The_Project = Empty_Node then
+                        Error_Msg ("unknown package or project",
+                                   The_Names (1).Location);
+                        Look_For_Variable := False;
+                     else
+                        Specified_Project := The_Project;
+                     end if;
+                  end;
+               end if;
+
+            --  Header comment needed ???
+
+            when 3 =>
+               Set_Name_Of (Variable, To => The_Names (3).Name);
+
+               declare
+                  With_Clause : Project_Node_Id :=
+                                  First_With_Clause_Of (Current_Project);
+
+               begin
+                  while With_Clause /= Empty_Node loop
+                     The_Project := Project_Node_Of (With_Clause);
+                     exit when Name_Of (The_Project) = The_Names (1).Name;
+                     With_Clause := Next_With_Clause_Of (With_Clause);
+                  end loop;
+
+                  if With_Clause = Empty_Node then
+                     The_Project :=
+                       Modified_Project_Of
+                          (Project_Declaration_Of (Current_Project));
+
+                     if The_Project /= Empty_Node
+                       and then Name_Of (The_Project) /= The_Names (1).Name
+                     then
+                        The_Project := Empty_Node;
+                     end if;
+                  end if;
+
+                  if The_Project = Empty_Node then
+                     Error_Msg ("unknown package or project",
+                                The_Names (1).Location);
+                     Look_For_Variable := False;
+
+                  else
+                     Specified_Project := The_Project;
+                     The_Package := First_Package_Of (The_Project);
+
+                     while The_Package /= Empty_Node
+                       and then Name_Of (The_Package) /= The_Names (2).Name
+                     loop
+                        The_Package := Next_Package_In_Project (The_Package);
+                     end loop;
+
+                     if The_Package = Empty_Node then
+                        Error_Msg ("unknown package",
+                                   The_Names (2).Location);
+                        Look_For_Variable := False;
+
+                     else
+                        Specified_Package := The_Package;
+                        The_Project := Empty_Node;
+                     end if;
+                  end if;
+               end;
+
+         end case;
+      end if;
+
+      if Look_For_Variable then
+         Variable_Name := Name_Of (Variable);
+         Set_Project_Node_Of (Variable, To => Specified_Project);
+         Set_Package_Node_Of (Variable, To => Specified_Package);
+
+         if The_Package /= Empty_Node then
+            Current_Variable := First_Variable_Of (The_Package);
+
+            while Current_Variable /= Empty_Node
+              and then
+              Name_Of (Current_Variable) /= Variable_Name
+            loop
+               Current_Variable := Next_Variable (Current_Variable);
+            end loop;
+         end if;
+
+         if Current_Variable = Empty_Node
+           and then The_Project /= Empty_Node
+         then
+            Current_Variable := First_Variable_Of (The_Project);
+            while Current_Variable /= Empty_Node
+              and then Name_Of (Current_Variable) /= Variable_Name
+            loop
+               Current_Variable := Next_Variable (Current_Variable);
+            end loop;
+         end if;
+
+         if Current_Variable = Empty_Node then
+            Error_Msg ("unknown variable", The_Names (Last_Name).Location);
+         end if;
+      end if;
+
+      if Current_Variable /= Empty_Node then
+         Set_Expression_Kind_Of
+           (Variable, To => Expression_Kind_Of (Current_Variable));
+
+         if Kind_Of (Current_Variable) = N_Typed_Variable_Declaration then
+            Set_String_Type_Of
+              (Variable, To => String_Type_Of (Current_Variable));
+         end if;
+      end if;
+   end Parse_Variable_Reference;
+
+   ---------------------------------
+   -- Start_New_Case_Construction --
+   ---------------------------------
+
+   procedure Start_New_Case_Construction (String_Type  : Project_Node_Id) is
+      Current_String : Project_Node_Id;
+
+   begin
+      if Choice_First = 0 then
+         Choice_First := 1;
+         Choices.Set_Last (First_Choice_Node_Id);
+      else
+         Choice_First := Choices.Last + 1;
+      end if;
+
+      if String_Type /= Empty_Node then
+         Current_String := First_Literal_String (String_Type);
+
+         while Current_String /= Empty_Node loop
+            Add (This_String => String_Value_Of (Current_String));
+            Current_String := Next_Literal_String (Current_String);
+         end loop;
+      end if;
+
+      Choice_Lasts.Increment_Last;
+      Choice_Lasts.Table (Choice_Lasts.Last) := Choices.Last;
+
+   end Start_New_Case_Construction;
+
+   -----------
+   -- Terms --
+   -----------
+
+   procedure Terms (Term            : out Project_Node_Id;
+                    Expr_Kind       : in out Variable_Kind;
+                    Current_Project : Project_Node_Id;
+                    Current_Package : Project_Node_Id)
+   is
+      Next_Term          : Project_Node_Id := Empty_Node;
+      Term_Id            : Project_Node_Id := Empty_Node;
+      Current_Expression : Project_Node_Id := Empty_Node;
+      Next_Expression    : Project_Node_Id := Empty_Node;
+      Current_Location   : Source_Ptr      := No_Location;
+      Reference          : Project_Node_Id := Empty_Node;
+
+   begin
+      Term := Default_Project_Node (Of_Kind => N_Term);
+      Set_Location_Of (Term, To => Token_Ptr);
+
+      case Token is
+
+         when Tok_Left_Paren =>
+            case Expr_Kind is
+               when Undefined =>
+                  Expr_Kind := List;
+               when List =>
+                  null;
+               when Single =>
+                  Expr_Kind := List;
+                  Error_Msg
+                    ("literal string list cannot appear in a string",
+                     Token_Ptr);
+            end case;
+
+            Term_Id := Default_Project_Node
+              (Of_Kind => N_Literal_String_List,
+               And_Expr_Kind => List);
+            Set_Current_Term (Term, To => Term_Id);
+            Set_Location_Of (Term, To => Token_Ptr);
+
+            Scan;
+            if Token = Tok_Right_Paren then
+               Scan;
+
+            else
+               loop
+                  Current_Location := Token_Ptr;
+                  Parse_Expression (Expression      => Next_Expression,
+                                    Current_Project => Current_Project,
+                                    Current_Package => Current_Package);
+
+                  if Expression_Kind_Of (Next_Expression) = List then
+                     Error_Msg ("single expression expected",
+                                Current_Location);
+                  end if;
+
+                  if Current_Expression = Empty_Node then
+                     Set_First_Expression_In_List
+                       (Term_Id, To => Next_Expression);
+                  else
+                     Set_Next_Expression_In_List
+                       (Current_Expression, To => Next_Expression);
+                  end if;
+
+                  Current_Expression := Next_Expression;
+                  exit when Token /= Tok_Comma;
+                  Scan; -- past the comma
+               end loop;
+
+               Expect (Tok_Right_Paren, "(");
+
+               if Token = Tok_Right_Paren then
+                  Scan;
+               end if;
+            end if;
+
+         when Tok_String_Literal =>
+            if Expr_Kind = Undefined then
+               Expr_Kind := Single;
+            end if;
+
+            Term_Id := Default_Project_Node (Of_Kind => N_Literal_String);
+            Set_Current_Term (Term, To => Term_Id);
+            Set_String_Value_Of (Term_Id, To => Strval (Token_Node));
+
+            Scan;
+
+         when Tok_Identifier =>
+            Current_Location := Token_Ptr;
+            Parse_Variable_Reference
+              (Variable        => Reference,
+               Current_Project => Current_Project,
+               Current_Package => Current_Package);
+            Set_Current_Term (Term, To => Reference);
+
+            if Reference /= Empty_Node then
+               if Expr_Kind = Undefined then
+                  Expr_Kind := Expression_Kind_Of (Reference);
+
+               elsif Expr_Kind = Single
+                 and then Expression_Kind_Of (Reference) = List
+               then
+                  Expr_Kind := List;
+                  Error_Msg
+                    ("list variable cannot appear in single string expression",
+                     Current_Location);
+               end if;
+            end if;
+
+         when Tok_Project =>
+            Current_Location := Token_Ptr;
+            Scan;
+            Expect (Tok_Apostrophe, "'");
+
+            if Token = Tok_Apostrophe then
+               Attribute_Reference
+                 (Reference       => Reference,
+                  First_Attribute => Prj.Attr.Attribute_First,
+                  Current_Project => Current_Project,
+                  Current_Package => Empty_Node);
+               Set_Current_Term (Term, To => Reference);
+            end if;
+
+            if Reference /= Empty_Node then
+               if Expr_Kind = Undefined then
+                  Expr_Kind := Expression_Kind_Of (Reference);
+
+               elsif Expr_Kind = Single
+                 and then Expression_Kind_Of (Reference) = List
+               then
+                  Error_Msg
+                    ("lists cannot appear in single string expression",
+                     Current_Location);
+               end if;
+            end if;
+
+         when Tok_External =>
+            if Expr_Kind = Undefined then
+               Expr_Kind := Single;
+            end if;
+
+            External_Reference (External_Value => Reference);
+            Set_Current_Term (Term, To => Reference);
+
+         when others =>
+            Error_Msg ("cannot be part of an expression", Token_Ptr);
+            Term := Empty_Node;
+            return;
+      end case;
+
+      if Token = Tok_Ampersand then
+         Scan;
+
+         Terms (Term            => Next_Term,
+                Expr_Kind       => Expr_Kind,
+                Current_Project => Current_Project,
+                Current_Package => Current_Package);
+         Set_Next_Term (Term, To => Next_Term);
+
+      end if;
+
+   end Terms;
+
+end Prj.Strt;