









with Ada.Containers;                  use Ada.Containers;
with Ada.Containers.Hashed_Maps;
with Ada.Containers.Vectors;
with Ada.Directories;
with Ada.Exceptions;
with Ada.Finalization;
with Ada.Strings.Unbounded;           use Ada.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded; use Ada.Strings.Wide_Wide_Unbounded;

pragma Warnings (Off, "internal");
with Ada.Strings.Wide_Wide_Unbounded.Aux;
use Ada.Strings.Wide_Wide_Unbounded.Aux;
pragma Warnings (On, "internal");

with Ada.Text_IO;                     use Ada.Text_IO;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with System;

with GNAT.Task_Lock;
with GNAT.Traceback.Symbolic;

with GNATCOLL.Traces;

with Langkit_Support.Adalog.Debug;
with Langkit_Support.Generic_API.Analysis;
with Langkit_Support.Generic_API.Introspection;
with Langkit_Support.Hashes; use Langkit_Support.Hashes;
with Langkit_Support.Images; use Langkit_Support.Images;
with Langkit_Support.Names;  use Langkit_Support.Names;
with Langkit_Support.Relative_Get;

with Librflxlang.Private_Converters;
use Librflxlang.Private_Converters;

pragma Warnings (Off, "referenced");


pragma Warnings (On, "referenced");



package body Librflxlang.Implementation is

   use Precomputed_Symbols;

   pragma Warnings (Off, "has no effect");
   use Solver;
   pragma Warnings (On, "has no effect");

   package Context_Vectors is new Ada.Containers.Vectors
     (Index_Type   => Positive,
      Element_Type => Internal_Context);

   type Contexts_Destructor is limited
      new Ada.Finalization.Limited_Controlled with null record;
   overriding procedure Finalize (CD : in out Contexts_Destructor);
   --  Helper to destroy all contexts when terminating the process

   package Context_Pool is

      procedure Acquire (Context : out Internal_Context)
         with Post => Context /= null;
      --  If a context is free for reuse, increment its serial number and
      --  return it. Otherwise, allocate a new one. In any case, this does not
      --  initialize it, except for the Serial_Number field.

      procedure Release (Context : in out Internal_Context)
         with Pre  => Context /= null,
              Post => Context = null;
      --  Tag Context as free for reuse and set it to null

      procedure Free;
      --  Free all contexts in this pool. Intended to be called only when the
      --  process is terminating, to avoid reported memory leaks.

   private

      Available : Context_Vectors.Vector;
      --  List of allocated contexts that can be re-used right now

      CD : Contexts_Destructor with Unreferenced;
      --  Singleton whose only purpose is to free all contexts in Available
      --  when finalized.

   end Context_Pool;

   procedure Register_Destroyable_Helper
     (Unit    : Internal_Unit;
      Object  : System.Address;
      Destroy : Destroy_Procedure);
   --  Common underlying implementation for Register_Destroyable_Gen

   pragma Warnings (Off, "referenced");
   function Construct_Entity_Array
     (V : AST_Envs.Entity_Vectors.Vector) return Internal_Entity_Array_Access;
   pragma Warnings (On, "referenced");

   procedure Destroy (Env : in out Lexical_Env_Access);

   function Snaps_At_Start (Self : Bare_R_F_L_X_Node) return Boolean;
   function Snaps_At_End (Self : Bare_R_F_L_X_Node) return Boolean;

   --  Those maps are used to give unique ids to lexical envs while pretty
   --  printing them.

   package Address_To_Id_Maps is new Ada.Containers.Hashed_Maps
     (Lexical_Env, Integer, Hash, "=");

   type Dump_Lexical_Env_State is record
      Env_Ids : Address_To_Id_Maps.Map;
      --  Mapping: Lexical_Env -> Integer, used to remember which unique Ids we
      --  assigned to the lexical environments we found.

      Next_Id : Positive := 1;
      --  Id to assign to the next unknown lexical environment

      Root_Env : Lexical_Env;
      --  Lexical environment we consider a root (this is the Root_Scope from
      --  the current analysis context), or null if unknown.
   end record;
   --  Holder for the state of lexical environment dumpers

   function Get_Env_Id
     (E : Lexical_Env; State : in out Dump_Lexical_Env_State) return String;
   --  If E is known, return its unique Id from State. Otherwise, assign it a
   --  new unique Id and return it.

   procedure Print
     (Node        : Langkit_Support.Generic_API.Analysis.Lk_Node;
      Show_Slocs  : Boolean;
      Line_Prefix : String := "");
   --  Helper for the public overload, but working on the generic API node type

   ------------------------
   -- Precomputed_Symbol --
   ------------------------

   pragma Warnings (Off, "referenced");
   function Precomputed_Symbol
     (Index : Precomputed_Symbol_Index) return Text_Type is
   pragma Warnings (On, "referenced");
   begin
         return (raise Program_Error);
   end Precomputed_Symbol;

   ----------------------------
   -- Construct_Entity_Array --
   ----------------------------

   function Construct_Entity_Array
     (V : AST_Envs.Entity_Vectors.Vector) return Internal_Entity_Array_Access
   is
      Ret : Internal_Entity_Array_Access :=
        Create_Internal_Entity_Array (V.Length);
   begin
      for J in V.First_Index .. V.Last_Index loop
         Ret.Items (J) := V.Get (J);
      end loop;

      declare
         Tmp : AST_Envs.Entity_Vectors.Vector := V;
      begin
         Tmp.Destroy;
      end;

      return Ret;
   end Construct_Entity_Array;

   -----------
   -- Image --
   -----------

   function Image (Self : Symbol_Type) return String_Type is
   begin
      return Create_String (Image (Self));
   end Image;

   ------------------
   -- Context_Pool --
   ------------------

   package body Context_Pool is

      -------------
      -- Acquire --
      -------------

      procedure Acquire (Context : out Internal_Context) is
      begin
         GNAT.Task_Lock.Lock;

         if Available.Is_Empty then
            Context := new Analysis_Context_Type;
            Context.Serial_Number := 1;
         else
            Context := Available.Last_Element;
            Available.Delete_Last;
         end if;

         GNAT.Task_Lock.Unlock;

      exception
         when others =>
            GNAT.Task_Lock.Unlock;
            raise;
      end Acquire;

      -------------
      -- Release --
      -------------

      procedure Release (Context : in out Internal_Context) is
      begin
         GNAT.Task_Lock.Lock;

         Available.Append (Context);
         Context.Serial_Number := Context.Serial_Number + 1;
         Context := null;

         GNAT.Task_Lock.Unlock;

      exception
         when others =>
            GNAT.Task_Lock.Unlock;
            raise;
      end Release;

      ----------
      -- Free --
      ----------

      procedure Free is
      begin
         GNAT.Task_Lock.Lock;

         for C of Available loop
            Free (C);
         end loop;

         GNAT.Task_Lock.Unlock;

      exception
         when others =>
            GNAT.Task_Lock.Unlock;
            raise;
      end Free;

   end Context_Pool;

   --------------
   -- Finalize --
   --------------

   overriding procedure Finalize (CD : in out Contexts_Destructor) is
      pragma Unreferenced (CD);
   begin
      Context_Pool.Free;
   end Finalize;

   -------------
   -- Dec_Ref --
   -------------

   procedure Dec_Ref (File_Reader : in out Internal_File_Reader_Access) is
      procedure Destroy is new Ada.Unchecked_Deallocation
        (Internal_File_Reader'Class, Internal_File_Reader_Access);
   begin
      if File_Reader /= null and then File_Reader.all.Dec_Ref then
         Destroy (File_Reader);
      end if;
   end Dec_Ref;

   -------------
   -- Dec_Ref --
   -------------

   procedure Dec_Ref (Self : in out Internal_Event_Handler_Access) is
      procedure Destroy is new Ada.Unchecked_Deallocation
        (Internal_Event_Handler'Class, Internal_Event_Handler_Access);
   begin
      if Self /= null and then Self.all.Dec_Ref then
         Destroy (Self);
      end if;
   end Dec_Ref;

   -------------
   -- Dec_Ref --
   -------------

   procedure Dec_Ref (Provider : in out Internal_Unit_Provider_Access) is
      procedure Destroy is new Ada.Unchecked_Deallocation
        (Internal_Unit_Provider'Class, Internal_Unit_Provider_Access);
   begin
      if Provider /= null and then Provider.all.Dec_Ref then
         Destroy (Provider);
      end if;
   end Dec_Ref;

   ----------------
   -- Get_Env_Id --
   ----------------

   function Get_Env_Id
     (E : Lexical_Env; State : in out Dump_Lexical_Env_State) return String
   is
      C        : Address_To_Id_Maps.Cursor;
      Inserted : Boolean;
   begin
      if E = Null_Lexical_Env then
         return "$null";

      elsif E = State.Root_Env then
         --  Insert root env with a special Id so that we only print it once
         State.Env_Ids.Insert (E, -1, C, Inserted);
         return "$root";
      end if;

      State.Env_Ids.Insert (E, State.Next_Id, C, Inserted);
      if Inserted then
         State.Next_Id := State.Next_Id + 1;
      end if;

      return '@' & Stripped_Image (Address_To_Id_Maps.Element (C));
   end Get_Env_Id;

   pragma Warnings (Off, "referenced");
   function To_Lookup_Kind_Type (K : Lookup_Kind) return Lookup_Kind_Type
   is
     (Lookup_Kind_Type'Val (Lookup_Kind'Pos (K)));
   pragma Warnings (On, "referenced");

   ----------------------
   -- Allocate_Context --
   ----------------------

   function Allocate_Context return Internal_Context is
   begin
      return Context : Internal_Context do
         Context_Pool.Acquire (Context);
         Context.Ref_Count := 1;
      end return;
   end Allocate_Context;

   ------------------------
   -- Initialize_Context --
   ------------------------

   procedure Initialize_Context
     (Context        : Internal_Context;
      Charset        : String;
      File_Reader    : Internal_File_Reader_Access;
      Unit_Provider  : Internal_Unit_Provider_Access;
      Event_Handler  : Internal_Event_Handler_Access;
      With_Trivia    : Boolean;
      Tab_Stop       : Positive)
   is
      Actual_Charset : constant String :=
        (if Charset = "" then Default_Charset else Charset);
      Symbols        : constant Precomputed_Symbol_Table
        := Create_Symbol_Table;
   begin
      Context.Symbols := Symbol_Table (Symbols);
      Context.Charset := To_Unbounded_String (Actual_Charset);
      Context.Tab_Stop := Tab_Stop;
      Context.With_Trivia := With_Trivia;
      Context.Root_Scope := Create_Static_Lexical_Env
        (Parent => Null_Lexical_Env,
         Node   => null);

      --  Create a new ownership share for Event_Handler so that it lives at
      --  least as long as this analysis context.
      Context.Event_Handler := Event_Handler;
      if Context.Event_Handler /= null then
         Context.Event_Handler.Inc_Ref;
      end if;

      --  Create a new ownership share for File_Reader so that it lives at
      --  least as long as this analysis context.
      Context.File_Reader := File_Reader;
      if Context.File_Reader /= null then
         Context.File_Reader.Inc_Ref;
      end if;

      --  Create a new ownership share for Unit_Provider so that it lives at
      --  least as long as this analysis context.
      Context.Unit_Provider := Unit_Provider;
      if Context.Unit_Provider /= null then
         Context.Unit_Provider.Inc_Ref;
      end if;


      Initialize (Context.Parser);

      Context.Discard_Errors_In_Populate_Lexical_Env := True;
      Context.Logic_Resolution_Timeout :=
        Langkit_Support.Adalog.Default_Timeout_Ticks_Number;
      Context.In_Populate_Lexical_Env := False;
      Context.Cache_Version := 0;
      Context.Reparse_Cache_Version := 0;

      Context.Rewriting_Handle := No_Rewriting_Handle_Pointer;
      Context.Templates_Unit := No_Analysis_Unit;

      Context.Available_Rebindings := Env_Rebindings_Vectors.Empty_Vector;

      

   end Initialize_Context;

   -----------------
   -- Create_Unit --
   -----------------

   function Create_Unit
     (Context             : Internal_Context;
      Normalized_Filename : Virtual_File;
      Charset             : String;
      Rule                : Grammar_Rule) return Internal_Unit
   is
      use Units_Maps;

      Unit : Internal_Unit;
   begin
      Unit := Create_Special_Unit
        (Context, Normalized_Filename, Charset, Rule);
      Context.Units.Insert (Normalized_Filename, Unit);
      return Unit;
   end Create_Unit;

   --------------
   -- Get_Unit --
   --------------

   function Get_Unit
     (Context           : Internal_Context;
      Filename, Charset : String;
      Reparse           : Boolean;
      Input             : Internal_Lexer_Input;
      Rule              : Grammar_Rule;
      Is_Internal       : Boolean := False) return Internal_Unit
   is
      use Units_Maps;

      Normalized_Filename : constant GNATCOLL.VFS.Virtual_File :=
         Normalized_Unit_Filename (Context, Filename);

      Cur     : constant Cursor :=
         Context.Units.Find (Normalized_Filename);
      Created : constant Boolean := Cur = No_Element;
      Unit    : Internal_Unit;

      Actual_Charset : Unbounded_String;
      Refined_Input  : Internal_Lexer_Input := Input;

   begin
      --  Determine which encoding to use. Use the Charset parameter (if
      --  provided), otherwise use the context-wide default.

      Actual_Charset := (if Charset'Length /= 0
                         then To_Unbounded_String (Charset)
                         else Context.Charset);

      if Refined_Input.Kind = File then
         Refined_Input.Filename := Normalized_Filename;
      end if;

      if Refined_Input.Kind in File | Bytes_Buffer then
         Refined_Input.Charset := Actual_Charset;

         --  Unless the caller requested a specific charset for this unit,
         --  allow the lexer to automatically discover the source file encoding
         --  before defaulting to the context-specific one. We do this trying
         --  to match a byte order mark.

         Refined_Input.Read_BOM := Charset'Length = 0;
      end if;

      --  Create the Internal_Unit if needed

      Unit :=
        (if Created
         then Create_Unit (Context, Normalized_Filename,
                           To_String (Actual_Charset), Rule)
         else Element (Cur));

      --  If an internal unit is requested, set the corresponding flag.
      --  Otherwise, make sure that the unit we return isn't internal.

      if Is_Internal then
         Unit.Is_Internal := True;
      end if;

      --  (Re)parse it if needed

      if Created or else Reparse then

         --  It is illegal to reparse an internal unit for public API users.
         --  Since public APIs do not allow to pass True to Is_Internal, we can
         --  check here that only the implementation can ask to reparse an
         --  internal unit.

         if Unit.Is_Internal and then not Is_Internal then
            raise Precondition_Failure with "cannot reparse an internal unit";
         end if;

         declare
            Reparsed : Reparsed_Unit;
         begin
            Do_Parsing (Unit, Refined_Input, Reparsed);
            Update_After_Reparse (Unit, Reparsed);
         end;

         --  Now that we have removed reparsed the unit, update its current
         --  charset.

         Unit.Charset := Actual_Charset;
      end if;

      if Context.Event_Handler /= null then
         Context.Event_Handler.Unit_Parsed_Callback
           (Context  => Context,
            Unit     => Unit,
            Reparsed => not Created and then Reparse);
      end if;

      return Unit;
   end Get_Unit;

   --------------
   -- Has_Unit --
   --------------

   function Has_Unit
     (Context : Internal_Context; Unit_Filename : String) return Boolean is
   begin
      return Context.Units.Contains
        (Normalized_Unit_Filename (Context, Unit_Filename));
   end Has_Unit;

   -------------------
   -- Get_From_File --
   -------------------

   function Get_From_File
     (Context  : Internal_Context;
      Filename : String;
      Charset  : String;
      Reparse  : Boolean;
      Rule     : Grammar_Rule) return Internal_Unit
   is
      Input : constant Internal_Lexer_Input :=
        (Kind     => File,
         Charset  => <>,
         Read_BOM => False,
         Filename => <>);
   begin
      if Reparse and then Has_Rewriting_Handle (Context) then
         raise Precondition_Failure with
            "cannot reparse during tree rewriting";
      end if;

      return Get_Unit (Context, Filename, Charset, Reparse, Input, Rule);
   end Get_From_File;

   ---------------------
   -- Get_From_Buffer --
   ---------------------

   function Get_From_Buffer
     (Context  : Internal_Context;
      Filename : String;
      Charset  : String;
      Buffer   : String;
      Rule     : Grammar_Rule) return Internal_Unit
   is
      Input : constant Internal_Lexer_Input :=
        (Kind        => Bytes_Buffer,
         Charset     => <>,
         Read_BOM    => False,
         Bytes       => Buffer'Address,
         Bytes_Count => Buffer'Length);
   begin
      if Has_Rewriting_Handle (Context) then
         raise Precondition_Failure with
            "cannot parse from buffer during tree rewriting";

      elsif Context.File_Reader /= null then
         raise Precondition_Failure with
            "cannot parse from buffer with a file reader";
      end if;

      return Get_Unit (Context, Filename, Charset, True, Input, Rule);
   end Get_From_Buffer;

   --------------------
   -- Get_With_Error --
   --------------------

   function Get_With_Error
     (Context  : Internal_Context;
      Filename : String;
      Error    : Text_Type;
      Charset  : String;
      Rule     : Grammar_Rule) return Internal_Unit
   is
      use Units_Maps;

      Normalized_Filename : constant Virtual_File :=
         Normalized_Unit_Filename (Context, Filename);
      Cur                 : constant Cursor :=
         Context.Units.Find (Normalized_Filename);
   begin
      if Cur = No_Element then
         declare
            Unit : constant Internal_Unit := Create_Unit
              (Context, Normalized_Filename, Charset, Rule);
         begin
            Append (Unit.Diagnostics, No_Source_Location_Range, Error);
            return Unit;
         end;
      else
         return Element (Cur);
      end if;
   end Get_With_Error;


   -------------------
   -- Unit_Provider --
   -------------------

   function Unit_Provider
     (Context : Internal_Context) return Internal_Unit_Provider_Access
   is (Context.Unit_Provider);

   ------------------
   -- Resolve_Unit --
   ------------------

   procedure Resolve_Unit
     (Context : Internal_Context;
      Name    : Text_Type;
      Kind    : Analysis_Unit_Kind;
      Unit    : out Resolved_Unit)
   is
      --  Look for the cache entry corresponding to Unit; create one if needed

      Dummy    : Resolved_Unit_Array;
      Key      : constant Symbol_Type := Find (Context.Symbols, Name);
      Pos      : Unit_Provider_Cache_Maps.Cursor;
      Inserted : Boolean;
   begin
      Context.Unit_Provider_Cache.Insert (Key, Dummy, Pos, Inserted);
      declare
         Units : Resolved_Unit_Array renames
           Context.Unit_Provider_Cache.Reference (Pos);
         U     : Resolved_Unit renames Units (Kind);
      begin
         --  If the cache entry is not populated for the requested kind, run
         --  the query and save the result for later requests.

         if U.Filename = null then
            declare
               Provider : Internal_Unit_Provider'Class renames
                 Context.Unit_Provider.all;
               Filename : Unbounded_String;
            begin
               Provider.Get_Unit_Location
                 (Name           => Name,
                  Kind           => Kind,
                  Filename       => Filename,
                  PLE_Root_Index => U.PLE_Root_Index);
               Provider.Get_Unit_And_PLE_Root
                 (Context        => Context,
                  Name           => Name,
                  Kind           => Kind,
                  Unit           => U.Unit,
                  PLE_Root_Index => U.PLE_Root_Index);
               U.Filename := new String'(To_String (Filename));
            end;
         end if;

         Unit := U;
      end;
   end Resolve_Unit;

   -----------------------
   -- Get_Unit_Location --
   -----------------------

   procedure Get_Unit_Location
     (Context        : Internal_Context;
      Name           : Text_Type;
      Kind           : Analysis_Unit_Kind;
      Filename       : out String_Access;
      PLE_Root_Index : out Positive)
   is
      U : Resolved_Unit;
   begin
      Resolve_Unit (Context, Name, Kind, U);
      Filename := U.Filename;
      PLE_Root_Index := U.PLE_Root_Index;
   end Get_Unit_Location;

   ---------------------------
   -- Get_Unit_And_PLE_Root --
   ---------------------------

   procedure Get_Unit_And_PLE_Root
     (Context        : Internal_Context;
      Name           : Text_Type;
      Kind           : Analysis_Unit_Kind;
      Unit           : out Internal_Unit;
      PLE_Root_Index : out Positive)
   is
      U : Resolved_Unit;
   begin
      Resolve_Unit (Context, Name, Kind, U);
      Unit := U.Unit;
      PLE_Root_Index := U.PLE_Root_Index;
   end Get_Unit_And_PLE_Root;

   ----------
   -- Hash --
   ----------

   function Hash (Context : Internal_Context) return Hash_Type is
      function H is new Hash_Access (Analysis_Context_Type, Internal_Context);
   begin
      return H (Context);
   end Hash;

   ---------------------
   -- Has_With_Trivia --
   ---------------------

   function Has_With_Trivia (Context : Internal_Context) return Boolean is
   begin
      return Context.With_Trivia;
   end Has_With_Trivia;

   --------------------------------------------
   -- Discard_Errors_In_Populate_Lexical_Env --
   --------------------------------------------

   procedure Discard_Errors_In_Populate_Lexical_Env
     (Context : Internal_Context; Discard : Boolean) is
   begin
      Context.Discard_Errors_In_Populate_Lexical_Env := Discard;
   end Discard_Errors_In_Populate_Lexical_Env;

   ----------------------------------
   -- Set_Logic_Resolution_Timeout --
   ----------------------------------

   procedure Set_Logic_Resolution_Timeout
     (Context : Internal_Context; Timeout : Natural) is
   begin
      Context.Logic_Resolution_Timeout := Timeout;
   end Set_Logic_Resolution_Timeout;

   --------------------------
   -- Has_Rewriting_Handle --
   --------------------------

   function Has_Rewriting_Handle (Context : Internal_Context) return Boolean is
   begin
      return Context.Rewriting_Handle /= No_Rewriting_Handle_Pointer;
   end Has_Rewriting_Handle;

   -------------
   -- Inc_Ref --
   -------------

   procedure Inc_Ref (Context : Internal_Context) is
   begin
      if Context /= null then
         Context.Ref_Count := Context.Ref_Count + 1;
      end if;
   end Inc_Ref;

   -------------
   -- Dec_Ref --
   -------------

   procedure Dec_Ref (Context : in out Internal_Context) is
   begin
      if Context /= null then
         Context.Ref_Count := Context.Ref_Count - 1;
         if Context.Ref_Count = 0 then
            Destroy (Context);
         end if;
      end if;
   end Dec_Ref;

   -------------
   -- Destroy --
   -------------

   procedure Destroy (Context : in out Internal_Context) is
   begin
      --  Destroy all named environment data structures
      for Desc of Context.Named_Envs loop
         for V of Desc.Foreign_Nodes loop
            V.Destroy;
         end loop;
         Destroy (Desc);
      end loop;
      Context.Named_Envs.Clear;

      --  If we are asked to free this context, it means that no one else have
      --  references to its analysis units, so it's safe to destroy these.
      for Unit of Context.Units loop
         Destroy (Unit);
      end loop;
      Context.Units := Units_Maps.Empty_Map;
      Context.Filenames := Virtual_File_Maps.Empty_Map;

      declare
         procedure Destroy is new Ada.Unchecked_Deallocation
           (Env_Rebindings_Type, Env_Rebindings);

         AR : Env_Rebindings_Vectors.Vector renames
            Context.Available_Rebindings;
         R  : Env_Rebindings;
      begin
         for I in AR.First_Index .. AR.Last_Index loop
            R := AR.Get (I);
            Destroy (R);
         end loop;
         AR.Destroy;
      end;

      for Pos in Context.Unit_Provider_Cache.Iterate loop
         declare
            Units : Resolved_Unit_Array renames
              Context.Unit_Provider_Cache.Reference (Pos);
         begin
            for U of Units loop
               Free (U.Filename);
            end loop;
         end;
      end loop;
      Context.Unit_Provider_Cache.Clear;

      Destroy (Context.Templates_Unit);
      AST_Envs.Destroy (Context.Root_Scope);
      Destroy (Context.Symbols);
      Destroy (Context.Parser);
      Dec_Ref (Context.File_Reader);
      Dec_Ref (Context.Unit_Provider);
      Dec_Ref (Context.Event_Handler);
      Context_Pool.Release (Context);
   end Destroy;

   -------------
   -- Context --
   -------------

   function Context (Unit : Internal_Unit) return Internal_Context is
   begin
      return Unit.Context;
   end Context;

   ----------
   -- Hash --
   ----------

   function Hash (Unit : Internal_Unit) return Hash_Type is
      function H is new Hash_Access (Analysis_Unit_Type, Internal_Unit);
   begin
      return H (Unit);
   end Hash;

   -------------
   -- Reparse --
   -------------

   procedure Reparse (Unit : Internal_Unit; Charset : String) is
      Dummy : constant Internal_Unit := Get_From_File
        (Unit.Context, +Unit.Filename.Full_Name, Charset,
         Reparse => True,
         Rule    => Unit.Rule);
   begin
      null;
   end Reparse;

   -------------
   -- Reparse --
   -------------

   procedure Reparse (Unit : Internal_Unit; Charset : String; Buffer : String)
   is
      Dummy : constant Internal_Unit := Get_From_Buffer
        (Unit.Context, +Unit.Filename.Full_Name, Charset, Buffer, Unit.Rule);
   begin
      null;
   end Reparse;

   --------------------------
   -- Populate_Lexical_Env --
   --------------------------

   procedure Populate_Lexical_Env
     (Unit           : Internal_Unit;
      PLE_Root_Index : Positive
         := 1
   ) is
      Context : constant Internal_Context := Unit.Context;

      Saved_In_Populate_Lexical_Env : constant Boolean :=
        Context.In_Populate_Lexical_Env;

      Has_Errors : Boolean := False;
      --  Whether at least one Property_Error occurred during this PLE pass

      procedure Reset_Envs_Caches (Unit : Internal_Unit);
      --  Reset the env caches of all lexical environments created for ``Unit``

      -----------------------
      -- Reset_Envs_Caches --
      -----------------------

      procedure Reset_Envs_Caches (Unit : Internal_Unit) is
         procedure Internal (Node : Bare_R_F_L_X_Node);
         --  Reset env caches in ``Node`` and then in its children recursively

         --------------
         -- Internal --
         --------------

         procedure Internal (Node : Bare_R_F_L_X_Node) is
         begin
            if Node = null then
               return;
            end if;
            Reset_Caches (Node.Self_Env);
            for I in 1 .. Children_Count (Node) loop
               Internal (Child (Node, I));
            end loop;
         end Internal;
      begin
         Internal (Unit.Ast_Root);
      end Reset_Envs_Caches;

   begin
      --  TODO??? Handle env invalidation when reparsing a unit and when a
      --  previous call raised a Property_Error.

      --  If we have already run PLE on this root, there is nothing to do.
      --  Otherwise, keep track of the fact that PLE was requested for it,
      --  possibly extending the vector if needed.

      if Unit.Env_Populated_Roots.Last_Index >= PLE_Root_Index
         and then Unit.Env_Populated_Roots.Get (PLE_Root_Index)
      then
         return;
      end if;
      for Dummy in Unit.Env_Populated_Roots.Last_Index + 1 .. PLE_Root_Index
      loop
         Unit.Env_Populated_Roots.Append (False);
      end loop;
      Unit.Env_Populated_Roots.Set (PLE_Root_Index, True);

      --  Create context for the PLE run: all exit points must call the Cleanup
      --  procedure above first to clean this context.

      Context.In_Populate_Lexical_Env := True;
      if Main_Trace.Active then
         Main_Trace.Trace
           ("Populating lexical envs for"
            & " unit: " & Basename (Unit));
         Main_Trace.Increase_Indent;
      end if;

      --  Fetch the node on which to run PLE: it's the unit root node, or one
      --  of its children if PLE roots are enabled and the unit has a list of
      --  PLE roots. Then run PLE itself.

      declare
         PLE_Root : Bare_R_F_L_X_Node := Unit.Ast_Root;
      begin

         if PLE_Root /= null then
            Has_Errors := Populate_Lexical_Env (PLE_Root);
         end if;
      end;

      --  Restore the context for PLE run (undo what was done above)

      Context.In_Populate_Lexical_Env := Saved_In_Populate_Lexical_Env;
      if Main_Trace.Active then
         Main_Trace.Decrease_Indent;
         Main_Trace.Trace
           ("Finished populating lexical envs for"
            & " unit: " & Basename (Unit));
      end if;

      Reset_Envs_Caches (Unit);

      if Has_Errors and then not Context.Discard_Errors_In_Populate_Lexical_Env
      then
         raise Property_Error with
            "errors occurred in Populate_Lexical_Env";
      end if;
   end Populate_Lexical_Env;

   -----------------------------------
   -- Populate_Lexical_Env_For_Unit --
   -----------------------------------

   procedure Populate_Lexical_Env_For_Unit (Node : Bare_R_F_L_X_Node) is
      Root  : Bare_R_F_L_X_Node;
      Index : Natural;
   begin
      Lookup_PLE_Root (Node, Root, Index);
      if Index = 0 then
         Index := 1;
      end if;
      Populate_Lexical_Env (Node.Unit, Index);
   end Populate_Lexical_Env_For_Unit;

   ------------------
   -- Get_Filename --
   ------------------

   function Get_Filename (Unit : Internal_Unit) return String is
     (+Unit.Filename.Full_Name);

   -----------------
   -- Get_Charset --
   -----------------

   function Get_Charset (Unit : Internal_Unit) return String is
   begin
      return To_String (Unit.Charset);
   end Get_Charset;

   ---------------------
   -- Has_Diagnostics --
   ---------------------

   function Has_Diagnostics (Unit : Internal_Unit) return Boolean is
   begin
      return not Unit.Diagnostics.Is_Empty;
   end Has_Diagnostics;

   -----------------
   -- Diagnostics --
   -----------------

   function Diagnostics (Unit : Internal_Unit) return Diagnostics_Array is
      Result : Diagnostics_Array (1 .. Natural (Unit.Diagnostics.Length));
      I      : Natural := 1;
   begin
      for D of Unit.Diagnostics loop
         Result (I) := D;
         I := I + 1;
      end loop;
      return Result;
   end Diagnostics;

   ---------------------------
   -- Format_GNU_Diagnostic --
   ---------------------------

   function Format_GNU_Diagnostic
     (Unit : Internal_Unit; D : Diagnostic) return String
   is
      Filename : constant String := Basename (Unit);
      Sloc     : constant Source_Location := Start_Sloc (D.Sloc_Range);
      Msg      : constant String :=
         Image
           (Ada.Strings.Wide_Wide_Unbounded.To_Wide_Wide_String (D.Message));
   begin
      return (Filename
              & (if Sloc = No_Source_Location then "" else ":" & Image (Sloc))
              & ": " & Msg);
   end Format_GNU_Diagnostic;

   ----------
   -- Root --
   ----------

   function Root (Unit : Internal_Unit) return Bare_R_F_L_X_Node is
     (Unit.Ast_Root);

   -----------------
   -- First_Token --
   -----------------

   function First_Token (Unit : Internal_Unit) return Token_Reference is
     (Wrap_Token_Reference (Unit.Context,
                            Unit.TDH'Access,
                            First_Token_Or_Trivia (Unit.TDH)));

   ----------------
   -- Last_Token --
   ----------------

   function Last_Token (Unit : Internal_Unit) return Token_Reference is
     (Wrap_Token_Reference (Unit.Context,
                            Unit.TDH'Access,
                            Last_Token_Or_Trivia (Unit.TDH)));

   -----------------
   -- Token_Count --
   -----------------

   function Token_Count (Unit : Internal_Unit) return Natural is
     (Unit.TDH.Tokens.Length);

   ------------------
   -- Trivia_Count --
   ------------------

   function Trivia_Count (Unit : Internal_Unit) return Natural is
     (Unit.TDH.Trivias.Length);

   ----------
   -- Text --
   ----------

   function Text (Unit : Internal_Unit) return Text_Type is
   begin
      return Text (First_Token (Unit), Last_Token (Unit));
   end Text;

   ------------------
   -- Lookup_Token --
   ------------------

   function Lookup_Token
     (Unit : Internal_Unit; Sloc : Source_Location) return Token_Reference
   is
      Result : constant Token_Or_Trivia_Index := Lookup_Token (Unit.TDH, Sloc);
   begin
      return Wrap_Token_Reference (Unit.Context, Unit.TDH'Access, Result);
   end Lookup_Token;

   ---------------------
   -- Lookup_PLE_Root --
   ---------------------

   procedure Lookup_PLE_Root
     (Node  : Bare_R_F_L_X_Node;
      Root  : out Bare_R_F_L_X_Node;
      Index : out Natural)
   is
      Unit : constant Internal_Unit := Node.Unit;
   begin
      --  If this unit does not contain a list of PLE roots, just return the
      --  unit root node.

      if Unit.PLE_Roots_Starting_Token.Is_Empty then
         Root := Unit.Ast_Root;
         Index := 0;
         return;
      end if;

      --  Otherwise, look for the last PLE root whose first token (in
      --  Unit.PLE_Roots_Starting_Token) appears before Node's (T). This vector
      --  is sorted by construction, so we can perform a binary search.

      declare
         T      : constant Token_Index := Node.Token_Start_Index;
         Tokens : Token_Index_Vectors.Vector renames
           Unit.PLE_Roots_Starting_Token;

         First : Positive := Tokens.First_Index;
         Last  : Positive := Tokens.Last_Index;
         I     : Positive;
      begin
         while First < Last loop

            --  Because we look for the "floor" (last element that is <= T), we
            --  need to look at the value in Last when there are only two
            --  elements left to look at. If we did not do that, then we would
            --  go into an infinite loop when Tokens[First] < T.

            I := (if First + 1 = Last
                  then Last
                  else (First + Last) / 2);
            declare
               I_T : constant Token_Index := Tokens.Get (I);
            begin
               if I_T <= T then
                  First := I;
               else
                  Last := I - 1;
               end if;
            end;
         end loop;

         Root := Child (Unit.Ast_Root, First);
         Index := First;
      end;
   end Lookup_PLE_Root;

   --------------
   -- Ple_Root --
   --------------

   function Ple_Root
     (Node : Bare_R_F_L_X_Node) return Bare_R_F_L_X_Node
   is
      Root        : Bare_R_F_L_X_Node;
      Dummy_Index : Natural;
   begin
      if Node = null then
         raise Property_Error with "null node dereference";
      end if;
      Lookup_PLE_Root (Node, Root, Dummy_Index);
      return Root;
   end Ple_Root;

   ----------------------
   -- Dump_Lexical_Env --
   ----------------------

   procedure Dump_Lexical_Env (Unit : Internal_Unit) is
      Node     : constant Bare_R_F_L_X_Node := Unit.Ast_Root;
      Root_Env : constant Lexical_Env := Unit.Context.Root_Scope;
      State    : Dump_Lexical_Env_State := (Root_Env => Root_Env, others => <>);

      function Get_Parent (Env : Lexical_Env) return Lexical_Env
      is (Unwrap (Env).Parent);

      --------------------------
      -- Explore_Parent_Chain --
      --------------------------

      procedure Explore_Parent_Chain (Env : Lexical_Env) is
         P : Lexical_Env;
      begin
         if Env /= Null_Lexical_Env then
            P := Get_Parent (Env);
            Dump_One_Lexical_Env
              (Env, Get_Env_Id (Env, State), Get_Env_Id (P, State));
            Explore_Parent_Chain (P);
         end if;
      end Explore_Parent_Chain;

      --------------
      -- Internal --
      --------------

      procedure Internal (Current : Bare_R_F_L_X_Node) is
         Explore_Parent : Boolean := False;
         Env, Parent    : Lexical_Env;
      begin
         if Current = null then
            return;
         end if;

         --  We only dump environments that we haven't dumped before. This way
         --  we'll only dump environments at the site of their creation, and
         --  not in any subsequent link. We use the Env_Ids map to check which
         --  envs we have already seen or not.
         if not State.Env_Ids.Contains (Current.Self_Env) then
            Env := Current.Self_Env;
            Parent := Get_Parent (Env);
            Explore_Parent := not State.Env_Ids.Contains (Parent);

            Dump_One_Lexical_Env
              (Env, Get_Env_Id (Env, State), Get_Env_Id (Parent, State));

            if Explore_Parent then
               Explore_Parent_Chain (Parent);
            end if;
         end if;

         for Child of Internal_Bare_R_F_L_X_Node_Array'(Children (Current))
         loop
            Internal (Child);
         end loop;
      end Internal;
      --  This procedure implements the main recursive logic of dumping the
      --  environments.
   begin
      Internal (Bare_R_F_L_X_Node (Node));
   end Dump_Lexical_Env;

   --------------
   -- Get_Line --
   --------------

   function Get_Line
     (Unit : Internal_Unit; Line_Number : Positive) return Text_Type
   is
   begin
      return Get_Line (Unit.TDH, Line_Number);
   end Get_Line;

   -----------
   -- Print --
   -----------

   procedure Print (Unit : Internal_Unit; Show_Slocs : Boolean) is
   begin
      if Unit.Ast_Root = null then
         Put_Line ("<empty analysis unit>");
      else
         Print (Unit.Ast_Root, Show_Slocs);
      end if;
   end Print;

   ---------------
   -- PP_Trivia --
   ---------------

   procedure PP_Trivia (Unit : Internal_Unit) is

      procedure Process (Trivia : Token_Index) is
         Data : constant Stored_Token_Data :=
            Unit.TDH.Trivias.Get (Natural (Trivia)).T;
      begin
         Put_Line (Image (Text (Unit.TDH, Data)));
      end Process;

      Last_Token : constant Token_Index :=
         Token_Index (Token_Vectors.Last_Index (Unit.TDH.Tokens) - 1);
      --  Index for the last token in Unit excluding the Termination token
      --  (hence the -1).
   begin
      for Tok of Get_Leading_Trivias (Unit.TDH) loop
         Process (Tok);
      end loop;

      PP_Trivia (Unit.Ast_Root);

      for Tok of Get_Trivias (Unit.TDH, Last_Token) loop
         Process (Tok);
      end loop;
   end PP_Trivia;

   -------------
   -- Destroy --
   -------------

   procedure Destroy (Unit : in out Internal_Unit) is
   begin
      if Unit = No_Analysis_Unit then
         return;
      end if;

      Unit.PLE_Roots_Starting_Token.Destroy;
      Unit.Env_Populated_Roots.Destroy;

      Unit.Exiled_Entries.Destroy;
      Unit.Foreign_Nodes.Destroy;
      Unit.Exiled_Entries_In_NED.Destroy;
      Unit.Exiled_Envs.Destroy;
      Unit.Named_Envs.Destroy;
      Analysis_Unit_Sets.Destroy (Unit.Referenced_Units);


      Destroy_Rebindings (Unit.Rebindings'Access);
      Unit.Rebindings.Destroy;

      if Unit.Ast_Root /= null then
         Destroy (Unit.Ast_Root);
      end if;

      Free (Unit.TDH);
      Free (Unit.Ast_Mem_Pool);
      Destroy_Unit_Destroyables (Unit);
      Destroyable_Vectors.Destroy (Unit.Destroyables);
      

      Free (Unit);
   end Destroy;

   -------------------
   -- Is_Token_Node --
   -------------------

   function Is_Token_Node (Node : Bare_R_F_L_X_Node) return Boolean is
   begin
      return Is_Token_Node (Node.Kind);
   end Is_Token_Node;

   ------------------
   -- Is_Synthetic --
   ------------------

   function Is_Synthetic (Node : Bare_R_F_L_X_Node) return Boolean is
   begin
      return Node.Kind in Synthetic_Nodes;
   end Is_Synthetic;

   ------------------------------
   -- Raise_Property_Exception --
   ------------------------------

   procedure Raise_Property_Exception
     (Node    : Bare_R_F_L_X_Node;
      Exc     : Ada.Exceptions.Exception_Id;
      Message : String)
   is
      Sloc_Prefix : constant String :=
        (if Node = null
         then ""
         else Ada.Directories.Simple_Name (Get_Filename (Unit (Node)))
              & ":" & Image (Sloc_Range (Node)) & ": ");
   begin
      Ada.Exceptions.Raise_Exception (Exc, Sloc_Prefix & Message);
   end Raise_Property_Exception;

   ------------------------------
   -- Register_Destroyable_Gen --
   ------------------------------

   procedure Register_Destroyable_Gen
     (Unit : Internal_Unit; Object : T_Access)
   is
      function Convert is new Ada.Unchecked_Conversion
        (System.Address, Destroy_Procedure);
      procedure Destroy_Procedure (Object : in out T_Access) renames Destroy;
   begin
      Register_Destroyable_Helper
        (Unit,
         Object.all'Address,
         Convert (Destroy_Procedure'Address));
   end Register_Destroyable_Gen;

      

   


   ---------
   -- Get --
   ---------

   function Get
     (Node    : Bare_R_F_L_X_Node;
      T       : Bare_R_F_L_X_Node_Array_Access;
      Index   : Integer;
      Or_Null : Boolean := False) return Bare_R_F_L_X_Node
   is
      function Absolute_Get
        (T : Bare_R_F_L_X_Node_Array_Access; Index : Integer)
         return Bare_R_F_L_X_Node
      is
        (T.Items (Index + 1)); --  T.Items is 1-based but Index is 0-based

      function Relative_Get is new Langkit_Support.Relative_Get
        (Item_Type     => Bare_R_F_L_X_Node,
         Sequence_Type => Bare_R_F_L_X_Node_Array_Access,
         Length        => Length,
         Get           => Absolute_Get);

      Result : Bare_R_F_L_X_Node;
   begin
      if Relative_Get (T, Index, Result) then
         return Result;
      elsif Or_Null then
         return No_Bare_R_F_L_X_Node;
      else
         Raise_Property_Exception
           (Node,
            Property_Error'Identity,
            "out-of-bounds array access");
      end if;
   end Get;

   ------------
   -- Concat --
   ------------

   function Concat (L, R : Bare_R_F_L_X_Node_Array_Access) return Bare_R_F_L_X_Node_Array_Access is
      Ret : Bare_R_F_L_X_Node_Array_Access := Create_Bare_R_F_L_X_Node_Array (Length (L) + Length (R));
   begin
      Ret.Items := L.Items & R.Items;
      return Ret;
   end Concat;


   -------------
   -- Inc_Ref --
   -------------

   procedure Inc_Ref (T : Bare_R_F_L_X_Node_Array_Access) is
   begin
      if T.Ref_Count >= 0 then
         T.Ref_Count := T.Ref_Count + 1;
      end if;
   end Inc_Ref;

   ------------
   -- Length --
   ------------

   function Length (T : Bare_R_F_L_X_Node_Array_Access) return Natural is (T.N);

   -------------
   -- Dec_Ref --
   -------------

   procedure Dec_Ref (T : in out Bare_R_F_L_X_Node_Array_Access) is
   begin
      if T = null or else T.Ref_Count < 0 then
         return;
      end if;

      if T.Ref_Count = 1 then
         Free (T);
      else
         T.Ref_Count := T.Ref_Count - 1;
         T := null;
      end if;
   end Dec_Ref;

   function Create_Bare_R_F_L_X_Node_Array (Items_Count : Natural) return Bare_R_F_L_X_Node_Array_Access
   is (if Items_Count = 0
       then No_Bare_R_F_L_X_Node_Array_Type
       else new Bare_R_F_L_X_Node_Array_Record'(N => Items_Count, Ref_Count => 1, Items => <>));


   function Create_Bare_R_F_L_X_Node_Array
     (Items : Internal_Bare_R_F_L_X_Node_Array) return Bare_R_F_L_X_Node_Array_Access is
   begin
      if Items'Length = 0 then
         return No_Bare_R_F_L_X_Node_Array_Type;
      end if;

      return new Bare_R_F_L_X_Node_Array_Record'
        (N => Items'Length, Ref_Count => 1, Items => Items);
   end;

   ----------------
   -- Equivalent --
   ----------------

   function Equivalent (L, R : Bare_R_F_L_X_Node_Array_Access) return Boolean is
   begin
      if L.N /= R.N then
         return False;
      end if;

      for I in L.Items'Range loop
         if
               L.Items (I) /= R.Items (I)
         then
            return False;
         end if;
      end loop;

      return True;
   end Equivalent;


      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (A : Bare_R_F_L_X_Node_Array_Access) return String is
         Result : Unbounded_String;
      begin
         Append (Result, "[");
         for I in A.Items'Range loop
            if I > A.Items'First then
               Append (Result, ", ");
            end if;
            Append (Result, Trace_Image (A.Items (I)));
         end loop;
         Append (Result, "]");
         return To_String (Result);
      end Trace_Image;




      

   


   ---------
   -- Get --
   ---------

   function Get
     (Node    : Bare_R_F_L_X_Node;
      T       : Internal_Entity_Array_Access;
      Index   : Integer;
      Or_Null : Boolean := False) return Internal_Entity
   is
      function Absolute_Get
        (T : Internal_Entity_Array_Access; Index : Integer)
         return Internal_Entity
      is
        (T.Items (Index + 1)); --  T.Items is 1-based but Index is 0-based

      function Relative_Get is new Langkit_Support.Relative_Get
        (Item_Type     => Internal_Entity,
         Sequence_Type => Internal_Entity_Array_Access,
         Length        => Length,
         Get           => Absolute_Get);

      Result : Internal_Entity;
   begin
      if Relative_Get (T, Index, Result) then
         return Result;
      elsif Or_Null then
         return No_Entity;
      else
         Raise_Property_Exception
           (Node,
            Property_Error'Identity,
            "out-of-bounds array access");
      end if;
   end Get;

   ------------
   -- Concat --
   ------------

   function Concat (L, R : Internal_Entity_Array_Access) return Internal_Entity_Array_Access is
      Ret : Internal_Entity_Array_Access := Create_Internal_Entity_Array (Length (L) + Length (R));
   begin
      Ret.Items := L.Items & R.Items;
      return Ret;
   end Concat;


   -------------
   -- Inc_Ref --
   -------------

   procedure Inc_Ref (T : Internal_Entity_Array_Access) is
   begin
      if T.Ref_Count >= 0 then
         T.Ref_Count := T.Ref_Count + 1;
      end if;
   end Inc_Ref;

   ------------
   -- Length --
   ------------

   function Length (T : Internal_Entity_Array_Access) return Natural is (T.N);

   -------------
   -- Dec_Ref --
   -------------

   procedure Dec_Ref (T : in out Internal_Entity_Array_Access) is
   begin
      if T = null or else T.Ref_Count < 0 then
         return;
      end if;

      if T.Ref_Count = 1 then
         Free (T);
      else
         T.Ref_Count := T.Ref_Count - 1;
         T := null;
      end if;
   end Dec_Ref;

   function Create_Internal_Entity_Array (Items_Count : Natural) return Internal_Entity_Array_Access
   is (if Items_Count = 0
       then No_Internal_Entity_Array_Type
       else new Internal_Entity_Array_Record'(N => Items_Count, Ref_Count => 1, Items => <>));

   function Create_Internal_Entity_Array
     (Items : AST_Envs.Entity_Array) return Internal_Entity_Array_Access
   is (if Items'Length = 0
       then No_Internal_Entity_Array_Type
       else new Internal_Entity_Array_Record'
         (N         => Items'Length,
          Items     => Implementation.Internal_Internal_Entity_Array (Items),
          Ref_Count => 1));

   function Create_Internal_Entity_Array
     (Items : Internal_Internal_Entity_Array) return Internal_Entity_Array_Access is
   begin
      if Items'Length = 0 then
         return No_Internal_Entity_Array_Type;
      end if;

      return new Internal_Entity_Array_Record'
        (N => Items'Length, Ref_Count => 1, Items => Items);
   end;

   ----------------
   -- Equivalent --
   ----------------

   function Equivalent (L, R : Internal_Entity_Array_Access) return Boolean is
   begin
      if L.N /= R.N then
         return False;
      end if;

      for I in L.Items'Range loop
         if
               L.Items (I) /= R.Items (I)
         then
            return False;
         end if;
      end loop;

      return True;
   end Equivalent;


      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (A : Internal_Entity_Array_Access) return String is
         Result : Unbounded_String;
      begin
         Append (Result, "[");
         for I in A.Items'Range loop
            if I > A.Items'First then
               Append (Result, ", ");
            end if;
            Append (Result, Trace_Image (A.Items (I)));
         end loop;
         Append (Result, "]");
         return To_String (Result);
      end Trace_Image;




      

   


   ---------
   -- Get --
   ---------

   function Get
     (Node    : Bare_R_F_L_X_Node;
      T       : Internal_Inner_Env_Assoc_Array_Access;
      Index   : Integer;
      Or_Null : Boolean := False) return Internal_Inner_Env_Assoc
   is
      function Absolute_Get
        (T : Internal_Inner_Env_Assoc_Array_Access; Index : Integer)
         return Internal_Inner_Env_Assoc
      is
        (T.Items (Index + 1)); --  T.Items is 1-based but Index is 0-based

      function Relative_Get is new Langkit_Support.Relative_Get
        (Item_Type     => Internal_Inner_Env_Assoc,
         Sequence_Type => Internal_Inner_Env_Assoc_Array_Access,
         Length        => Length,
         Get           => Absolute_Get);

      Result : Internal_Inner_Env_Assoc;
   begin
      if Relative_Get (T, Index, Result) then
         return Result;
      elsif Or_Null then
         return No_Inner_Env_Assoc;
      else
         Raise_Property_Exception
           (Node,
            Property_Error'Identity,
            "out-of-bounds array access");
      end if;
   end Get;

   ------------
   -- Concat --
   ------------

   function Concat (L, R : Internal_Inner_Env_Assoc_Array_Access) return Internal_Inner_Env_Assoc_Array_Access is
      Ret : Internal_Inner_Env_Assoc_Array_Access := Create_Internal_Inner_Env_Assoc_Array (Length (L) + Length (R));
   begin
      Ret.Items := L.Items & R.Items;
      return Ret;
   end Concat;


   -------------
   -- Inc_Ref --
   -------------

   procedure Inc_Ref (T : Internal_Inner_Env_Assoc_Array_Access) is
   begin
      if T.Ref_Count >= 0 then
         T.Ref_Count := T.Ref_Count + 1;
      end if;
   end Inc_Ref;

   ------------
   -- Length --
   ------------

   function Length (T : Internal_Inner_Env_Assoc_Array_Access) return Natural is (T.N);

   -------------
   -- Dec_Ref --
   -------------

   procedure Dec_Ref (T : in out Internal_Inner_Env_Assoc_Array_Access) is
   begin
      if T = null or else T.Ref_Count < 0 then
         return;
      end if;

      if T.Ref_Count = 1 then
         Free (T);
      else
         T.Ref_Count := T.Ref_Count - 1;
         T := null;
      end if;
   end Dec_Ref;

   function Create_Internal_Inner_Env_Assoc_Array (Items_Count : Natural) return Internal_Inner_Env_Assoc_Array_Access
   is (if Items_Count = 0
       then No_Internal_Inner_Env_Assoc_Array_Type
       else new Internal_Inner_Env_Assoc_Array_Record'(N => Items_Count, Ref_Count => 1, Items => <>));


   function Create_Internal_Inner_Env_Assoc_Array
     (Items : Internal_Internal_Inner_Env_Assoc_Array) return Internal_Inner_Env_Assoc_Array_Access is
   begin
      if Items'Length = 0 then
         return No_Internal_Inner_Env_Assoc_Array_Type;
      end if;

      return new Internal_Inner_Env_Assoc_Array_Record'
        (N => Items'Length, Ref_Count => 1, Items => Items);
   end;

   ----------------
   -- Equivalent --
   ----------------

   function Equivalent (L, R : Internal_Inner_Env_Assoc_Array_Access) return Boolean is
   begin
      if L.N /= R.N then
         return False;
      end if;

      for I in L.Items'Range loop
         if
               L.Items (I) /= R.Items (I)
         then
            return False;
         end if;
      end loop;

      return True;
   end Equivalent;


      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (A : Internal_Inner_Env_Assoc_Array_Access) return String is
         Result : Unbounded_String;
      begin
         Append (Result, "[");
         for I in A.Items'Range loop
            if I > A.Items'First then
               Append (Result, ", ");
            end if;
            Append (Result, Trace_Image (A.Items (I)));
         end loop;
         Append (Result, "]");
         return To_String (Result);
      end Trace_Image;




      

   


   ---------
   -- Get --
   ---------

   function Get
     (Node    : Bare_R_F_L_X_Node;
      T       : Lexical_Env_Array_Access;
      Index   : Integer;
      Or_Null : Boolean := False) return Lexical_Env
   is
      function Absolute_Get
        (T : Lexical_Env_Array_Access; Index : Integer)
         return Lexical_Env
      is
        (T.Items (Index + 1)); --  T.Items is 1-based but Index is 0-based

      function Relative_Get is new Langkit_Support.Relative_Get
        (Item_Type     => Lexical_Env,
         Sequence_Type => Lexical_Env_Array_Access,
         Length        => Length,
         Get           => Absolute_Get);

      Result : Lexical_Env;
   begin
      if Relative_Get (T, Index, Result) then
            Inc_Ref (Result);
         return Result;
      elsif Or_Null then
         return Empty_Env;
      else
         Raise_Property_Exception
           (Node,
            Property_Error'Identity,
            "out-of-bounds array access");
      end if;
   end Get;

   ------------
   -- Concat --
   ------------

   function Concat (L, R : Lexical_Env_Array_Access) return Lexical_Env_Array_Access is
      Ret : Lexical_Env_Array_Access := Create_Lexical_Env_Array (Length (L) + Length (R));
   begin
      Ret.Items := L.Items & R.Items;
         for Item of Ret.Items loop
            Inc_Ref (Item);
         end loop;
      return Ret;
   end Concat;


   -------------
   -- Inc_Ref --
   -------------

   procedure Inc_Ref (T : Lexical_Env_Array_Access) is
   begin
      if T.Ref_Count >= 0 then
         T.Ref_Count := T.Ref_Count + 1;
      end if;
   end Inc_Ref;

   ------------
   -- Length --
   ------------

   function Length (T : Lexical_Env_Array_Access) return Natural is (T.N);

   -------------
   -- Dec_Ref --
   -------------

   procedure Dec_Ref (T : in out Lexical_Env_Array_Access) is
   begin
      if T = null or else T.Ref_Count < 0 then
         return;
      end if;

      if T.Ref_Count = 1 then
            for Item of T.Items loop
               Dec_Ref (Item);
            end loop;
         Free (T);
      else
         T.Ref_Count := T.Ref_Count - 1;
         T := null;
      end if;
   end Dec_Ref;

   function Create_Lexical_Env_Array (Items_Count : Natural) return Lexical_Env_Array_Access
   is (if Items_Count = 0
       then No_Lexical_Env_Array_Type
       else new Lexical_Env_Array_Record'(N => Items_Count, Ref_Count => 1, Items => <>));


   function Create_Lexical_Env_Array
     (Items : Internal_Lexical_Env_Array) return Lexical_Env_Array_Access is
   begin
      if Items'Length = 0 then
         return No_Lexical_Env_Array_Type;
      end if;

         for El of Items loop
            Inc_Ref (El);
         end loop;
      return new Lexical_Env_Array_Record'
        (N => Items'Length, Ref_Count => 1, Items => Items);
   end;

   ----------------
   -- Equivalent --
   ----------------

   function Equivalent (L, R : Lexical_Env_Array_Access) return Boolean is
   begin
      if L.N /= R.N then
         return False;
      end if;

      for I in L.Items'Range loop
         if
               not Equivalent (L.Items (I), R.Items (I))
         then
            return False;
         end if;
      end loop;

      return True;
   end Equivalent;


      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (A : Lexical_Env_Array_Access) return String is
         Result : Unbounded_String;
      begin
         Append (Result, "[");
         for I in A.Items'Range loop
            if I > A.Items'First then
               Append (Result, ", ");
            end if;
            Append (Result, Trace_Image (A.Items (I)));
         end loop;
         Append (Result, "]");
         return To_String (Result);
      end Trace_Image;




      

   


   ---------
   -- Get --
   ---------

   function Get
     (Node    : Bare_R_F_L_X_Node;
      T       : Symbol_Type_Array_Access;
      Index   : Integer;
      Or_Null : Boolean := False) return Symbol_Type
   is
      function Absolute_Get
        (T : Symbol_Type_Array_Access; Index : Integer)
         return Symbol_Type
      is
        (T.Items (Index + 1)); --  T.Items is 1-based but Index is 0-based

      function Relative_Get is new Langkit_Support.Relative_Get
        (Item_Type     => Symbol_Type,
         Sequence_Type => Symbol_Type_Array_Access,
         Length        => Length,
         Get           => Absolute_Get);

      Result : Symbol_Type;
   begin
      if Relative_Get (T, Index, Result) then
         return Result;
      elsif Or_Null then
         return null;
      else
         Raise_Property_Exception
           (Node,
            Property_Error'Identity,
            "out-of-bounds array access");
      end if;
   end Get;

   ------------
   -- Concat --
   ------------

   function Concat (L, R : Symbol_Type_Array_Access) return Symbol_Type_Array_Access is
      Ret : Symbol_Type_Array_Access := Create_Symbol_Type_Array (Length (L) + Length (R));
   begin
      Ret.Items := L.Items & R.Items;
      return Ret;
   end Concat;


   -------------
   -- Inc_Ref --
   -------------

   procedure Inc_Ref (T : Symbol_Type_Array_Access) is
   begin
      if T.Ref_Count >= 0 then
         T.Ref_Count := T.Ref_Count + 1;
      end if;
   end Inc_Ref;

   ------------
   -- Length --
   ------------

   function Length (T : Symbol_Type_Array_Access) return Natural is (T.N);

   -------------
   -- Dec_Ref --
   -------------

   procedure Dec_Ref (T : in out Symbol_Type_Array_Access) is
   begin
      if T = null or else T.Ref_Count < 0 then
         return;
      end if;

      if T.Ref_Count = 1 then
         Free (T);
      else
         T.Ref_Count := T.Ref_Count - 1;
         T := null;
      end if;
   end Dec_Ref;

   function Create_Symbol_Type_Array (Items_Count : Natural) return Symbol_Type_Array_Access
   is (if Items_Count = 0
       then No_Symbol_Type_Array_Type
       else new Symbol_Type_Array_Record'(N => Items_Count, Ref_Count => 1, Items => <>));


   function Create_Symbol_Type_Array
     (Items : Internal_Symbol_Type_Array) return Symbol_Type_Array_Access is
   begin
      if Items'Length = 0 then
         return No_Symbol_Type_Array_Type;
      end if;

      return new Symbol_Type_Array_Record'
        (N => Items'Length, Ref_Count => 1, Items => Items);
   end;

   ----------------
   -- Equivalent --
   ----------------

   function Equivalent (L, R : Symbol_Type_Array_Access) return Boolean is
   begin
      if L.N /= R.N then
         return False;
      end if;

      for I in L.Items'Range loop
         if
               L.Items (I) /= R.Items (I)
         then
            return False;
         end if;
      end loop;

      return True;
   end Equivalent;


      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (A : Symbol_Type_Array_Access) return String is
         Result : Unbounded_String;
      begin
         Append (Result, "[");
         for I in A.Items'Range loop
            if I > A.Items'First then
               Append (Result, ", ");
            end if;
            Append (Result, Trace_Image (A.Items (I)));
         end loop;
         Append (Result, "]");
         return To_String (Result);
      end Trace_Image;





         

   

   ----------
   -- Next --
   ----------

   function Next
     (T       : Bare_R_F_L_X_Node_Iterator_Access;
      Element : out Bare_R_F_L_X_Node) return Boolean is
   begin
      if T = null then
         raise Property_Error with "null access dereference";
      end if;
      Check_Safety_Net (T.Safety_Net);

      if T.Index > T.Elements.Items'Last then
         return False;
      else
         Element := T.Elements.Items (T.Index);
         T.Index := T.Index + 1;
         return True;
      end if;
   end Next;

   -------------
   -- Inc_Ref --
   -------------

   procedure Inc_Ref (T : Bare_R_F_L_X_Node_Iterator_Access) is
   begin
      if T /= null and then T.Ref_Count >= 0 then
         T.Ref_Count := T.Ref_Count + 1;
      end if;
   end Inc_Ref;

   -------------
   -- Dec_Ref --
   -------------

   procedure Dec_Ref (T : in out Bare_R_F_L_X_Node_Iterator_Access) is
   begin
      if T = null or else T.Ref_Count < 0 then
         return;
      end if;

      if T.Ref_Count = 1 then
         Dec_Ref (T.Elements);
         Free (T);
      else
         T.Ref_Count := T.Ref_Count - 1;
         T := null;
      end if;
   end Dec_Ref;

      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (A : Bare_R_F_L_X_Node_Iterator_Access) return String is
      begin
         return "<Iterator of RFLXNode, index="
                & A.Index'Image & ">";
      end Trace_Image;


         

   

   ----------
   -- Next --
   ----------

   function Next
     (T       : Internal_Entity_Iterator_Access;
      Element : out Internal_Entity) return Boolean is
   begin
      if T = null then
         raise Property_Error with "null access dereference";
      end if;
      Check_Safety_Net (T.Safety_Net);

      if T.Index > T.Elements.Items'Last then
         return False;
      else
         Element := T.Elements.Items (T.Index);
         T.Index := T.Index + 1;
         return True;
      end if;
   end Next;

   -------------
   -- Inc_Ref --
   -------------

   procedure Inc_Ref (T : Internal_Entity_Iterator_Access) is
   begin
      if T /= null and then T.Ref_Count >= 0 then
         T.Ref_Count := T.Ref_Count + 1;
      end if;
   end Inc_Ref;

   -------------
   -- Dec_Ref --
   -------------

   procedure Dec_Ref (T : in out Internal_Entity_Iterator_Access) is
   begin
      if T = null or else T.Ref_Count < 0 then
         return;
      end if;

      if T.Ref_Count = 1 then
         Dec_Ref (T.Elements);
         Free (T);
      else
         T.Ref_Count := T.Ref_Count - 1;
         T := null;
      end if;
   end Dec_Ref;

      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (A : Internal_Entity_Iterator_Access) return String is
      begin
         return "<Iterator of RFLXNode.entity, index="
                & A.Index'Image & ">";
      end Trace_Image;


         

   

   ----------
   -- Next --
   ----------

   function Next
     (T       : Internal_Inner_Env_Assoc_Iterator_Access;
      Element : out Internal_Inner_Env_Assoc) return Boolean is
   begin
      if T = null then
         raise Property_Error with "null access dereference";
      end if;
      Check_Safety_Net (T.Safety_Net);

      if T.Index > T.Elements.Items'Last then
         return False;
      else
         Element := T.Elements.Items (T.Index);
         T.Index := T.Index + 1;
         return True;
      end if;
   end Next;

   -------------
   -- Inc_Ref --
   -------------

   procedure Inc_Ref (T : Internal_Inner_Env_Assoc_Iterator_Access) is
   begin
      if T /= null and then T.Ref_Count >= 0 then
         T.Ref_Count := T.Ref_Count + 1;
      end if;
   end Inc_Ref;

   -------------
   -- Dec_Ref --
   -------------

   procedure Dec_Ref (T : in out Internal_Inner_Env_Assoc_Iterator_Access) is
   begin
      if T = null or else T.Ref_Count < 0 then
         return;
      end if;

      if T.Ref_Count = 1 then
         Dec_Ref (T.Elements);
         Free (T);
      else
         T.Ref_Count := T.Ref_Count - 1;
         T := null;
      end if;
   end Dec_Ref;

      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (A : Internal_Inner_Env_Assoc_Iterator_Access) return String is
      begin
         return "<Iterator of InnerEnvAssoc, index="
                & A.Index'Image & ">";
      end Trace_Image;



   ---------
   -- "<" --
   ---------

   function "<" (Left, Right : Internal_Unit) return Boolean is
   begin
      return Left.Filename < Right.Filename;
   end "<";


   -------------------
   -- Solve_Wrapper --
   -------------------

   function Solve_Wrapper
     (R            : Solver.Relation;
      Context_Node : Bare_R_F_L_X_Node) return Boolean is
   begin
      if Context_Node /= null and then Langkit_Support.Adalog.Debug.Debug then
         Assign_Names_To_Logic_Vars (Context_Node);
      end if;

      begin
         return Solver.Solve_First
           (R, Timeout => Context_Node.Unit.Context.Logic_Resolution_Timeout);
      exception
         when Langkit_Support.Adalog.Early_Binding_Error =>
            Raise_Property_Exception
              (Context_Node,
               Property_Error'Identity,
               "invalid equation for logic resolution");
         when Langkit_Support.Adalog.Timeout_Error =>
            Raise_Property_Exception
              (Context_Node,
               Property_Error'Identity,
               "logic resolution timed out");
      end;
   end Solve_Wrapper;

   -------------
   -- Destroy --
   -------------

   procedure Destroy (Env : in out Lexical_Env_Access) is
      Mutable_Env : Lexical_Env :=
        (Wrap (Env), 0, Env.Kind, No_Generic_Unit, 0);
   begin
      Destroy (Mutable_Env);
      Env := null;
   end Destroy;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize
     (Self              : Bare_R_F_L_X_Node;
      Kind              : R_F_L_X_Node_Kind_Type;
      Unit              : Internal_Unit;
      Token_Start_Index : Token_Index;
      Token_End_Index   : Token_Index;
      Parent            : Bare_R_F_L_X_Node := null;
      Self_Env          : Lexical_Env := AST_Envs.Empty_Env) is
   begin
      pragma Unreferenced (Kind);
      Self.Parent := Parent;
      Self.Unit := Unit;

      Self.Token_Start_Index := Token_Start_Index;
      Self.Token_End_Index := Token_End_Index;

      Self.Self_Env := Self_Env;
      Self.Last_Attempted_Child := -1;

      

   end Initialize;

   --------------------
   -- Use_Direct_Env --
   --------------------

   procedure Use_Direct_Env (State : in out PLE_Node_State; Env : Lexical_Env)
   is
   begin
      State.Current_Env := Env;
      State.Current_NED := null;
   end Use_Direct_Env;

   -------------------
   -- Use_Named_Env --
   -------------------

   procedure Use_Named_Env
     (State   : in out PLE_Node_State;
      Context : Internal_Context;
      Name    : Symbol_Type) is
   begin
      State.Current_NED := Get_Named_Env_Descriptor (Context, Name);
      State.Current_Env := State.Current_NED.Env_With_Precedence;
   end Use_Named_Env;

   ---------------------
   -- Set_Initial_Env --
   ---------------------

   procedure Set_Initial_Env
     (Self         : Bare_R_F_L_X_Node;
      State        : in out PLE_Node_State;
      Env          : Internal_Designated_Env;
      DSL_Location : String) is
   begin
      case Env.Kind is
         when None =>
            Use_Direct_Env (State, Empty_Env);

         when Current_Env =>
            null;

         when Named_Env =>
            Use_Named_Env (State, Self.Unit.Context, Env.Env_Name);

         when Direct_Env =>

            --  Sanitize this environment value: make sure it's a non-foreign
            --  and primary environment.

            if Env.Direct_Env.Kind /= Static_Primary then
               Raise_Property_Exception
                 (Self,
                  Property_Error'Identity,
                  "Cannot set an env that is not static-primary as the"
                  & " initial env");

            elsif Is_Foreign_Strict (Env.Direct_Env, Self) then
               Raise_Property_Exception
                 (Self,
                  Property_Error'Identity,
                  "unsound foreign environment in SetInitialEnv ("
                  & DSL_Location & ")");
            end if;
            Use_Direct_Env (State, Env.Direct_Env);
      end case;
   end Set_Initial_Env;

   ----------------
   -- Add_To_Env --
   ----------------

   procedure Add_To_Env
     (Self         : Bare_R_F_L_X_Node;
      State        : PLE_Node_State;
      Key          : Symbol_Type;
      Value        : Bare_R_F_L_X_Node;
      Md           : Internal_Metadata;
      Resolver     : Entity_Resolver;
      Dest_Env     : Internal_Designated_Env;
      DSL_Location : String)
   is
      Context    : constant Internal_Context := Self.Unit.Context;
      Root_Scope : Lexical_Env renames Context.Root_Scope;
      --  Shortcuts

      Actual_Dest_Env : Lexical_Env;
      Dest_NED        : Named_Env_Descriptor_Access;
      --  Description for the destination environment
   begin
      --  Skip the env addition if explicitly requested

      if Key = null
         or else Value = null
         or else (case Dest_Env.Kind is
                  when None        => True,
                  when Current_Env => False,
                  when Named_Env   => Dest_Env.Env_Name = null,
                  when Direct_Env  => Dest_Env.Direct_Env = Empty_Env)
      then
         return;
      end if;

      if Value.Unit /= Self.Unit then
         Raise_Property_Exception
           (Self,
            Property_Error'Identity,
            "Cannot add_to_env an AST node that comes from another analysis"
            & " unit");
      end if;

      

      --  Then determine the destination environment

      case Dest_Env.Kind is
         when None =>
            raise Program_Error with "unreachable code";

         when Current_Env =>
            --  Just use the current environment
            Dest_NED := State.Current_NED;
            Actual_Dest_Env := State.Current_Env;

         when Named_Env =>
            --  There is an environment name: just lookup the corresponding
            --  NED/env.
            Dest_NED := Get_Named_Env_Descriptor (Context, Dest_Env.Env_Name);
            Actual_Dest_Env := Dest_NED.Env_With_Precedence;

         when Direct_Env =>
            --  There is an explicit destination environment
            Dest_NED := null;
            Actual_Dest_Env := Dest_Env.Direct_Env;
      end case;

      --  Sanitize it

      if Actual_Dest_Env.Kind /= Static_Primary then
         Raise_Property_Exception
           (Self,
            Property_Error'Identity,
            "Cannot add elements to a lexical env that is not static-primary");

      elsif
         --  Since lexical envs need to sort the foreign nodes they contain,
         --  and that the total order on nodes is not defined for synthetic
         --  nodes, it is not possible to add a synthetic node to a foreign
         --  lexical environment.
         --
         --  This reasoning applies to environments that belong to foreign
         --  units, but also to the root environment.
         Is_Foreign (Actual_Dest_Env, Self) and then Is_Synthetic (Value)
      then
         Raise_Property_Exception
           (Self,
            Property_Error'Identity,
            "Cannot add a synthetic node to a lexical env from another"
            & " analysis unit");

      elsif
         --  Reject direct references to foreign destination environments.
         --
         --  This is an attempt at identifying uses of the unsound relocation
         --  mechanism (as opposed to named environments), so this applies to
         --  all foreign environments (root scope included).
         DSL_Location'Length > 0
         and then Dest_Env.Kind = Direct_Env
         and then Is_Foreign_Strict (Actual_Dest_Env, Self)
      then
         Raise_Property_Exception
           (Self,
            Property_Error'Identity,
            "unsound foreign environment in AddToEnv (" & DSL_Location & ")");
      end if;

      --  Now that everything is sanitized, we can proceed with the actual
      --  key/value pair addition. Note that this does nothing if
      --  Actual_Dest_Env ended up empty.
      Add (Actual_Dest_Env, Key, Value, Md, Resolver);

      --  If we're adding the element to an environment by env name, we must
      --  register this association in two places: in the target named env
      --  entry, and in Value's unit.
      if Dest_NED /= null then
         declare
            use NED_Assoc_Maps;

            FN    : Map renames Dest_NED.Foreign_Nodes;
            Dummy : Boolean;
            Cur   : Cursor;
         begin
            FN.Insert (Key      => Key,
                       New_Item => Internal_Map_Node_Vectors.Empty_Vector,
                       Position => Cur,
                       Inserted => Dummy);
            declare
               V : Internal_Map_Node_Vectors.Vector renames
                  FN.Reference (Cur);
            begin
               V.Append ((Value, Md, Resolver));
            end;
         end;
         Value.Unit.Exiled_Entries_In_NED.Append ((Dest_NED, Key, Value));

      --  Otherwise, if we're adding the element to an environment that belongs
      --  to a different unit, or to the root scope, then...
      elsif Is_Foreign_Not_Empty (Actual_Dest_Env, Self) then
         --  Add the Key/Value association to the list of entries contained in
         --  other units, so we can remove them when reparsing Value's unit.
         Value.Unit.Exiled_Entries.Append ((Actual_Dest_Env, Key, Value));

         if Actual_Dest_Env /= Root_Scope then
            --  Add Val to the list of foreign nodes that Actual_Dest_Env's
            --  unit contains, so that when that unit is reparsed, we can call
            --  Add_To_Env again on those nodes.
            Convert_Unit (Actual_Dest_Env.Owner).Foreign_Nodes.Append
              ((Value, Self.Unit));
         end if;
      end if;
   end Add_To_Env;

   -------------
   -- Ref_Env --
   -------------

   procedure Ref_Env
     (Self                : Bare_R_F_L_X_Node;
      Dest_Env            : Lexical_Env;
      Ref_Env_Nodes       : in out Bare_R_F_L_X_Node_Array_Access;
      Resolver            : Lexical_Env_Resolver;
      Kind                : Ref_Kind;
      Cats                : Ref_Categories;
      Shed_Rebindings     : Boolean) is
   begin
      for N of Ref_Env_Nodes.Items loop
         if N /= null then
            if N.Unit /= Self.Unit then
               Raise_Property_Exception
                 (Self,
                  Property_Error'Identity,
                  "attempt to add a referenced environment to a foreign unit");
            end if;
            Reference (Dest_Env, N, Resolver, Kind, Cats, Shed_Rebindings);
         end if;
      end loop;
      Dec_Ref (Ref_Env_Nodes);
   end Ref_Env;

   -------------
   -- Add_Env --
   -------------

   procedure Add_Env
     (Self              : Bare_R_F_L_X_Node;
      State             : in out PLE_Node_State;
      No_Parent         : Boolean;
      Transitive_Parent : Boolean;
      Names             : in out Symbol_Type_Array_Access)
   is
      Parent_From_Name : constant Boolean := State.Current_NED /= null;
      --  Does the parent environment comes from a named environment lookup?

      --  Determine the parent of this new environment:
      --
      --  (1) no parent if requested;
      --  (2) the current environment as the static parent if it comes from a
      --      named env lookup or if it is not foreign (or is the empty/root
      --      environment).
      Parent : constant Lexical_Env :=
        (if No_Parent
         then Null_Lexical_Env
         else State.Current_Env);
   begin
      --  Create the environment itself
      Self.Self_Env := Create_Static_Lexical_Env
        (Parent            => Parent,
         Node              => Self,
         Transitive_Parent => Transitive_Parent);

      --  If the parent of this new environment comes from a named environment
      --  lookup, register this new environment so that its parent is updated
      --  when the precence for this named environment changes.
      if Parent_From_Name then
         declare
            NED : constant Named_Env_Descriptor_Access := State.Current_NED;
         begin
            Self.Unit.Exiled_Envs.Append ((NED, Self.Self_Env));
            NED.Foreign_Envs.Insert (Self, Self.Self_Env);
         end;
      end if;

      --  From now on, the current environment is Self.Self_Env, with a direct
      --  access to it. It does not go through the env naming scheme, since
      --  only this node and its children (i.e. non-foreign nodes) will access
      --  it as a "current" environment during PLE.
      Use_Direct_Env (State, Self.Self_Env);

      --  Register the environment we just created on all the requested names
      if Names /= null then
         declare
            Context   : constant Internal_Context := Self.Unit.Context;
            Env       : constant Lexical_Env := Self.Self_Env;
            NENU      : NED_Maps.Map renames
               State.Unit_State.Named_Envs_Needing_Update;
         begin
            for N of Names.Items loop
               Register_Named_Env (Context, N, Env, NENU);
            end loop;
            Dec_Ref (Names);
         end;
      end if;
   end Add_Env;

   ---------------------
   -- Pre_Env_Actions --
   ---------------------

   procedure Pre_Env_Actions
     (Self            : Bare_R_F_L_X_Node;
      State           : in out PLE_Node_State;
      Add_To_Env_Only : Boolean := False) is
   begin

      
   

   case Self.Kind is
      when others =>  null; 
   end case;


         pragma Unreferenced (State, Add_To_Env_Only);
   end Pre_Env_Actions;

   ----------------------
   -- Post_Env_Actions --
   ----------------------

   procedure Post_Env_Actions
     (Self : Bare_R_F_L_X_Node; State : in out PLE_Node_State) is
   begin
      
   

   case Self.Kind is
      when others =>  null; 
   end case;


         pragma Unreferenced (State);
   end Post_Env_Actions;

   ----------------
   -- Get_Symbol --
   ----------------

   function Get_Symbol
     (Node : Bare_R_F_L_X_Node) return Symbol_Type is
   begin
      if Node = null then
         Raise_Property_Exception
           (Node,
            Property_Error'Identity,
            "cannot get the symbol of a null node");
      end if;
      return Get_Symbol (Token (Node, Node.Token_Start_Index));
   end Get_Symbol;

   ----------
   -- Text --
   ----------

   function Text
     (Node : Bare_R_F_L_X_Node) return Text_Type
   is
   begin
      if Node = null then
         Raise_Property_Exception
           (Node,
            Property_Error'Identity,
            "cannot get the text of a null node");
      end if;

      declare
         Start_T : constant Token_Reference :=
            Token (Node, Node.Token_Start_Index);
         End_T   : constant Token_Reference :=
            Token (Node, Node.Token_End_Index);
      begin
         --  No text is associated to synthetic and ghost nodes

         if Is_Synthetic (Node) then
            return "";
         end if;

         if Is_Ghost (Node) then
            return "";
         end if;

         return Text (Start_T, End_T);
      end;
   end Text;

   ---------------------
   -- Is_Visible_From --
   ---------------------

   function Is_Visible_From
     (Self                     : Bare_R_F_L_X_Node;
      Referenced_Env, Base_Env : Lexical_Env) return Boolean
   is
      Referenced_Unit : constant Internal_Unit :=
         Convert_Unit (Referenced_Env.Owner);
      Base_Unit       : constant Internal_Unit :=
         Convert_Unit (Base_Env.Owner);
   begin
      if Referenced_Unit = null then
         Raise_Property_Exception
           (Self,
            Property_Error'Identity,
            "referenced environment does not belong to any analysis unit");
      elsif Base_Unit = null then
         Raise_Property_Exception
           (Self,
            Property_Error'Identity,
            "base environment does not belong to any analysis unit");
      end if;
      return Is_Referenced_From (Referenced_Unit, Base_Unit);
   end Is_Visible_From;

   ----------
   -- Unit --
   ----------

   function Unit (Node : Bare_R_F_L_X_Node) return Internal_Unit is
   begin
      return Node.Unit;
   end Unit;

   function Lookup_Internal
     (Node : Bare_R_F_L_X_Node;
      Sloc : Source_Location) return Bare_R_F_L_X_Node;
   procedure Lookup_Relative
     (Node       : Bare_R_F_L_X_Node;
      Sloc       : Source_Location;
      Position   : out Relative_Position;
      Node_Found : out Bare_R_F_L_X_Node);
   --  Implementation helpers for the looking up process

   -----------------
   -- Set_Parents --
   -----------------

   procedure Set_Parents
     (Node, Parent : Bare_R_F_L_X_Node)
   is
   begin
      if Node = null then
         return;
      end if;

      Node.Parent := Bare_R_F_L_X_Node (Parent);

      for I in 1 .. Children_Count (Node) loop
         Set_Parents (Child (Node, I), Node);
      end loop;
   end Set_Parents;

   -------------
   -- Destroy --
   -------------

   procedure Destroy (Node : Bare_R_F_L_X_Node) is
   begin
      if Node = null then
         return;
      end if;

      Free_User_Fields (Node);
      for I in 1 .. Children_Count (Node) loop
         Destroy (Child (Node, I));
      end loop;
   end Destroy;

   -----------
   -- Child --
   -----------

   function Child (Node  : Bare_R_F_L_X_Node;
                   Index : Positive) return Bare_R_F_L_X_Node
   is
      Result          : Bare_R_F_L_X_Node;
      Index_In_Bounds : Boolean;
   begin
      Get_Child (Node, Index, Index_In_Bounds, Result);
      return Result;
   end Child;

   --------------
   -- Traverse --
   --------------

   function Traverse
     (Node  : Bare_R_F_L_X_Node;
      Visit : access function (Node : Bare_R_F_L_X_Node)
              return Visit_Status)
     return Visit_Status
   is
      Status : Visit_Status := Into;

   begin
      if Node /= null then
         Status := Visit (Node);

         --  Skip processing the child nodes if the returned status is Over
         --  or Stop. In the former case the previous call to Visit has taken
         --  care of processing the needed childs, and in the latter case we
         --  must immediately stop processing the tree.

         if Status = Into then
            for I in 1 .. Children_Count (Node) loop
               declare
                  Cur_Child : constant Bare_R_F_L_X_Node :=
                     Child (Node, I);

               begin
                  if Cur_Child /= null then
                     Status := Traverse (Cur_Child, Visit);
                     exit when Status /= Into;
                  end if;
               end;
            end loop;
         end if;
      end if;

      if Status = Stop then
         return Stop;

      --  At this stage the Over status has no sense and we just continue
      --  processing the tree.

      else
         return Into;
      end if;
   end Traverse;

   --------------
   -- Traverse --
   --------------

   procedure Traverse
     (Node  : Bare_R_F_L_X_Node;
      Visit : access function (Node : Bare_R_F_L_X_Node)
                               return Visit_Status)
   is
      Result_Status : Visit_Status;
      pragma Unreferenced (Result_Status);
   begin
      Result_Status := Traverse (Node, Visit);
   end Traverse;

   ------------------------
   -- Traverse_With_Data --
   ------------------------

   function Traverse_With_Data
     (Node  : Bare_R_F_L_X_Node;
      Visit : access function (Node : Bare_R_F_L_X_Node;
                               Data : in out Data_Type)
                               return Visit_Status;
      Data  : in out Data_Type)
      return Visit_Status
   is
      function Helper (Node : Bare_R_F_L_X_Node) return Visit_Status;

      ------------
      -- Helper --
      ------------

      function Helper (Node : Bare_R_F_L_X_Node) return Visit_Status is
      begin
         return Visit (Node, Data);
      end Helper;

      Saved_Data : Data_Type;
      Result     : Visit_Status;

   begin
      if Reset_After_Traversal then
         Saved_Data := Data;
      end if;
      Result := Traverse (Node, Helper'Access);
      if Reset_After_Traversal then
         Data := Saved_Data;
      end if;
      return Result;
   end Traverse_With_Data;

   ----------------
   -- Sloc_Range --
   ----------------

   function Sloc_Range
     (Node : Bare_R_F_L_X_Node) return Source_Location_Range
   is
      type Token_Anchor is (T_Start, T_End);
      type Token_Pos is record
         Pos    : Token_Index;
         Anchor : Token_Anchor;
      end record;

      TDH                    : Token_Data_Handler renames Node.Unit.TDH;
      Token_Start, Token_End : Token_Pos;

      function Get (Index : Token_Index) return Stored_Token_Data is
        (Get_Token (TDH, Index));

      function Sloc (T : Token_Pos) return Source_Location is
        (if T.Anchor = T_Start
         then Sloc_Start (TDH, Get (T.Pos))
         else Sloc_End (TDH, Get (T.Pos)));

   begin
      if Is_Synthetic (Node) then
         return Sloc_Range (Node.Parent);
      end if;

      if Is_Ghost (Node) then
         Token_Start := (if Node.Token_Start_Index = 1
                         then (1, T_Start)
                         else (Node.Token_Start_Index - 1, T_End));
         Token_End := Token_Start;
      else
         Token_Start := (Node.Token_Start_Index, T_Start);
         Token_End := (Node.Token_End_Index, T_End);
      end if;

      if Snaps_At_Start (Node)
         and then not Is_Ghost (Node)
         and then Token_Start.Pos /= 1
      then
         Token_Start := (Token_Start.Pos - 1, T_End);
      end if;

      if Snaps_At_End (Node) and then Token_End.Pos /= Last_Token (TDH) then
         Token_End := (Token_End.Pos + 1, T_Start);
      end if;

      return Make_Range (Sloc (Token_Start), Sloc (Token_End));
   end Sloc_Range;

   ------------
   -- Lookup --
   ------------

   function Lookup
     (Node : Bare_R_F_L_X_Node;
      Sloc : Source_Location) return Bare_R_F_L_X_Node
   is
      Position : Relative_Position;
      Result   : Bare_R_F_L_X_Node;
   begin
      if Sloc = No_Source_Location then
         return null;
      end if;

      Lookup_Relative
        (Bare_R_F_L_X_Node (Node), Sloc, Position, Result);
      return Result;
   end Lookup;

   ---------------------
   -- Lookup_Internal --
   ---------------------

   function Lookup_Internal
     (Node : Bare_R_F_L_X_Node;
      Sloc : Source_Location) return Bare_R_F_L_X_Node
   is
      --  For this implementation helper (i.e. internal primitive), we can
      --  assume that all lookups fall into this node's sloc range.
      pragma Assert (Compare (Sloc_Range (Node), Sloc) = Inside);

      Children : constant Internal_Bare_R_F_L_X_Node_Array :=
         Implementation.Children (Node);
      Pos      : Relative_Position;
      Result   : Bare_R_F_L_X_Node;
   begin
      --  Look for a child node that contains Sloc (i.e. return the most
      --  precise result).

      for Child of Children loop
         --  Note that we assume here that child nodes are ordered so that the
         --  first one has a sloc range that is before the sloc range of the
         --  second child node, etc.

         if Child /= null then
            Lookup_Relative (Child, Sloc, Pos, Result);
            case Pos is
               when Before =>
                   --  If this is the first node, Sloc is before it, so we can
                   --  stop here.  Otherwise, Sloc is between the previous
                   --  child node and the next one...  so we can stop here,
                   --  too.
                   return Node;

               when Inside =>
                   return Result;

               when After =>
                   --  Sloc is after the current child node, so see with the
                   --  next one.
                   null;
            end case;
         end if;
      end loop;

      --  If we reach this point, we found no children that covers Sloc, but
      --  Node still covers it (see the assertion).
      return Node;
   end Lookup_Internal;

   -------------
   -- Compare --
   -------------

   function Compare
     (Node : Bare_R_F_L_X_Node;
      Sloc : Source_Location) return Relative_Position is
   begin
      return Compare (Sloc_Range (Node), Sloc);
   end Compare;

   ---------------------
   -- Lookup_Relative --
   ---------------------

   procedure Lookup_Relative
     (Node       : Bare_R_F_L_X_Node;
      Sloc       : Source_Location;
      Position   : out Relative_Position;
      Node_Found : out Bare_R_F_L_X_Node)
   is
      Result : constant Relative_Position :=
        Compare (Node, Sloc);
   begin
      Position := Result;
      Node_Found := (if Result = Inside
                     then Lookup_Internal (Node, Sloc)
                     else null);
   end Lookup_Relative;

   -------------
   -- Compare --
   -------------

   function Compare
     (Self, Left, Right : Bare_R_F_L_X_Node;
      Relation          : Comparison_Relation) return Boolean
   is
      LS, RS : Source_Location;
   begin
      if Left = null or else Right = null or else Left.Unit /= Right.Unit then
         Raise_Property_Exception
           (Self,
            Property_Error'Identity,
            "invalid node comparison");
      end if;

      LS := Start_Sloc (Sloc_Range (Left));
      RS := Start_Sloc (Sloc_Range (Right));
      return (case Relation is
              when Langkit_Support.Types.Less_Than        => LS < RS,
              when Langkit_Support.Types.Less_Or_Equal    => LS <= RS,
              when Langkit_Support.Types.Greater_Than     => LS > RS,
              when Langkit_Support.Types.Greater_Or_Equal => LS >= RS);
   end Compare;

   --------------
   -- Children --
   --------------

   function Children
     (Node : Bare_R_F_L_X_Node) return Internal_Bare_R_F_L_X_Node_Array
   is
      First : constant Integer := Bare_R_F_L_X_Node_Vectors.Index_Type'First;
      Last  : constant Integer := First + Children_Count (Node) - 1;
   begin
      return A : Internal_Bare_R_F_L_X_Node_Array (First .. Last)
      do
         for I in First .. Last loop
            A (I) := Child (Node, I);
         end loop;
      end return;
   end Children;

   function Children
     (Node : Bare_R_F_L_X_Node) return Bare_R_F_L_X_Node_Array_Access
   is
      C : Internal_Bare_R_F_L_X_Node_Array := Children (Node);
   begin
      return Ret : Bare_R_F_L_X_Node_Array_Access :=
         Create_Bare_R_F_L_X_Node_Array (C'Length)
      do
         Ret.Items := C;
      end return;
   end Children;

   ---------
   -- Get --
   ---------

   function Get
     (Self    : Bare_R_F_L_X_Node;
      Node    : Bare_R_F_L_X_Node_Base_List;
      Index   : Integer;
      Or_Null : Boolean := False) return Bare_R_F_L_X_Node
   is
      function Length (Node : Bare_R_F_L_X_Node_Base_List) return Natural
      is (Node.Count);
      --  Wrapper around the Length primitive to get the compiler happy for the
      --  the package instantiation below.

      function Absolute_Get
        (L     : Bare_R_F_L_X_Node_Base_List;
         Index : Integer) return Bare_R_F_L_X_Node
      is (L.Nodes.all (Index + 1));
      --  L.Nodes is 1-based but Index is 0-based

      function Relative_Get is new Langkit_Support.Relative_Get
        (Item_Type     => Bare_R_F_L_X_Node,
         Sequence_Type => Bare_R_F_L_X_Node_Base_List,
         Length        => Length,
         Get           => Absolute_Get);

      Result : Bare_R_F_L_X_Node;
   begin
      if Node = null and then Or_Null then
         return null;
      elsif Relative_Get (Node, Index, Result) then
         return Result;
      elsif Or_Null then
         return null;
      else
         Raise_Property_Exception
           (Self, Property_Error'Identity, "out-of-bounds AST list access");
      end if;
   end Get;

   ---------------
   -- PP_Trivia --
   ---------------

   procedure PP_Trivia
     (Node        : Bare_R_F_L_X_Node;
      Line_Prefix : String := "")
   is
      Children_Prefix : constant String := Line_Prefix & "|  ";
   begin
      if Node = null then
         Put_Line (Line_Prefix & "None");
         return;
      end if;
      Put_Line (Line_Prefix & Kind_Name (Node));
      for C of Children_And_Trivia (Node) loop
         case C.Kind is
            when Trivia =>
               Put_Line (Children_Prefix & Image (Text (C.Trivia)));
            when Child =>
               PP_Trivia (C.Node, Children_Prefix);
         end case;
      end loop;
   end PP_Trivia;

   --------------------------
   -- Populate_Lexical_Env --
   --------------------------

   function Populate_Lexical_Env (Node : Bare_R_F_L_X_Node) return Boolean is

      Context    : constant Internal_Context := Node.Unit.Context;
      Unit_State : aliased PLE_Unit_State := (Named_Envs_Needing_Update => <>);
      Root_State : constant PLE_Node_State :=
        (Unit_State  => Unit_State'Unchecked_Access,
         Current_Env => Context.Root_Scope,
         Current_NED => null);

      function Populate_Internal
        (Node         : Bare_R_F_L_X_Node;
         Parent_State : PLE_Node_State) return Boolean;
      --  Do the lexical env population on Node and recurse on its children

      procedure Register_Foreign_Env
        (Node : Bare_R_F_L_X_Node; State : PLE_Node_State);
      --  Given a node and its PLE state, register Node.Self_Env as being
      --  initialized through the named environment mechanism, if that's indeed
      --  the case. Do nothing otherwise.

      -----------------------
      -- Populate_Internal --
      -----------------------

      function Populate_Internal
        (Node         : Bare_R_F_L_X_Node;
         Parent_State : PLE_Node_State) return Boolean
      is
         Result : Boolean := False;
         State  : PLE_Node_State := Parent_State;
      begin
         if Node = null then
            return Result;
         end if;

         --  By default (i.e. unless env actions add a new env), the
         --  environment we store in Node is the current one.
         Node.Self_Env := State.Current_Env;

         --  Run pre/post actions, and run PLE on children in between. Make
         --  sure we register the potential foreign Node.Self_Env environment
         --  at the end, even when an exception interrupts PLE to keep the
         --  state consistent.
         begin
            Pre_Env_Actions (Node, State);
            if State.Current_Env /= Null_Lexical_Env then
               Node.Self_Env := State.Current_Env;
               Register_Foreign_Env (Node, State);
            end if;

            --  Call recursively on children
            for I in First_Child_Index (Node) .. Last_Child_Index (Node) loop
               Result := Populate_Internal
                 (Child (Node, I), State) or else Result;
            end loop;

            Post_Env_Actions (Node, State);
         exception
            when Exc : Property_Error =>
               if PLE_Errors_Trace.Is_Active then
                   GNATCOLL.Traces.Trace
                     (PLE_Errors_Trace,
                      "Exception raised during PLE "
                      & Ada.Exceptions.Exception_Name (Exc) & " : "
                      & Ada.Exceptions.Exception_Message (Exc));
                   GNATCOLL.Traces.Trace
                     (PLE_Errors_Trace,
                      GNAT.Traceback.Symbolic.Symbolic_Traceback (Exc));
               end if;
               Register_Foreign_Env (Node, State);
               return True;
         end;

         return Result;
      end Populate_Internal;

      --------------------------
      -- Register_Foreign_Env --
      --------------------------

      procedure Register_Foreign_Env
        (Node : Bare_R_F_L_X_Node; State : PLE_Node_State) is
      begin
         if State.Current_NED /= null then
            State.Current_NED.Nodes_With_Foreign_Env.Insert (Node);
            Node.Unit.Nodes_With_Foreign_Env.Insert (Node, State.Current_NED);
         end if;
      end Register_Foreign_Env;

   begin
      --  This is intended to be called on the root node only (when there is no
      --  PLE root) or on a PLE root (child of the root node with a specific
      --  kind).
      if
         Node.Parent /= null
      then
         raise Program_Error;
      end if;

      return Result : constant Boolean :=
         Populate_Internal (Node, Root_State)
      do
         Update_Named_Envs (Context, Unit_State.Named_Envs_Needing_Update);
      end return;
   end Populate_Lexical_Env;

   ------------------------------
   -- AST_Envs_Node_Text_Image --
   ------------------------------

   function AST_Envs_Node_Text_Image
     (Node  : Bare_R_F_L_X_Node;
      Short : Boolean := True) return Text_Type is
   begin
      if Short then
         if Node = null then
            return "null";
         end if;
         return To_Text (Basename (Node.Unit))
           & ":" & To_Text (Image (Start_Sloc (Sloc_Range (Node))));
      else
         return Short_Text_Image (Node);
      end if;
   end AST_Envs_Node_Text_Image;

   -------------------
   -- Is_Rebindable --
   -------------------

   function Is_Rebindable (Node : Bare_R_F_L_X_Node) return Boolean is
   begin
      
         pragma Unreferenced (Node);
         return True;
   end Is_Rebindable;

   -----------------------
   -- Acquire_Rebinding --
   -----------------------

   function Acquire_Rebinding
     (Node             : Bare_R_F_L_X_Node;
      Parent           : Env_Rebindings;
      Old_Env, New_Env : Lexical_Env) return Env_Rebindings
   is
      Result    : Env_Rebindings;
      Available : Env_Rebindings_Vectors.Vector renames
         Node.Unit.Context.Available_Rebindings;
   begin
      --  Use an existing and available Env_Rebindings_Type record for Node's
      --  Context, otherwise allocate a new rebinding.
      Result := (if Available.Is_Empty
                 then new Env_Rebindings_Type'(Version => 0, others => <>)
                 else Available.Pop);

      Result.Parent := Parent;
      Result.Old_Env := Old_Env;
      Result.New_Env := New_Env;
      Result.Children := Env_Rebindings_Vectors.Empty_Vector;
      return Result;
   end Acquire_Rebinding;

   -----------------------
   -- Release_Rebinding --
   -----------------------

   procedure Release_Rebinding (Self : in out Env_Rebindings) is
      Available : Env_Rebindings_Vectors.Vector renames
         Unwrap (Self.Old_Env).Node.Unit.Context.Available_Rebindings;
   begin
      --  Bumping the version number, to invalidate existing references to
      --  Self.
      Self.Version := Self.Version + 1;

      Self.Children.Destroy;
      Available.Append (Self);
      Self := null;
   end Release_Rebinding;

   ------------------------
   -- Register_Rebinding --
   ------------------------

   procedure Register_Rebinding
     (Node : Bare_R_F_L_X_Node; Rebinding : Env_Rebindings) is
   begin
      Node.Unit.Rebindings.Append (Rebinding);
   end Register_Rebinding;

   --------------------
   -- Element_Parent --
   --------------------

   function Element_Parent
     (Node : Bare_R_F_L_X_Node) return Bare_R_F_L_X_Node
   is (Node.Parent);

   ---------------
   -- Node_Unit --
   ---------------

   function Node_Unit (Node : Bare_R_F_L_X_Node) return Generic_Unit_Ptr is
   begin
      return Convert_Unit (Node.Unit);
   end Node_Unit;

   ----------
   -- Hash --
   ----------

   function Hash (Node : Bare_R_F_L_X_Node) return Hash_Type
   is
      function H is new Hash_Access
        (Root_Node_Record, Bare_R_F_L_X_Node);
   begin
      return H (Node);
   end Hash;

      function Hash (B : Boolean) return Hash_Type is (Boolean'Pos (B));





   ------------------------
   -- Named environments --
   ------------------------

   ---------
   -- Add --
   ---------

   procedure Add
     (Self : in out NED_Assoc_Maps.Map;
      Key  : Symbol_Type;
      Node : AST_Envs.Internal_Map_Node)
   is
      use NED_Assoc_Maps;

      Pos   : Cursor;
      Dummy : Boolean;
   begin
      --  Make sure there is a vector entry for Key
      Self.Insert (Key, Internal_Map_Node_Vectors.Empty_Vector, Pos, Dummy);

      --  Append Node to that vector
      declare
         V : Internal_Map_Node_Vectors.Vector renames Self.Reference (Pos);
      begin
         V.Append (Node);
      end;
   end Add;

   ------------
   -- Remove --
   ------------

   procedure Remove
     (Self : in out NED_Assoc_Maps.Map;
      Key  : Symbol_Type;
      Node : Bare_R_F_L_X_Node)
   is
      use NED_Assoc_Maps;

      V : Internal_Map_Node_Vectors.Vector renames Self.Reference (Key);
   begin
      --  Remove the (assumed unique) entry in V whose node is Node. The order
      --  of items in V is not significant, so we can use Pop for efficient
      --  removal. Do the traversal in reverse order for correctness.
      for I in reverse 1 .. V.Length loop
         if V.Get_Access (I).Node = Node then
            V.Pop (I);
            exit;
         end if;
      end loop;
   end Remove;

   ------------------------------
   -- Get_Named_Env_Descriptor --
   ------------------------------

   function Get_Named_Env_Descriptor
     (Context : Internal_Context;
      Name    : Symbol_Type) return Named_Env_Descriptor_Access
   is
      use NED_Maps;

      --  Look for an existing entry for Name
      Pos : constant Cursor := Context.Named_Envs.Find (Name);
   begin
      if Has_Element (Pos) then
         return Element (Pos);
      end if;

      --  There is no such entry: create one
      return Result : constant Named_Env_Descriptor_Access :=
         new Named_Env_Descriptor'
           (Name                   => Name,
            Envs                   => <>,
            Env_With_Precedence    => Empty_Env,
            Foreign_Nodes          => <>,
            Foreign_Envs           => <>,
            Nodes_With_Foreign_Env => <>)
      do
         Context.Named_Envs.Insert (Name, Result);
      end return;
   end Get_Named_Env_Descriptor;

   ------------------------
   -- Register_Named_Env --
   ------------------------

   procedure Register_Named_Env
     (Context                   : Internal_Context;
      Name                      : Symbol_Type;
      Env                       : Lexical_Env;
      Named_Envs_Needing_Update : in out NED_Maps.Map)
   is
      NED_Access : constant Named_Env_Descriptor_Access :=
         Get_Named_Env_Descriptor (Context, Name);
      NED        : Named_Env_Descriptor renames NED_Access.all;
      Node       : constant Bare_R_F_L_X_Node := Env_Node (Env);
   begin
      NED.Envs.Insert (Node, Env);
      Node.Unit.Named_Envs.Append ((Name, Env));

      --  If that insertion must change the env that has precedence, signal
      --  that NED requires an update.

      if NED.Envs.First_Element /= NED.Env_With_Precedence then
         Named_Envs_Needing_Update.Include (Name, NED_Access);
      end if;
   end Register_Named_Env;

   ----------------------
   -- Update_Named_Env --
   ----------------------

   procedure Update_Named_Envs
     (Context : Internal_Context; Named_Envs : NED_Maps.Map)
   is
      Require_Cache_Reset : Boolean := False;
   begin
      for Cur in Named_Envs.Iterate loop
         declare
            NE      : Named_Env_Descriptor renames NED_Maps.Element (Cur).all;
            New_Env : constant Lexical_Env :=
              (if NE.Envs.Is_Empty
               then Empty_Env
               else NE.Envs.First_Element);
         begin
            --  If there was an environment with precedence, remove its foreign
            --  nodes.
            if NE.Env_With_Precedence /= Empty_Env then
               for Cur in NE.Foreign_Nodes.Iterate loop
                  declare
                     Key   : constant Symbol_Type :=
                        NED_Assoc_Maps.Key (Cur);
                     Nodes : Internal_Map_Node_Vectors.Vector renames
                        NE.Foreign_Nodes.Reference (Cur);
                  begin
                     for N of Nodes loop
                        Remove (NE.Env_With_Precedence, Key, N.Node);
                     end loop;
                  end;
               end loop;
            end if;

            --  Now, set the new environment that has precedence
            NE.Env_With_Precedence := New_Env;

            --  Add the foreign nodes to the new environment with precedence,
            --  if any.
            for Cur in NE.Foreign_Nodes.Iterate loop
               declare
                  Key   : constant Symbol_Type :=
                     NED_Assoc_Maps.Key (Cur);
                  Nodes : Internal_Map_Node_Vectors.Vector renames
                     NE.Foreign_Nodes.Reference (Cur);
               begin
                  for N of Nodes loop
                     Add (New_Env, Key, N.Node, N.Md, N.Resolver);
                  end loop;
               end;
            end loop;

            --  Set the parent environment of all foreign environments
            for Cur in NE.Foreign_Envs.Iterate loop
               declare
                  Env : Lexical_Env_Record renames
                     Unwrap (Sorted_Env_Maps.Element (Cur)).all;
               begin
                  Env.Parent := New_Env;

                  --  We have updated the lexical env hierarchy (e.g. an env
                  --  which had no parent may have one now), so the cached
                  --  entries for queries that traveresed the old env hierarchy
                  --  need to be invalidated.
                  Require_Cache_Reset := True;
               end;
            end loop;

            --  Update nodes whose environment was the old env with precedence
            for N of NE.Nodes_With_Foreign_Env loop
               N.Self_Env := New_Env;
            end loop;
         end;
      end loop;
      if Require_Cache_Reset then
         Invalidate_Caches (Context, Invalidate_Envs => True);
      end if;
   end Update_Named_Envs;

   --------------------------
   -- Big integers wrapper --
   --------------------------

   ------------------------
   -- Create_Big_Integer --
   ------------------------

   function Create_Big_Integer
     (Image : String; Base : Integer := 10) return Big_Integer_Type
   is
      use GNATCOLL.GMP;
      use GNATCOLL.GMP.Integers;
   begin
      return new Big_Integer_Record'(Value     => Make (Image, Int (Base)),
                                     Ref_Count => 1);
   end Create_Big_Integer;

   ------------------------
   -- Create_Big_Integer --
   ------------------------

   function Create_Big_Integer
     (Big_Int : GNATCOLL.GMP.Integers.Big_Integer) return Big_Integer_Type
   is
      Result : constant Big_Integer_Type :=
         new Big_Integer_Record'(Value     => <>,
                                 Ref_Count => 1);
   begin
      Result.Value.Set (Big_Int);
      return Result;
   end Create_Big_Integer;

   ------------------------
   -- Create_Big_Integer --
   ------------------------

   function Create_Big_Integer (Int : Integer) return Big_Integer_Type is
      Result : constant Big_Integer_Type :=
         new Big_Integer_Record'(Value     => <>,
                                 Ref_Count => 1);
   begin
      Result.Value.Set (GNATCOLL.GMP.Long (Int));
      return Result;
   end Create_Big_Integer;

   -------------------------------
   -- Create_Public_Big_Integer --
   -------------------------------

   function Create_Public_Big_Integer
     (Big_Int : Big_Integer_Type) return GNATCOLL.GMP.Integers.Big_Integer is
   begin
      return Result : GNATCOLL.GMP.Integers.Big_Integer do
         Result.Set (Big_Int.Value);
      end return;
   end Create_Public_Big_Integer;

   -----------------
   -- Trace_Image --
   -----------------

   function Trace_Image (I : Big_Integer_Type) return String is
   begin
      return GNATCOLL.GMP.Integers.Image (I.Value);
   end Trace_Image;

   ----------------
   -- To_Integer --
   ----------------

   function To_Integer
     (Self    : Bare_R_F_L_X_Node;
      Big_Int : Big_Integer_Type) return Integer
   is
      Image : constant String := Big_Int.Value.Image;
   begin
      return Integer'Value (Image);
   exception
      when Constraint_Error =>
         Raise_Property_Exception
           (Self, Property_Error'Identity, "out of range big integer");
   end To_Integer;

   -------------
   -- Inc_Ref --
   -------------

   procedure Inc_Ref (Big_Int : Big_Integer_Type) is
   begin
      if Big_Int.Ref_Count /= -1 then
         Big_Int.Ref_Count := Big_Int.Ref_Count + 1;
      end if;
   end Inc_Ref;

   -------------
   -- Dec_Ref --
   -------------

   procedure Dec_Ref (Big_Int : in out Big_Integer_Type) is
      procedure Destroy is new Ada.Unchecked_Deallocation
        (Big_Integer_Record, Big_Integer_Type);
   begin
      if Big_Int = null or else Big_Int.Ref_Count = -1 then
         return;
      end if;

      Big_Int.Ref_Count := Big_Int.Ref_Count - 1;
      if Big_Int.Ref_Count = 0 then
         Destroy (Big_Int);
      end if;
   end Dec_Ref;

   ----------------
   -- Equivalent --
   ----------------

   function Equivalent (Left, Right : Big_Integer_Type) return Boolean is
      use type GNATCOLL.GMP.Integers.Big_Integer;
   begin
      return Left.Value = Right.Value;
   end Equivalent;

   ---------
   -- "<" --
   ---------

   function "<" (Left, Right : Big_Integer_Type) return Boolean is
      use type GNATCOLL.GMP.Integers.Big_Integer;
   begin
      return Left.Value < Right.Value;
   end "<";

   ----------
   -- "<=" --
   ----------

   function "<=" (Left, Right : Big_Integer_Type) return Boolean is
      use type GNATCOLL.GMP.Integers.Big_Integer;
   begin
      return Left.Value <= Right.Value;
   end "<=";

   ---------
   -- ">" --
   ---------

   function ">" (Left, Right : Big_Integer_Type) return Boolean is
      use type GNATCOLL.GMP.Integers.Big_Integer;
   begin
      return Left.Value > Right.Value;
   end ">";

   ----------
   -- ">=" --
   ----------

   function ">=" (Left, Right : Big_Integer_Type) return Boolean is
      use type GNATCOLL.GMP.Integers.Big_Integer;
   begin
      return Left.Value >= Right.Value;
   end ">=";

   ---------
   -- "+" --
   ---------

   function "+" (Left, Right : Big_Integer_Type) return Big_Integer_Type is
      use type GNATCOLL.GMP.Integers.Big_Integer;
   begin
      return Create_Big_Integer (Left.Value + Right.Value);
   end "+";

   ---------
   -- "-" --
   ---------

   function "-" (Left, Right : Big_Integer_Type) return Big_Integer_Type is
      use type GNATCOLL.GMP.Integers.Big_Integer;
   begin
      return Create_Big_Integer (Left.Value - Right.Value);
   end "-";

   ------------------
   -- Unit_Version --
   ------------------

   function Unit_Version (Unit : Generic_Unit_Ptr) return Version_Number is
   begin
      return Convert_Unit (Unit).Unit_Version;
   end Unit_Version;

   -------------------------
   -- Get_Context_Version --
   -------------------------

   function Get_Context_Version
     (Node : Bare_R_F_L_X_Node) return Version_Number is
   begin
      return Node.Unit.Context.Cache_Version;
   end Get_Context_Version;

   --------------------------
   -- Properties_May_Raise --
   --------------------------

   function Properties_May_Raise
     (Exc : Ada.Exceptions.Exception_Occurrence) return Boolean is
   begin
      return Ada.Exceptions.Exception_Identity (Exc) in
            Property_Error'Identity
      ;
   end Properties_May_Raise;

   ----------------------
   -- Short_Text_Image --
   ----------------------

   function Short_Text_Image (Self : Bare_R_F_L_X_Node) return Text_Type
   is
   begin
      if Self = null then
         return "None";
      end if;

      
   

   case Self.Kind is
      when others => 
         return "<" & To_Text (Kind_Name (Self))
                & " "
                & To_Text
                  (Ada.Directories.Simple_Name
                     (Get_Filename (Unit (Self))))
                & ":" & To_Text (Image (Sloc_Range (Self))) & ">";
      
   end case;

   end Short_Text_Image;

   --------------------
   -- Snaps_At_Start --
   --------------------

   function Snaps_At_Start (Self : Bare_R_F_L_X_Node) return Boolean is
   begin
      
   

   case Self.Kind is
      when others => 
         return False;
      
   end case;

   end Snaps_At_Start;

   ------------------
   -- Snaps_At_End --
   ------------------

   function Snaps_At_End (Self : Bare_R_F_L_X_Node) return Boolean is
   begin
      
   

   case Self.Kind is
      when others => 
         return Is_Incomplete (Self);
      
   end case;

   end Snaps_At_End;

   -------------
   -- Parents --
   -------------

   function Parents
     (Node      : Bare_R_F_L_X_Node;
      With_Self : Boolean := True)
      return Bare_R_F_L_X_Node_Array_Access
   is
      Count : Natural := 0;
      Start : Bare_R_F_L_X_Node :=
        (if With_Self then Node else Node.Parent);
      Cur   : Bare_R_F_L_X_Node := Start;
   begin
      while Cur /= null loop
         Count := Count + 1;
         Cur := Cur.Parent;
      end loop;

      declare
         Result : constant Bare_R_F_L_X_Node_Array_Access :=
            Create_Bare_R_F_L_X_Node_Array (Count);
      begin
         Cur := Start;
         for I in Result.Items'Range loop
            Result.Items (I) := Cur;
            Cur := Cur.Parent;
         end loop;
         return Result;
      end;
   end Parents;

   -----------------------
   -- First_Child_Index --
   -----------------------

   function First_Child_Index (Node : Bare_R_F_L_X_Node) return Natural
   is (1);

   ----------------------
   -- Last_Child_Index --
   ----------------------

   function Last_Child_Index (Node : Bare_R_F_L_X_Node) return Natural
   is (Children_Count (Node));

   ---------------
   -- Get_Child --
   ---------------

   procedure Get_Child
     (Node            : Bare_R_F_L_X_Node;
      Index           : Positive;
      Index_In_Bounds : out Boolean;
      Result          : out Bare_R_F_L_X_Node)
   is
      K : constant R_F_L_X_Node_Kind_Type := Node.Kind;
   begin
      

      Index_In_Bounds := True;
      Result := null;
      case Rflx_R_F_L_X_Node (K) is
when Rflx_I_D_Range =>
declare
N_Bare_I_D : constant Bare_I_D := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_I_D.I_D_F_Package;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_I_D.I_D_F_Name;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Aspect_Range =>
declare
N_Bare_Aspect : constant Bare_Aspect := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Aspect.Aspect_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Aspect.Aspect_F_Value;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Message_Aggregate_Associations_Range =>
declare
N_Bare_Message_Aggregate_Associations : constant Bare_Message_Aggregate_Associations := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Message_Aggregate_Associations.Message_Aggregate_Associations_F_Associations;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Checksum_Val_Range =>
declare
N_Bare_Checksum_Val : constant Bare_Checksum_Val := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Checksum_Val.Checksum_Val_F_Data;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Checksum_Value_Range_Range =>
declare
N_Bare_Checksum_Value_Range : constant Bare_Checksum_Value_Range := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Checksum_Value_Range.Checksum_Value_Range_F_First;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Checksum_Value_Range.Checksum_Value_Range_F_Last;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Checksum_Assoc_Range =>
declare
N_Bare_Checksum_Assoc : constant Bare_Checksum_Assoc := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Checksum_Assoc.Checksum_Assoc_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Checksum_Assoc.Checksum_Assoc_F_Covered_Fields;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Refinement_Decl_Range =>
declare
N_Bare_Refinement_Decl : constant Bare_Refinement_Decl := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Refinement_Decl.Refinement_Decl_F_Pdu;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Refinement_Decl.Refinement_Decl_F_Field;
                            return;
                    

                        when 3 =>
                            Result := N_Bare_Refinement_Decl.Refinement_Decl_F_Sdu;
                            return;
                    

                        when 4 =>
                            Result := N_Bare_Refinement_Decl.Refinement_Decl_F_Condition;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Session_Decl_Range =>
declare
N_Bare_Session_Decl : constant Bare_Session_Decl := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Session_Decl.Session_Decl_F_Parameters;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Session_Decl.Session_Decl_F_Identifier;
                            return;
                    

                        when 3 =>
                            Result := N_Bare_Session_Decl.Session_Decl_F_Declarations;
                            return;
                    

                        when 4 =>
                            Result := N_Bare_Session_Decl.Session_Decl_F_States;
                            return;
                    

                        when 5 =>
                            Result := N_Bare_Session_Decl.Session_Decl_F_End_Identifier;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Type_Decl_Range =>
declare
N_Bare_Type_Decl : constant Bare_Type_Decl := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Type_Decl.Type_Decl_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Type_Decl.Type_Decl_F_Parameters;
                            return;
                    

                        when 3 =>
                            Result := N_Bare_Type_Decl.Type_Decl_F_Definition;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Description_Range =>
declare
N_Bare_Description : constant Bare_Description := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Description.Description_F_Content;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Element_Value_Assoc_Range =>
declare
N_Bare_Element_Value_Assoc : constant Bare_Element_Value_Assoc := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Element_Value_Assoc.Element_Value_Assoc_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Element_Value_Assoc.Element_Value_Assoc_F_Literal;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Attribute_Range =>
declare
N_Bare_Attribute : constant Bare_Attribute := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Attribute.Attribute_F_Expression;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Attribute.Attribute_F_Kind;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Bin_Op_Range =>
declare
N_Bare_Bin_Op : constant Bare_Bin_Op := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Bin_Op.Bin_Op_F_Left;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Bin_Op.Bin_Op_F_Op;
                            return;
                    

                        when 3 =>
                            Result := N_Bare_Bin_Op.Bin_Op_F_Right;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Binding_Range =>
declare
N_Bare_Binding : constant Bare_Binding := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Binding.Binding_F_Expression;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Binding.Binding_F_Bindings;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Call_Range =>
declare
N_Bare_Call : constant Bare_Call := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Call.Call_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Call.Call_F_Arguments;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Case_Expression_Range =>
declare
N_Bare_Case_Expression : constant Bare_Case_Expression := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Case_Expression.Case_Expression_F_Expression;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Case_Expression.Case_Expression_F_Choices;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Choice_Range =>
declare
N_Bare_Choice : constant Bare_Choice := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Choice.Choice_F_Selectors;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Choice.Choice_F_Expression;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Comprehension_Range =>
declare
N_Bare_Comprehension : constant Bare_Comprehension := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Comprehension.Comprehension_F_Iterator;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Comprehension.Comprehension_F_Sequence;
                            return;
                    

                        when 3 =>
                            Result := N_Bare_Comprehension.Comprehension_F_Condition;
                            return;
                    

                        when 4 =>
                            Result := N_Bare_Comprehension.Comprehension_F_Selector;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Context_Item_Range =>
declare
N_Bare_Context_Item : constant Bare_Context_Item := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Context_Item.Context_Item_F_Item;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Conversion_Range =>
declare
N_Bare_Conversion : constant Bare_Conversion := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Conversion.Conversion_F_Target_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Conversion.Conversion_F_Argument;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Message_Aggregate_Range =>
declare
N_Bare_Message_Aggregate : constant Bare_Message_Aggregate := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Message_Aggregate.Message_Aggregate_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Message_Aggregate.Message_Aggregate_F_Values;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Negation_Range =>
declare
N_Bare_Negation : constant Bare_Negation := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Negation.Negation_F_Data;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Paren_Expression_Range =>
declare
N_Bare_Paren_Expression : constant Bare_Paren_Expression := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Paren_Expression.Paren_Expression_F_Data;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Quantified_Expression_Range =>
declare
N_Bare_Quantified_Expression : constant Bare_Quantified_Expression := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Quantified_Expression.Quantified_Expression_F_Operation;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Quantified_Expression.Quantified_Expression_F_Parameter_Identifier;
                            return;
                    

                        when 3 =>
                            Result := N_Bare_Quantified_Expression.Quantified_Expression_F_Iterable;
                            return;
                    

                        when 4 =>
                            Result := N_Bare_Quantified_Expression.Quantified_Expression_F_Predicate;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Select_Node_Range =>
declare
N_Bare_Select_Node : constant Bare_Select_Node := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Select_Node.Select_Node_F_Expression;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Select_Node.Select_Node_F_Selector;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Concatenation_Range =>
declare
N_Bare_Concatenation : constant Bare_Concatenation := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Concatenation.Concatenation_F_Left;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Concatenation.Concatenation_F_Right;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Sequence_Aggregate_Range =>
declare
N_Bare_Sequence_Aggregate : constant Bare_Sequence_Aggregate := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Sequence_Aggregate.Sequence_Aggregate_F_Values;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Variable_Range =>
declare
N_Bare_Variable : constant Bare_Variable := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Variable.Variable_F_Identifier;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Formal_Channel_Decl_Range =>
declare
N_Bare_Formal_Channel_Decl : constant Bare_Formal_Channel_Decl := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Formal_Channel_Decl.Formal_Channel_Decl_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Formal_Channel_Decl.Formal_Channel_Decl_F_Parameters;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Formal_Function_Decl_Range =>
declare
N_Bare_Formal_Function_Decl : constant Bare_Formal_Function_Decl := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Formal_Function_Decl.Formal_Function_Decl_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Formal_Function_Decl.Formal_Function_Decl_F_Parameters;
                            return;
                    

                        when 3 =>
                            Result := N_Bare_Formal_Function_Decl.Formal_Function_Decl_F_Return_Type_Identifier;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Renaming_Decl_Range =>
declare
N_Bare_Renaming_Decl : constant Bare_Renaming_Decl := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Renaming_Decl.Renaming_Decl_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Renaming_Decl.Renaming_Decl_F_Type_Identifier;
                            return;
                    

                        when 3 =>
                            Result := N_Bare_Renaming_Decl.Renaming_Decl_F_Expression;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Variable_Decl_Range =>
declare
N_Bare_Variable_Decl : constant Bare_Variable_Decl := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Variable_Decl.Variable_Decl_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Variable_Decl.Variable_Decl_F_Type_Identifier;
                            return;
                    

                        when 3 =>
                            Result := N_Bare_Variable_Decl.Variable_Decl_F_Initializer;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Message_Aggregate_Association_Range =>
declare
N_Bare_Message_Aggregate_Association : constant Bare_Message_Aggregate_Association := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Message_Aggregate_Association.Message_Aggregate_Association_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Message_Aggregate_Association.Message_Aggregate_Association_F_Expression;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Byte_Order_Aspect_Range =>
declare
N_Bare_Byte_Order_Aspect : constant Bare_Byte_Order_Aspect := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Byte_Order_Aspect.Byte_Order_Aspect_F_Byte_Order;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Checksum_Aspect_Range =>
declare
N_Bare_Checksum_Aspect : constant Bare_Checksum_Aspect := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Checksum_Aspect.Checksum_Aspect_F_Associations;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Message_Field_Range =>
declare
N_Bare_Message_Field : constant Bare_Message_Field := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Message_Field.Message_Field_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Message_Field.Message_Field_F_Type_Identifier;
                            return;
                    

                        when 3 =>
                            Result := N_Bare_Message_Field.Message_Field_F_Type_Arguments;
                            return;
                    

                        when 4 =>
                            Result := N_Bare_Message_Field.Message_Field_F_Aspects;
                            return;
                    

                        when 5 =>
                            Result := N_Bare_Message_Field.Message_Field_F_Condition;
                            return;
                    

                        when 6 =>
                            Result := N_Bare_Message_Field.Message_Field_F_Thens;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Message_Fields_Range =>
declare
N_Bare_Message_Fields : constant Bare_Message_Fields := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Message_Fields.Message_Fields_F_Initial_Field;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Message_Fields.Message_Fields_F_Fields;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Null_Message_Field_Range =>
declare
N_Bare_Null_Message_Field : constant Bare_Null_Message_Field := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Null_Message_Field.Null_Message_Field_F_Thens;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Package_Node_Range =>
declare
N_Bare_Package_Node : constant Bare_Package_Node := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Package_Node.Package_Node_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Package_Node.Package_Node_F_Declarations;
                            return;
                    

                        when 3 =>
                            Result := N_Bare_Package_Node.Package_Node_F_End_Identifier;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Parameter_Range =>
declare
N_Bare_Parameter : constant Bare_Parameter := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Parameter.Parameter_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Parameter.Parameter_F_Type_Identifier;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Parameters_Range =>
declare
N_Bare_Parameters : constant Bare_Parameters := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Parameters.Parameters_F_Parameters;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_R_F_L_X_Node_Base_List =>
declare
N_Bare_R_F_L_X_Node_Base_List : constant Bare_R_F_L_X_Node_Base_List := Node;
begin

                    if Index > N_Bare_R_F_L_X_Node_Base_List.Count then
                        Index_In_Bounds := False;
                    else
                        Result := N_Bare_R_F_L_X_Node_Base_List.Nodes (Index);
                    end if;
                    return;
                
end;
when Rflx_Specification_Range =>
declare
N_Bare_Specification : constant Bare_Specification := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Specification.Specification_F_Context_Clause;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Specification.Specification_F_Package_Declaration;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_State_Range =>
declare
N_Bare_State : constant Bare_State := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_State.State_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_State.State_F_Description;
                            return;
                    

                        when 3 =>
                            Result := N_Bare_State.State_F_Body;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_State_Body_Range =>
declare
N_Bare_State_Body : constant Bare_State_Body := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_State_Body.State_Body_F_Declarations;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_State_Body.State_Body_F_Actions;
                            return;
                    

                        when 3 =>
                            Result := N_Bare_State_Body.State_Body_F_Conditional_Transitions;
                            return;
                    

                        when 4 =>
                            Result := N_Bare_State_Body.State_Body_F_Final_Transition;
                            return;
                    

                        when 5 =>
                            Result := N_Bare_State_Body.State_Body_F_Exception_Transition;
                            return;
                    

                        when 6 =>
                            Result := N_Bare_State_Body.State_Body_F_End_Identifier;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Assignment_Range =>
declare
N_Bare_Assignment : constant Bare_Assignment := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Assignment.Assignment_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Assignment.Assignment_F_Expression;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Attribute_Statement_Range =>
declare
N_Bare_Attribute_Statement : constant Bare_Attribute_Statement := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Attribute_Statement.Attribute_Statement_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Attribute_Statement.Attribute_Statement_F_Attr;
                            return;
                    

                        when 3 =>
                            Result := N_Bare_Attribute_Statement.Attribute_Statement_F_Expression;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Message_Field_Assignment_Range =>
declare
N_Bare_Message_Field_Assignment : constant Bare_Message_Field_Assignment := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Message_Field_Assignment.Message_Field_Assignment_F_Message;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Message_Field_Assignment.Message_Field_Assignment_F_Field;
                            return;
                    

                        when 3 =>
                            Result := N_Bare_Message_Field_Assignment.Message_Field_Assignment_F_Expression;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Reset_Range =>
declare
N_Bare_Reset : constant Bare_Reset := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Reset.Reset_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Reset.Reset_F_Associations;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Term_Assoc_Range =>
declare
N_Bare_Term_Assoc : constant Bare_Term_Assoc := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Term_Assoc.Term_Assoc_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Term_Assoc.Term_Assoc_F_Expression;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Then_Node_Range =>
declare
N_Bare_Then_Node : constant Bare_Then_Node := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Then_Node.Then_Node_F_Target;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Then_Node.Then_Node_F_Aspects;
                            return;
                    

                        when 3 =>
                            Result := N_Bare_Then_Node.Then_Node_F_Condition;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Transition_Range =>
declare
N_Bare_Transition : constant Bare_Transition := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Transition.Transition_F_Target;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Transition.Transition_F_Description;
                            return;
                    

                        when others => null;
                    end case;
                
case Rflx_Transition_Range (K) is
when Rflx_Conditional_Transition_Range =>
declare
N_Bare_Conditional_Transition : constant Bare_Conditional_Transition := N_Bare_Transition;
begin
case Index is

                        when 3 =>
                            Result := N_Bare_Conditional_Transition.Conditional_Transition_F_Condition;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when others => null;
end case;
end;
when Rflx_Type_Argument_Range =>
declare
N_Bare_Type_Argument : constant Bare_Type_Argument := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Type_Argument.Type_Argument_F_Identifier;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Type_Argument.Type_Argument_F_Expression;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Message_Type_Def_Range =>
declare
N_Bare_Message_Type_Def : constant Bare_Message_Type_Def := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Message_Type_Def.Message_Type_Def_F_Message_Fields;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Message_Type_Def.Message_Type_Def_F_Aspects;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Named_Enumeration_Def_Range =>
declare
N_Bare_Named_Enumeration_Def : constant Bare_Named_Enumeration_Def := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Named_Enumeration_Def.Named_Enumeration_Def_F_Elements;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Positional_Enumeration_Def_Range =>
declare
N_Bare_Positional_Enumeration_Def : constant Bare_Positional_Enumeration_Def := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Positional_Enumeration_Def.Positional_Enumeration_Def_F_Elements;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Enumeration_Type_Def_Range =>
declare
N_Bare_Enumeration_Type_Def : constant Bare_Enumeration_Type_Def := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Enumeration_Type_Def.Enumeration_Type_Def_F_Elements;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Enumeration_Type_Def.Enumeration_Type_Def_F_Aspects;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Modular_Type_Def_Range =>
declare
N_Bare_Modular_Type_Def : constant Bare_Modular_Type_Def := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Modular_Type_Def.Modular_Type_Def_F_Mod;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Range_Type_Def_Range =>
declare
N_Bare_Range_Type_Def : constant Bare_Range_Type_Def := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Range_Type_Def.Range_Type_Def_F_First;
                            return;
                    

                        when 2 =>
                            Result := N_Bare_Range_Type_Def.Range_Type_Def_F_Last;
                            return;
                    

                        when 3 =>
                            Result := N_Bare_Range_Type_Def.Range_Type_Def_F_Size;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Sequence_Type_Def_Range =>
declare
N_Bare_Sequence_Type_Def : constant Bare_Sequence_Type_Def := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Sequence_Type_Def.Sequence_Type_Def_F_Element_Type;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when Rflx_Type_Derivation_Def_Range =>
declare
N_Bare_Type_Derivation_Def : constant Bare_Type_Derivation_Def := Node;
begin
case Index is

                        when 1 =>
                            Result := N_Bare_Type_Derivation_Def.Type_Derivation_Def_F_Base;
                            return;
                    

                        when others => null;
                    end case;
                
end;
when others => null;
end case;

      --  Execution should reach this point iff nothing matched this index, so
      --  we must be out of bounds.
      Index_In_Bounds := False;
   end Get_Child;

   -----------
   -- Print --
   -----------

   procedure Print
     (Node        : Langkit_Support.Generic_API.Analysis.Lk_Node;
      Show_Slocs  : Boolean;
      Line_Prefix : String := "")
   is
      use Langkit_Support.Generic_API.Analysis;
      use Langkit_Support.Generic_API.Introspection;

      T : Type_Ref;
   begin
      if Node.Is_Null then
         Put_Line ("None");
         return;
      end if;

      T := Type_Of (Node);
      Put (Line_Prefix & Image (Node_Type_Repr_Name (T)));
      if Show_Slocs then
         Put ("[" & Image (Node.Sloc_Range) & "]");
      end if;

      if Node.Is_Incomplete then
         Put (" <<INCOMPLETE>>");
      end if;

      if Node.Is_Token_Node then
         Put_Line (": " & Image (Node.Text));

      elsif Is_List_Node (Node) then

         --  List nodes are displayed in a special way (they have no field)

         declare
            Count : constant Natural := Node.Children_Count;
            Child : Lk_Node;
         begin
            if Count = 0 then
               Put_Line (": <empty list>");
               return;
            end if;
            New_Line;

            for I in 1 .. Count loop
               Child := Node.Child (I);
               if not Child.Is_Null then
                  Print (Child, Show_Slocs, Line_Prefix & "|  ");
               end if;
            end loop;
         end;

      else
         --  This is for regular nodes: display each syntax field (i.e.
         --  non-property member).

         declare
            Attr_Prefix     : constant String := Line_Prefix & "|";
            Children_Prefix : constant String := Line_Prefix & "|  ";
            M_List          : constant Struct_Member_Ref_Array := Members (T);
            Child           : Lk_Node;
         begin
            New_Line;
            for M of M_List loop
               if not Is_Property (M) and then not Is_Null_For (M, T) then
                  Child := As_Node (Eval_Node_Member (Node, M));
                  Put (Attr_Prefix
                       & Image (Format_Name (Member_Name (M), Lower)) & ":");
                  if Child.Is_Null then
                     Put_Line (" <null>");
                  else
                     New_Line;
                     Print (Child, Show_Slocs, Children_Prefix);
                  end if;
               end if;
            end loop;
         end;
      end if;
   end Print;

   -----------
   -- Print --
   -----------

   procedure Print
     (Node        : Bare_R_F_L_X_Node;
      Show_Slocs  : Boolean;
      Line_Prefix : String := "")
   is
      Entity : constant Internal_Entity := (Node, No_Entity_Info);
   begin
      Print (To_Generic_Node (Entity), Show_Slocs, Line_Prefix);
   end Print;

   ------------
   -- Parent --
   ------------

   function Parent (Node : Bare_R_F_L_X_Node) return Bare_R_F_L_X_Node is
   begin
      return Node.Parent;
   end Parent;

   ------------------
   -- Stored_Token --
   ------------------

   function Stored_Token
     (Node  : Bare_R_F_L_X_Node;
      Token : Token_Reference) return Token_Index
   is
      Index : constant Token_Or_Trivia_Index := Get_Token_Index (Token);
   begin
      if Node.Unit.TDH'Access /= Get_Token_TDH (Token) then
         Raise_Property_Exception
           (Node,
            Property_Error'Identity,
            "Cannot associate a token and a node from different analysis"
            & " units");
      elsif Index.Trivia /= No_Token_Index then
         Raise_Property_Exception
           (Node,
            Property_Error'Identity,
            "A node cannot hold trivia");
      end if;

      return Index.Token;
   end Stored_Token;

   -------------------------
   -- Children_And_Trivia --
   -------------------------

   function Children_And_Trivia
     (Node : Bare_R_F_L_X_Node) return Bare_Children_Array
   is
      package Children_Vectors is new Ada.Containers.Vectors
        (Positive, Bare_Child_Record);
      use Children_Vectors;

      Ret_Vec : Vector;
      Ctx     : Internal_Context renames Node.Unit.Context;
      TDH     : Token_Data_Handler renames Node.Unit.TDH;

      procedure Append_Trivias (First, Last : Token_Index);
      --  Append all the trivias of tokens between indices First and Last to
      --  the returned vector.

      function Filter_Children
        (Parent : Bare_R_F_L_X_Node)
         return Internal_Bare_R_F_L_X_Node_Array;
      --  Return an array for all children in Parent that are not null

      --------------------
      -- Append_Trivias --
      --------------------

      procedure Append_Trivias (First, Last : Token_Index) is
      begin
         for I in First .. Last loop
            for D of Get_Trivias (TDH, I) loop
               Ret_Vec.Append
                 (Bare_Child_Record'
                    (Kind   => Trivia,
                     Trivia => Wrap_Token_Reference
                                 (Ctx, TDH'Access, (I, D))));
            end loop;
         end loop;
      end Append_Trivias;

      ---------------------
      -- Filter_Children --
      ---------------------

      function Filter_Children
        (Parent : Bare_R_F_L_X_Node)
         return Internal_Bare_R_F_L_X_Node_Array
      is
         Children : constant Internal_Bare_R_F_L_X_Node_Array :=
            Implementation.Children (Parent);
         Result   : Internal_Bare_R_F_L_X_Node_Array (Children'Range);
         Next     : Integer := Result'First;
      begin
         for I in Children'Range loop
            if Children (I) /= null then
               Result (Next) := Children (I);
               Next := Next + 1;
            end if;
         end loop;
         return Result (Result'First .. Next - 1);
      end Filter_Children;

      First_Child : constant Positive := 1;
      N_Children  : constant Internal_Bare_R_F_L_X_Node_Array :=
         Filter_Children (Node);
   begin
      if N_Children'Length > 0
        and then (Node.Token_Start_Index
                    /= N_Children (First_Child).Token_Start_Index)
      then
         Append_Trivias (Node.Token_Start_Index,
                         N_Children (First_Child).Token_Start_Index - 1);
      end if;

      --  Append each node to Ret_Vec, and append trivia that follow after each
      --  non-ghost nodes.
      for I in N_Children'Range loop
         Ret_Vec.Append (Bare_Child_Record'(Child, N_Children (I)));
         if not Is_Ghost (N_Children (I)) then
            Append_Trivias (N_Children (I).Token_End_Index,
                            (if I = N_Children'Last
                             then Node.Token_End_Index - 1
                             else N_Children (I + 1).Token_Start_Index - 1));
         end if;
      end loop;

      declare
         A : Bare_Children_Array (1 .. Natural (Ret_Vec.Length));
      begin
         for I in A'Range loop
            A (I) := Ret_Vec.Element (I);
         end loop;
         return A;
      end;
   end Children_And_Trivia;

   --------------
   -- Is_Ghost --
   --------------

   function Is_Ghost (Node : Bare_R_F_L_X_Node) return Boolean
   is (Node.Token_End_Index = No_Token_Index);

   -------------------
   -- Is_Incomplete --
   -------------------

   function Is_Incomplete (Node : Bare_R_F_L_X_Node) return Boolean
   is
      LGC : Bare_R_F_L_X_Node;
   begin
     if Is_List_Node (Node.Kind) then
        LGC := (if Last_Child_Index (Node) /= 0
                then Child (Node, Last_Child_Index (Node))
                else null);
        return LGC /= null and then Is_Incomplete (LGC);
      else
         return Node.Last_Attempted_Child > -1;
      end if;
   end;

   -----------------
   -- Token_Start --
   -----------------

   function Token_Start (Node : Bare_R_F_L_X_Node) return Token_Reference
   is (Token (Node, Node.Token_Start_Index));

   ---------------
   -- Token_End --
   ---------------

   function Token_End (Node : Bare_R_F_L_X_Node) return Token_Reference
   is
     (if Node.Token_End_Index = No_Token_Index
      then Token_Start (Node)
      else Token (Node, Node.Token_End_Index));

   -----------
   -- Token --
   -----------

   function Token
     (Node  : Bare_R_F_L_X_Node;
      Index : Token_Index) return Token_Reference
   is
      Unit    : constant Internal_Unit := Node.Unit;
      Context : constant Internal_Context := Unit.Context;
   begin
      return Wrap_Token_Reference
        (Context, Token_Data (Unit), (Index, No_Token_Index));
   end Token;

   ---------
   -- "<" --
   ---------

   function "<" (Left, Right : Bare_R_F_L_X_Node) return Boolean is
   begin
      --  Reject invalid inputs
      if Left /= null and Is_Synthetic (Left) then
         raise Property_Error with "left node is synthetic";
      elsif Right /= null and Is_Synthetic (Right) then
         raise Property_Error with "right node is synthetic";
      end if;

      --  Null nodes come first
      if Left = null then
         return Right /= null;
      elsif Right = null then
         return False;
      end if;

      --  So we have two non-null nodes. Sort by unit filename
      if Left.Unit < Right.Unit then
         return True;
      elsif Left.Unit /= Right.Unit then
         return False;
      end if;

      --  Both nodes come from the same unit: compare their token indexes
      if Left.Token_Start_Index < Right.Token_Start_Index then
         return True;
      elsif Left.Token_Start_Index > Right.Token_Start_Index then
         return False;
      else
         return Left.Token_End_Index < Right.Token_End_Index;
      end if;
   end "<";

   -------------
   -- Is_Null --
   -------------

   function Is_Null (Node : Bare_R_F_L_X_Node) return Boolean
   is (Node = null);

   ----------
   -- Kind --
   ----------

   function Kind (Node : Bare_R_F_L_X_Node) return R_F_L_X_Node_Kind_Type
   is (Node.Kind);

   -----------------
   -- Child_Index --
   -----------------

   function Child_Index (Node : Bare_R_F_L_X_Node) return Integer
   is
      N : Bare_R_F_L_X_Node := null;
   begin
      if Node.Parent = null then
         raise Property_Error with
            "Trying to get the child index of a root node";
      end if;

      for I in First_Child_Index (Node.Parent)
            .. Last_Child_Index (Node.Parent)
      loop
         N := Child (Node.Parent, I);
         if N = Node then
            return I - 1;
         end if;
      end loop;

      --  If we reach this point, then Node isn't a Child of Node.Parent. This
      --  is not supposed to happen.
      raise Program_Error;
   end Child_Index;

   -------------------
   -- Fetch_Sibling --
   -------------------

   function Fetch_Sibling
     (Node   : Bare_R_F_L_X_Node;
      Offset : Integer) return Bare_R_F_L_X_Node is
   begin
      --  Root nodes have no sibling: handle them now to avoid invalid requests
      --  in the code below.
      if Node.Parent = null then
         return null;
      end if;

      declare
         Node_Index : constant Positive := Child_Index (Node) + 1;
         --  Child_Index is 0-based, but the Child primitive expects a 1-based
         --  index.

         Sibling_Index : constant Integer := Node_Index + Offset;
      begin
         --  Child returns null for out-of-bound indexes

         return (if Sibling_Index >= 1
                 then Child (Node.Parent, Sibling_Index)
                 else null);
      end;
   end Fetch_Sibling;

   -------------------
   -- Fetch_Sibling --
   -------------------

   function Fetch_Sibling
     (Node   : Bare_R_F_L_X_Node;
      E_Info : Internal_Entity_Info;
      Offset : Integer) return Internal_Entity
   is
      Sibling : constant Bare_R_F_L_X_Node := Fetch_Sibling (Node, Offset);
   begin
      --  Don't forget to clear entity info if the result is nul

      return (if Sibling = null
              then No_Entity
              else (Sibling, E_Info));
   end Fetch_Sibling;

   ----------------------
   -- Previous_Sibling --
   ----------------------

   function Previous_Sibling
     (Node   : Bare_R_F_L_X_Node;
      E_Info : Internal_Entity_Info := No_Entity_Info)
      return Internal_Entity is
   begin
      return Fetch_Sibling (Node, E_Info, -1);
   end Previous_Sibling;

   ------------------
   -- Next_Sibling --
   ------------------

   function Next_Sibling
     (Node   : Bare_R_F_L_X_Node;
      E_Info : Internal_Entity_Info := No_Entity_Info)
      return Internal_Entity is
   begin
      return Fetch_Sibling (Node, E_Info, 1);
   end Next_Sibling;


   ----------------------
   -- Compare_Metadata --
   ----------------------

   --  Deactivate "not referenced" warnings because if the metadata struct has
   --  no fields, formals and temporaries won't be referenced in the two
   --  following functions.
   pragma Warnings (Off, "referenced");
   function Compare_Metadata (L, R : Internal_Metadata) return Boolean is
   begin
      return True;
   end Compare_Metadata;

   ----------
   -- Hash --
   ----------

   function Hash (Self : Internal_Metadata) return Hash_Type is
      Ret : Hash_Type := Langkit_Support.Hashes.Initial_Hash;
   begin
      return Ret;
   end Hash;
   pragma Warnings (On, "referenced");

   -------------
   -- Combine --
   -------------

   function Combine
     (L, R : Internal_Metadata) return Internal_Metadata
   is
      pragma Unreferenced (L, R);
      Ret : Internal_Metadata := No_Metadata;
   begin
      return Ret;
   end Combine;

   -------------------------------
   -- Create_Static_Lexical_Env --
   -------------------------------

   function Create_Static_Lexical_Env
     (Parent            : Lexical_Env;
      Node              : Bare_R_F_L_X_Node;
      Transitive_Parent : Boolean := False) return Lexical_Env
   is
      Unit : constant Internal_Unit :=
        (if Node = null then null else Node.Unit);
   begin
      return Result : Lexical_Env := Create_Lexical_Env
        (Parent, Node, Transitive_Parent, Convert_Unit (Unit))
      do
         if Unit /= null then
            Register_Destroyable (Unit, Unwrap (Result.Env));
         end if;
      end return;
   end Create_Static_Lexical_Env;

   ---------
   -- Get --
   ---------

   function Get
     (Self  : Bare_R_F_L_X_Node;
      A     : AST_Envs.Entity_Array;
      Index : Integer) return Internal_Entity
   is
      function Length (A : AST_Envs.Entity_Array) return Natural
      is (A'Length);

      function Get
        (A     : AST_Envs.Entity_Array;
         Index : Integer) return Internal_Entity
      is (A (Index + 1)); --  A is 1-based but Index is 0-based

      function Relative_Get is new Langkit_Support.Relative_Get
        (Item_Type     => Entity,
         Sequence_Type => AST_Envs.Entity_Array,
         Length        => Length,
         Get           => Get);
      Result : Internal_Entity;
   begin
      if Relative_Get (A, Index, Result) then
         return Result;
      else
         Raise_Property_Exception
           (Self, Property_Error'Identity, "out-of-bounds array access");
      end if;
   end Get;

   -----------
   -- Group --
   -----------

   function Group
     (Envs   : Lexical_Env_Array_Access;
      Env_Md : Internal_Metadata := No_Metadata) return Lexical_Env
   is (Group (Lexical_Env_Array (Envs.Items), Env_Md));

       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   



       

   




   ------------------
   -- Children_Env --
   ------------------

   function Children_Env
     (Node   : Bare_R_F_L_X_Node;
      E_Info : Internal_Entity_Info := No_Entity_Info)
      return Lexical_Env
   is (Rebind_Env (Node.Self_Env, E_Info));

   --------------
   -- Node_Env --
   --------------

   function Node_Env
     (Node   : Bare_R_F_L_X_Node;
      E_Info : Internal_Entity_Info := No_Entity_Info)
      return Lexical_Env
   is
      function Get_Base_Env return Lexical_Env;
      --  Return the environment that we need to rebind before returning

      ------------------
      -- Get_Base_Env --
      ------------------

      function Get_Base_Env return Lexical_Env is
         pragma Warnings (Off, "referenced");
         function Get_Parent_Env return Lexical_Env;
         pragma Warnings (On, "referenced");

         --------------------
         -- Get_Parent_Env --
         --------------------

         function Get_Parent_Env return Lexical_Env is
            Parent : constant Lexical_Env := AST_Envs.Parent (Node.Self_Env);
         begin
            --  If Node is the root scope or the empty environment, Parent can
            --  be a wrapper around the null node. Turn this into the
            --  Empty_Env, as null envs are erroneous values in properties.
            return (if Unwrap (Parent) = null
                    then Empty_Env
                    else Parent);
         end Get_Parent_Env;

      begin
         
         return
           Node.Self_Env;
      end Get_Base_Env;

      Base_Env : Lexical_Env := Get_Base_Env;
      Result   : constant Lexical_Env := Rebind_Env (Base_Env, E_Info);
   begin
      Dec_Ref (Base_Env);
      return Result;
   end Node_Env;

   ------------
   -- Parent --
   ------------

   function Parent
     (Node   : Bare_R_F_L_X_Node;
      E_Info : Internal_Entity_Info := No_Entity_Info)
      return Internal_Entity is
   begin
      --  TODO: shed entity information as appropriate
      return (Node.Parent, E_Info);
   end Parent;

   -------------
   -- Parents --
   -------------

   function Parents
     (Node      : Bare_R_F_L_X_Node;
      With_Self : Boolean := True;
      E_Info    : Internal_Entity_Info := No_Entity_Info)
      return Internal_Entity_Array_Access
   is
      Bare_Parents : Bare_R_F_L_X_Node_Array_Access := Parents (Node, With_Self);
      Result       : Internal_Entity_Array_Access :=
         Create_Internal_Entity_Array (Bare_Parents.N);
   begin
      --  TODO: shed entity information as appropriate
      for I in Bare_Parents.Items'Range loop
         Result.Items (I) := (Bare_Parents.Items (I), E_Info);
      end loop;
      Dec_Ref (Bare_Parents);
      return Result;
   end Parents;

   --------------
   -- Children --
   --------------

   function Children
     (Node   : Bare_R_F_L_X_Node;
      E_Info : Internal_Entity_Info := No_Entity_Info)
      return Internal_Entity_Array_Access
   is
      Bare_Children : Bare_R_F_L_X_Node_Array_Access := Children (Node);
      Result        : Internal_Entity_Array_Access :=
         Create_Internal_Entity_Array (Bare_Children.N);
   begin
      --  TODO: shed entity information as appropriate
      for I in Bare_Children.Items'Range loop
         Result.Items (I) := (Bare_Children.Items (I), E_Info);
      end loop;
      Dec_Ref (Bare_Children);
      return Result;
   end Children;

   ---------------------
   -- New_Unit_String --
   ---------------------

   function New_Unit_String
     (Unit : Internal_Unit; Str : String) return String_Access
   is
      procedure Register_Destroyable_String is new Register_Destroyable_Gen
        (String, String_Access, Free);
   begin
      return Ret : String_Access := new String'(Str) do
         Register_Destroyable_String (Unit, Ret);
      end return;
   end New_Unit_String;

   --------------------------------
   -- Assign_Names_To_Logic_Vars --
   --------------------------------

   procedure Assign_Names_To_Logic_Vars (Node : Bare_R_F_L_X_Node) is

      pragma Warnings (Off, "referenced");

      procedure Assign
        (Node  : Bare_R_F_L_X_Node;
         LV    : in out Logic_Var_Record;
         Field : String);
      --  Assign a name to the LV logic variable. Node must be the node that
      --  owns LV, and Field must be the name of the field in Node that holds
      --  LV.

      ------------
      -- Assign --
      ------------

      procedure Assign
        (Node  : Bare_R_F_L_X_Node;
         LV    : in out Logic_Var_Record;
         Field : String) is
      begin
         LV.Dbg_Name :=
           new String'(Image (Short_Text_Image (Node)) & "." & Field);
      end Assign;

      K : constant R_F_L_X_Node_Kind_Type := Node.Kind;

      pragma Warnings (On, "referenced");

   begin
      
      pragma Unreferenced (K);
      for Child of Internal_Bare_R_F_L_X_Node_Array'(Children (Node)) loop
         if Child /= null then
            Assign_Names_To_Logic_Vars (Child);
         end if;
      end loop;
   end Assign_Names_To_Logic_Vars;

   ----------------
   -- Text_Image --
   ----------------

   function Text_Image (Ent : Internal_Entity) return Text_Type is
   begin
      if Ent.Node /= null then
         declare
            Node_Image : constant Text_Type := Short_Text_Image (Ent.Node);
         begin
            return
            (if Ent.Info.Rebindings /= null
             then "<| "
             & Node_Image (Node_Image'First + 1 .. Node_Image'Last - 1) & " "
             & AST_Envs.Text_Image (Ent.Info.Rebindings) & " |>"
             else Node_Image);
         end;
      else
         return "None";
      end if;
   end Text_Image;

   ---------------------
   -- Full_Sloc_Image --
   ---------------------

   function Full_Sloc_Image (Node : Bare_R_F_L_X_Node) return String_Type
   is
      Res      : constant Text_Type :=
        To_Text
          (Ada.Directories.Simple_Name
             (Get_Filename (Unit (Node))))
           & ":" & To_Text (Image (Start_Sloc (Sloc_Range (Node)))) & ": ";
   begin
      return Create_String (Res);
   end Full_Sloc_Image;

   -----------
   -- Image --
   -----------

   function Image (Ent : Internal_Entity) return String is
      Result : constant Text_Type := Text_Image (Ent);
   begin
      return Image (Result);
   end Image;

   ---------------
   -- Can_Reach --
   ---------------

   function Can_Reach (El, From : Bare_R_F_L_X_Node) return Boolean is
   begin
      return R_F_L_X_Node_P_Can_Reach (El, From);
   end Can_Reach;

   -----------------
   -- Hash_Entity --
   -----------------

   function Hash_Entity (Self : Internal_Entity) return Hash_Type is
   begin
      return Combine
        ((Hash (Self.Node), Hash (Self.Info.Rebindings), Hash (Self.Info.Md)));
   end Hash_Entity;

   --------------------
   -- Compare_Entity --
   --------------------

   function Compare_Entity (Left, Right : Internal_Entity) return Boolean
   is
   begin
      return Left.Node = Right.Node
             and then Left.Info.Rebindings = Right.Info.Rebindings
             and then Compare_Metadata (Left.Info.Md, Right.Info.Md);
   end Compare_Entity;

   --------------------------------
   -- Create_Dynamic_Lexical_Env --
   --------------------------------

   function Create_Dynamic_Lexical_Env
     (Self              : Bare_R_F_L_X_Node;
      Assocs_Getter     : Inner_Env_Assocs_Resolver;
      Assoc_Resolver    : Entity_Resolver;
      Transitive_Parent : Boolean) return Lexical_Env
   is
      Unit : constant Internal_Unit := Self.Unit;
   begin
      --  This restriction is necessary to avoid relocation issues when
      --  Self.Self_Env is terminated.
      if Is_Foreign_Strict (Self.Self_Env, Self) then
         Raise_Property_Exception
           (Self,
            Property_Error'Identity,
            "cannot create a dynamic lexical env when Self.Self_Env is"
            & " foreign");
      end if;

      return Result : constant Lexical_Env := Create_Dynamic_Lexical_Env
        (Parent            => Null_Lexical_Env,
         Node              => Self,
         Transitive_Parent => Transitive_Parent,
         Owner             => Convert_Unit (Unit),
         Assocs_Getter     => Assocs_Getter,
         Assoc_Resolver    => Assoc_Resolver)
      do
         --  Since dynamic lexical environments can only be created in lazy
         --  field initializers, it is fine to tie Result's lifetime to the
         --  its owning unit's lifetime.
         Register_Destroyable (Unit, Unwrap (Result));
      end return;
   end Create_Dynamic_Lexical_Env;

   procedure Destroy_Synthetic_Node (Node : in out Bare_R_F_L_X_Node);
   --  Helper for the Register_Destroyable above

   ------------
   -- Length --
   ------------

   function Length (Node : Bare_R_F_L_X_Node_Base_List) return Natural
   is (if Node = null then 0 else Children_Count (Node));


      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (B : Boolean) return String is
      begin
         return (if B then "True" else "False");
      end Trace_Image;

      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (I : Integer) return String is
      begin
         return Integer'Image (I);
      end Trace_Image;

      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (S : Symbol_Type) return String is
      begin
         return (if S = null
                 then "None"
                 else Image (S.all, With_Quotes => True));
      end Trace_Image;

      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (C : Character_Type) return String is
         C_Str : constant Text_Type := (1 => C);
      begin
         return "'" & Image (C_Str) & "'";
      end Trace_Image;

      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (S : String_Type) return String is
      begin
         return Image (S.Content, With_Quotes => True);
      end Trace_Image;

      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (Env : Lexical_Env) return String is
      begin
         case Env.Kind is
         when Static_Primary =>
            return "<LexicalEnv static-primary for "
                   & Trace_Image (Env_Node (Env)) & ">";
         when others =>
            return "<LexicalEnv synthetic>";
         end case;
      end Trace_Image;

      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (R : Env_Rebindings) return String is
      begin
         return Image (Text_Image (R));
      end Trace_Image;

      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (Unit : Internal_Unit) return String is
      begin
         return "Internal_Unit (""" & Basename (Unit) & """)";
      end Trace_Image;

      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (Eq : Logic_Equation) return String is
         pragma Unreferenced (Eq);
      begin
         return "<LogicEquation>";
      end Trace_Image;

      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (Var : Logic_Var) return String is
         pragma Unreferenced (Var);
      begin
         return "<LogicVariable>";
      end Trace_Image;

      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (K : Analysis_Unit_Kind) return String is
      begin
         return Analysis_Unit_Kind'Image (K);
      end Trace_Image;

      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image (Self : Ref_Categories) return String is
         Result : Unbounded_String;
         First  : Boolean := True;
      begin
         Append (Result, "RefCategories(");
         for C in Ref_Category loop
            if Self (C) then
               if First then
                  First := False;
               else
                  Append (Result, ", ");
               end if;
               Append (Result, C'Image);
            end if;
         end loop;
         Append (Result, ")");
         return To_String (Result);
      end Trace_Image;


   

   


      -------------
      -- Inc_Ref --
      -------------

      procedure Inc_Ref (R : Internal_Designated_Env) is
      begin
               Inc_Ref (R.Direct_Env);
      end Inc_Ref;

      -------------
      -- Dec_Ref --
      -------------

      procedure Dec_Ref (R : in out Internal_Designated_Env) is
      begin
               Dec_Ref (R.Direct_Env);
      end Dec_Ref;




      ----------------
      -- Equivalent --
      ----------------

      function Equivalent (L, R : Internal_Designated_Env) return Boolean is
      begin
         return L.Kind = R.Kind and then L.Env_Name = R.Env_Name and then Equivalent (L.Direct_Env, R.Direct_Env);
      end Equivalent;


   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Designated_Env) return String is
         pragma Warnings (On, "referenced");
      begin
            return
              ("("
                     & "Kind => " & Trace_Image (R.Kind)
                        & ", "
                     & "Env_Name => " & Trace_Image (R.Env_Name)
                        & ", "
                     & "Direct_Env => " & Trace_Image (R.Direct_Env)
               & ")");
      end Trace_Image;


   

   




   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Metadata) return String is
         pragma Warnings (On, "referenced");
      begin
            return
              ("("
                  & "null record"
               & ")");
      end Trace_Image;


   

   




   

      ----------
      -- Hash --
      ----------

      pragma Warnings (Off, "referenced");
      function Hash (R : Internal_Entity_Info) return Hash_Type is
         pragma Warnings (On, "referenced");
      begin
         
            return Combine ((Hash (R.Md), Hash (R.Rebindings), Hash (R.From_Rebound)));
      end Hash;


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Info) return String is
         pragma Warnings (On, "referenced");
      begin
            return
              ("("
                     & "Md => " & Trace_Image (R.Md)
                        & ", "
                     & "Rebindings => " & Trace_Image (R.Rebindings)
                        & ", "
                     & "From_Rebound => " & Trace_Image (R.From_Rebound)
               & ")");
      end Trace_Image;


   

   



      function Create_Internal_Entity
        (Node : Bare_R_F_L_X_Node; Info : Internal_Entity_Info)
         return Internal_Entity is
      begin
         if Node = null then
            return No_Entity;
         end if;
         return (Node => Node, Info => Info);
      end;



   

      ----------
      -- Hash --
      ----------

      pragma Warnings (Off, "referenced");
      function Hash (R : Internal_Entity) return Hash_Type is
         pragma Warnings (On, "referenced");
      begin
         
            return Combine
              (Hash (R.Node), Hash (R.Info));
      end Hash;


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Abstract_I_D
        (Node : Bare_Abstract_I_D; Info : Internal_Entity_Info)
         return Internal_Entity_Abstract_I_D is
      begin
         if Node = null then
            return No_Entity_Abstract_I_D;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Abstract_I_D) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Type_Def
        (Node : Bare_Type_Def; Info : Internal_Entity_Info)
         return Internal_Entity_Type_Def is
      begin
         if Node = null then
            return No_Entity_Type_Def;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Type_Def) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Abstract_Message_Type_Def
        (Node : Bare_Abstract_Message_Type_Def; Info : Internal_Entity_Info)
         return Internal_Entity_Abstract_Message_Type_Def is
      begin
         if Node = null then
            return No_Entity_Abstract_Message_Type_Def;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Abstract_Message_Type_Def) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Aspect
        (Node : Bare_Aspect; Info : Internal_Entity_Info)
         return Internal_Entity_Aspect is
      begin
         if Node = null then
            return No_Entity_Aspect;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Aspect) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_R_F_L_X_Node_Base_List
        (Node : Bare_R_F_L_X_Node_Base_List; Info : Internal_Entity_Info)
         return Internal_Entity_R_F_L_X_Node_Base_List is
      begin
         if Node = null then
            return No_Entity_R_F_L_X_Node_Base_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_R_F_L_X_Node_Base_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Aspect_List
        (Node : Bare_Aspect_List; Info : Internal_Entity_Info)
         return Internal_Entity_Aspect_List is
      begin
         if Node = null then
            return No_Entity_Aspect_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Aspect_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Statement
        (Node : Bare_Statement; Info : Internal_Entity_Info)
         return Internal_Entity_Statement is
      begin
         if Node = null then
            return No_Entity_Statement;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Statement) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Assignment
        (Node : Bare_Assignment; Info : Internal_Entity_Info)
         return Internal_Entity_Assignment is
      begin
         if Node = null then
            return No_Entity_Assignment;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Assignment) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Attr
        (Node : Bare_Attr; Info : Internal_Entity_Info)
         return Internal_Entity_Attr is
      begin
         if Node = null then
            return No_Entity_Attr;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Attr) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Attr_First
        (Node : Bare_Attr_First; Info : Internal_Entity_Info)
         return Internal_Entity_Attr_First is
      begin
         if Node = null then
            return No_Entity_Attr_First;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Attr_First) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Attr_Has_Data
        (Node : Bare_Attr_Has_Data; Info : Internal_Entity_Info)
         return Internal_Entity_Attr_Has_Data is
      begin
         if Node = null then
            return No_Entity_Attr_Has_Data;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Attr_Has_Data) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Attr_Head
        (Node : Bare_Attr_Head; Info : Internal_Entity_Info)
         return Internal_Entity_Attr_Head is
      begin
         if Node = null then
            return No_Entity_Attr_Head;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Attr_Head) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Attr_Last
        (Node : Bare_Attr_Last; Info : Internal_Entity_Info)
         return Internal_Entity_Attr_Last is
      begin
         if Node = null then
            return No_Entity_Attr_Last;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Attr_Last) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Attr_Opaque
        (Node : Bare_Attr_Opaque; Info : Internal_Entity_Info)
         return Internal_Entity_Attr_Opaque is
      begin
         if Node = null then
            return No_Entity_Attr_Opaque;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Attr_Opaque) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Attr_Present
        (Node : Bare_Attr_Present; Info : Internal_Entity_Info)
         return Internal_Entity_Attr_Present is
      begin
         if Node = null then
            return No_Entity_Attr_Present;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Attr_Present) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Attr_Size
        (Node : Bare_Attr_Size; Info : Internal_Entity_Info)
         return Internal_Entity_Attr_Size is
      begin
         if Node = null then
            return No_Entity_Attr_Size;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Attr_Size) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Attr_Stmt
        (Node : Bare_Attr_Stmt; Info : Internal_Entity_Info)
         return Internal_Entity_Attr_Stmt is
      begin
         if Node = null then
            return No_Entity_Attr_Stmt;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Attr_Stmt) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Attr_Stmt_Append
        (Node : Bare_Attr_Stmt_Append; Info : Internal_Entity_Info)
         return Internal_Entity_Attr_Stmt_Append is
      begin
         if Node = null then
            return No_Entity_Attr_Stmt_Append;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Attr_Stmt_Append) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Attr_Stmt_Extend
        (Node : Bare_Attr_Stmt_Extend; Info : Internal_Entity_Info)
         return Internal_Entity_Attr_Stmt_Extend is
      begin
         if Node = null then
            return No_Entity_Attr_Stmt_Extend;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Attr_Stmt_Extend) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Attr_Stmt_Read
        (Node : Bare_Attr_Stmt_Read; Info : Internal_Entity_Info)
         return Internal_Entity_Attr_Stmt_Read is
      begin
         if Node = null then
            return No_Entity_Attr_Stmt_Read;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Attr_Stmt_Read) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Attr_Stmt_Write
        (Node : Bare_Attr_Stmt_Write; Info : Internal_Entity_Info)
         return Internal_Entity_Attr_Stmt_Write is
      begin
         if Node = null then
            return No_Entity_Attr_Stmt_Write;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Attr_Stmt_Write) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Attr_Valid
        (Node : Bare_Attr_Valid; Info : Internal_Entity_Info)
         return Internal_Entity_Attr_Valid is
      begin
         if Node = null then
            return No_Entity_Attr_Valid;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Attr_Valid) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Attr_Valid_Checksum
        (Node : Bare_Attr_Valid_Checksum; Info : Internal_Entity_Info)
         return Internal_Entity_Attr_Valid_Checksum is
      begin
         if Node = null then
            return No_Entity_Attr_Valid_Checksum;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Attr_Valid_Checksum) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Expr
        (Node : Bare_Expr; Info : Internal_Entity_Info)
         return Internal_Entity_Expr is
      begin
         if Node = null then
            return No_Entity_Expr;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Expr) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Attribute
        (Node : Bare_Attribute; Info : Internal_Entity_Info)
         return Internal_Entity_Attribute is
      begin
         if Node = null then
            return No_Entity_Attribute;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Attribute) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Attribute_Statement
        (Node : Bare_Attribute_Statement; Info : Internal_Entity_Info)
         return Internal_Entity_Attribute_Statement is
      begin
         if Node = null then
            return No_Entity_Attribute_Statement;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Attribute_Statement) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Base_Aggregate
        (Node : Bare_Base_Aggregate; Info : Internal_Entity_Info)
         return Internal_Entity_Base_Aggregate is
      begin
         if Node = null then
            return No_Entity_Base_Aggregate;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Base_Aggregate) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Base_Checksum_Val
        (Node : Bare_Base_Checksum_Val; Info : Internal_Entity_Info)
         return Internal_Entity_Base_Checksum_Val is
      begin
         if Node = null then
            return No_Entity_Base_Checksum_Val;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Base_Checksum_Val) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Base_Checksum_Val_List
        (Node : Bare_Base_Checksum_Val_List; Info : Internal_Entity_Info)
         return Internal_Entity_Base_Checksum_Val_List is
      begin
         if Node = null then
            return No_Entity_Base_Checksum_Val_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Base_Checksum_Val_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Bin_Op
        (Node : Bare_Bin_Op; Info : Internal_Entity_Info)
         return Internal_Entity_Bin_Op is
      begin
         if Node = null then
            return No_Entity_Bin_Op;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Bin_Op) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Binding
        (Node : Bare_Binding; Info : Internal_Entity_Info)
         return Internal_Entity_Binding is
      begin
         if Node = null then
            return No_Entity_Binding;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Binding) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Message_Aspect
        (Node : Bare_Message_Aspect; Info : Internal_Entity_Info)
         return Internal_Entity_Message_Aspect is
      begin
         if Node = null then
            return No_Entity_Message_Aspect;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Message_Aspect) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Byte_Order_Aspect
        (Node : Bare_Byte_Order_Aspect; Info : Internal_Entity_Info)
         return Internal_Entity_Byte_Order_Aspect is
      begin
         if Node = null then
            return No_Entity_Byte_Order_Aspect;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Byte_Order_Aspect) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Byte_Order_Type
        (Node : Bare_Byte_Order_Type; Info : Internal_Entity_Info)
         return Internal_Entity_Byte_Order_Type is
      begin
         if Node = null then
            return No_Entity_Byte_Order_Type;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Byte_Order_Type) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Byte_Order_Type_Highorderfirst
        (Node : Bare_Byte_Order_Type_Highorderfirst; Info : Internal_Entity_Info)
         return Internal_Entity_Byte_Order_Type_Highorderfirst is
      begin
         if Node = null then
            return No_Entity_Byte_Order_Type_Highorderfirst;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Byte_Order_Type_Highorderfirst) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Byte_Order_Type_Loworderfirst
        (Node : Bare_Byte_Order_Type_Loworderfirst; Info : Internal_Entity_Info)
         return Internal_Entity_Byte_Order_Type_Loworderfirst is
      begin
         if Node = null then
            return No_Entity_Byte_Order_Type_Loworderfirst;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Byte_Order_Type_Loworderfirst) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Call
        (Node : Bare_Call; Info : Internal_Entity_Info)
         return Internal_Entity_Call is
      begin
         if Node = null then
            return No_Entity_Call;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Call) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Case_Expression
        (Node : Bare_Case_Expression; Info : Internal_Entity_Info)
         return Internal_Entity_Case_Expression is
      begin
         if Node = null then
            return No_Entity_Case_Expression;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Case_Expression) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Channel_Attribute
        (Node : Bare_Channel_Attribute; Info : Internal_Entity_Info)
         return Internal_Entity_Channel_Attribute is
      begin
         if Node = null then
            return No_Entity_Channel_Attribute;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Channel_Attribute) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Channel_Attribute_List
        (Node : Bare_Channel_Attribute_List; Info : Internal_Entity_Info)
         return Internal_Entity_Channel_Attribute_List is
      begin
         if Node = null then
            return No_Entity_Channel_Attribute_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Channel_Attribute_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Checksum_Aspect
        (Node : Bare_Checksum_Aspect; Info : Internal_Entity_Info)
         return Internal_Entity_Checksum_Aspect is
      begin
         if Node = null then
            return No_Entity_Checksum_Aspect;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Checksum_Aspect) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Checksum_Assoc
        (Node : Bare_Checksum_Assoc; Info : Internal_Entity_Info)
         return Internal_Entity_Checksum_Assoc is
      begin
         if Node = null then
            return No_Entity_Checksum_Assoc;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Checksum_Assoc) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Checksum_Assoc_List
        (Node : Bare_Checksum_Assoc_List; Info : Internal_Entity_Info)
         return Internal_Entity_Checksum_Assoc_List is
      begin
         if Node = null then
            return No_Entity_Checksum_Assoc_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Checksum_Assoc_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Checksum_Val
        (Node : Bare_Checksum_Val; Info : Internal_Entity_Info)
         return Internal_Entity_Checksum_Val is
      begin
         if Node = null then
            return No_Entity_Checksum_Val;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Checksum_Val) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Checksum_Value_Range
        (Node : Bare_Checksum_Value_Range; Info : Internal_Entity_Info)
         return Internal_Entity_Checksum_Value_Range is
      begin
         if Node = null then
            return No_Entity_Checksum_Value_Range;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Checksum_Value_Range) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Choice
        (Node : Bare_Choice; Info : Internal_Entity_Info)
         return Internal_Entity_Choice is
      begin
         if Node = null then
            return No_Entity_Choice;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Choice) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Choice_List
        (Node : Bare_Choice_List; Info : Internal_Entity_Info)
         return Internal_Entity_Choice_List is
      begin
         if Node = null then
            return No_Entity_Choice_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Choice_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Comprehension
        (Node : Bare_Comprehension; Info : Internal_Entity_Info)
         return Internal_Entity_Comprehension is
      begin
         if Node = null then
            return No_Entity_Comprehension;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Comprehension) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Sequence_Literal
        (Node : Bare_Sequence_Literal; Info : Internal_Entity_Info)
         return Internal_Entity_Sequence_Literal is
      begin
         if Node = null then
            return No_Entity_Sequence_Literal;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Sequence_Literal) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Concatenation
        (Node : Bare_Concatenation; Info : Internal_Entity_Info)
         return Internal_Entity_Concatenation is
      begin
         if Node = null then
            return No_Entity_Concatenation;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Concatenation) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Transition
        (Node : Bare_Transition; Info : Internal_Entity_Info)
         return Internal_Entity_Transition is
      begin
         if Node = null then
            return No_Entity_Transition;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Transition) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Conditional_Transition
        (Node : Bare_Conditional_Transition; Info : Internal_Entity_Info)
         return Internal_Entity_Conditional_Transition is
      begin
         if Node = null then
            return No_Entity_Conditional_Transition;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Conditional_Transition) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Conditional_Transition_List
        (Node : Bare_Conditional_Transition_List; Info : Internal_Entity_Info)
         return Internal_Entity_Conditional_Transition_List is
      begin
         if Node = null then
            return No_Entity_Conditional_Transition_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Conditional_Transition_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Context_Item
        (Node : Bare_Context_Item; Info : Internal_Entity_Info)
         return Internal_Entity_Context_Item is
      begin
         if Node = null then
            return No_Entity_Context_Item;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Context_Item) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Context_Item_List
        (Node : Bare_Context_Item_List; Info : Internal_Entity_Info)
         return Internal_Entity_Context_Item_List is
      begin
         if Node = null then
            return No_Entity_Context_Item_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Context_Item_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Conversion
        (Node : Bare_Conversion; Info : Internal_Entity_Info)
         return Internal_Entity_Conversion is
      begin
         if Node = null then
            return No_Entity_Conversion;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Conversion) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Declaration
        (Node : Bare_Declaration; Info : Internal_Entity_Info)
         return Internal_Entity_Declaration is
      begin
         if Node = null then
            return No_Entity_Declaration;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Declaration) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Declaration_List
        (Node : Bare_Declaration_List; Info : Internal_Entity_Info)
         return Internal_Entity_Declaration_List is
      begin
         if Node = null then
            return No_Entity_Declaration_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Declaration_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Description
        (Node : Bare_Description; Info : Internal_Entity_Info)
         return Internal_Entity_Description is
      begin
         if Node = null then
            return No_Entity_Description;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Description) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Element_Value_Assoc
        (Node : Bare_Element_Value_Assoc; Info : Internal_Entity_Info)
         return Internal_Entity_Element_Value_Assoc is
      begin
         if Node = null then
            return No_Entity_Element_Value_Assoc;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Element_Value_Assoc) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Element_Value_Assoc_List
        (Node : Bare_Element_Value_Assoc_List; Info : Internal_Entity_Info)
         return Internal_Entity_Element_Value_Assoc_List is
      begin
         if Node = null then
            return No_Entity_Element_Value_Assoc_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Element_Value_Assoc_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Enumeration_Def
        (Node : Bare_Enumeration_Def; Info : Internal_Entity_Info)
         return Internal_Entity_Enumeration_Def is
      begin
         if Node = null then
            return No_Entity_Enumeration_Def;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Enumeration_Def) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Enumeration_Type_Def
        (Node : Bare_Enumeration_Type_Def; Info : Internal_Entity_Info)
         return Internal_Entity_Enumeration_Type_Def is
      begin
         if Node = null then
            return No_Entity_Enumeration_Type_Def;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Enumeration_Type_Def) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Expr_List
        (Node : Bare_Expr_List; Info : Internal_Entity_Info)
         return Internal_Entity_Expr_List is
      begin
         if Node = null then
            return No_Entity_Expr_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Expr_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Formal_Decl
        (Node : Bare_Formal_Decl; Info : Internal_Entity_Info)
         return Internal_Entity_Formal_Decl is
      begin
         if Node = null then
            return No_Entity_Formal_Decl;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Formal_Decl) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Formal_Channel_Decl
        (Node : Bare_Formal_Channel_Decl; Info : Internal_Entity_Info)
         return Internal_Entity_Formal_Channel_Decl is
      begin
         if Node = null then
            return No_Entity_Formal_Channel_Decl;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Formal_Channel_Decl) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Formal_Decl_List
        (Node : Bare_Formal_Decl_List; Info : Internal_Entity_Info)
         return Internal_Entity_Formal_Decl_List is
      begin
         if Node = null then
            return No_Entity_Formal_Decl_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Formal_Decl_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Formal_Function_Decl
        (Node : Bare_Formal_Function_Decl; Info : Internal_Entity_Info)
         return Internal_Entity_Formal_Function_Decl is
      begin
         if Node = null then
            return No_Entity_Formal_Function_Decl;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Formal_Function_Decl) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_I_D
        (Node : Bare_I_D; Info : Internal_Entity_Info)
         return Internal_Entity_I_D is
      begin
         if Node = null then
            return No_Entity_I_D;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_I_D) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Integer_Type_Def
        (Node : Bare_Integer_Type_Def; Info : Internal_Entity_Info)
         return Internal_Entity_Integer_Type_Def is
      begin
         if Node = null then
            return No_Entity_Integer_Type_Def;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Integer_Type_Def) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Local_Decl
        (Node : Bare_Local_Decl; Info : Internal_Entity_Info)
         return Internal_Entity_Local_Decl is
      begin
         if Node = null then
            return No_Entity_Local_Decl;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Local_Decl) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Local_Decl_List
        (Node : Bare_Local_Decl_List; Info : Internal_Entity_Info)
         return Internal_Entity_Local_Decl_List is
      begin
         if Node = null then
            return No_Entity_Local_Decl_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Local_Decl_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Message_Aggregate
        (Node : Bare_Message_Aggregate; Info : Internal_Entity_Info)
         return Internal_Entity_Message_Aggregate is
      begin
         if Node = null then
            return No_Entity_Message_Aggregate;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Message_Aggregate) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Message_Aggregate_Association
        (Node : Bare_Message_Aggregate_Association; Info : Internal_Entity_Info)
         return Internal_Entity_Message_Aggregate_Association is
      begin
         if Node = null then
            return No_Entity_Message_Aggregate_Association;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Message_Aggregate_Association) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Message_Aggregate_Association_List
        (Node : Bare_Message_Aggregate_Association_List; Info : Internal_Entity_Info)
         return Internal_Entity_Message_Aggregate_Association_List is
      begin
         if Node = null then
            return No_Entity_Message_Aggregate_Association_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Message_Aggregate_Association_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Message_Aggregate_Associations
        (Node : Bare_Message_Aggregate_Associations; Info : Internal_Entity_Info)
         return Internal_Entity_Message_Aggregate_Associations is
      begin
         if Node = null then
            return No_Entity_Message_Aggregate_Associations;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Message_Aggregate_Associations) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Message_Aspect_List
        (Node : Bare_Message_Aspect_List; Info : Internal_Entity_Info)
         return Internal_Entity_Message_Aspect_List is
      begin
         if Node = null then
            return No_Entity_Message_Aspect_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Message_Aspect_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Message_Field
        (Node : Bare_Message_Field; Info : Internal_Entity_Info)
         return Internal_Entity_Message_Field is
      begin
         if Node = null then
            return No_Entity_Message_Field;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Message_Field) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Message_Field_Assignment
        (Node : Bare_Message_Field_Assignment; Info : Internal_Entity_Info)
         return Internal_Entity_Message_Field_Assignment is
      begin
         if Node = null then
            return No_Entity_Message_Field_Assignment;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Message_Field_Assignment) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Message_Field_List
        (Node : Bare_Message_Field_List; Info : Internal_Entity_Info)
         return Internal_Entity_Message_Field_List is
      begin
         if Node = null then
            return No_Entity_Message_Field_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Message_Field_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Message_Fields
        (Node : Bare_Message_Fields; Info : Internal_Entity_Info)
         return Internal_Entity_Message_Fields is
      begin
         if Node = null then
            return No_Entity_Message_Fields;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Message_Fields) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Message_Type_Def
        (Node : Bare_Message_Type_Def; Info : Internal_Entity_Info)
         return Internal_Entity_Message_Type_Def is
      begin
         if Node = null then
            return No_Entity_Message_Type_Def;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Message_Type_Def) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Modular_Type_Def
        (Node : Bare_Modular_Type_Def; Info : Internal_Entity_Info)
         return Internal_Entity_Modular_Type_Def is
      begin
         if Node = null then
            return No_Entity_Modular_Type_Def;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Modular_Type_Def) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Named_Enumeration_Def
        (Node : Bare_Named_Enumeration_Def; Info : Internal_Entity_Info)
         return Internal_Entity_Named_Enumeration_Def is
      begin
         if Node = null then
            return No_Entity_Named_Enumeration_Def;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Named_Enumeration_Def) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Negation
        (Node : Bare_Negation; Info : Internal_Entity_Info)
         return Internal_Entity_Negation is
      begin
         if Node = null then
            return No_Entity_Negation;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Negation) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Null_Message_Aggregate
        (Node : Bare_Null_Message_Aggregate; Info : Internal_Entity_Info)
         return Internal_Entity_Null_Message_Aggregate is
      begin
         if Node = null then
            return No_Entity_Null_Message_Aggregate;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Null_Message_Aggregate) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Null_Message_Field
        (Node : Bare_Null_Message_Field; Info : Internal_Entity_Info)
         return Internal_Entity_Null_Message_Field is
      begin
         if Node = null then
            return No_Entity_Null_Message_Field;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Null_Message_Field) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Null_Message_Type_Def
        (Node : Bare_Null_Message_Type_Def; Info : Internal_Entity_Info)
         return Internal_Entity_Null_Message_Type_Def is
      begin
         if Node = null then
            return No_Entity_Null_Message_Type_Def;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Null_Message_Type_Def) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Numeric_Literal
        (Node : Bare_Numeric_Literal; Info : Internal_Entity_Info)
         return Internal_Entity_Numeric_Literal is
      begin
         if Node = null then
            return No_Entity_Numeric_Literal;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Numeric_Literal) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Numeric_Literal_List
        (Node : Bare_Numeric_Literal_List; Info : Internal_Entity_Info)
         return Internal_Entity_Numeric_Literal_List is
      begin
         if Node = null then
            return No_Entity_Numeric_Literal_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Numeric_Literal_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Op
        (Node : Bare_Op; Info : Internal_Entity_Info)
         return Internal_Entity_Op is
      begin
         if Node = null then
            return No_Entity_Op;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Op) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Op_Add
        (Node : Bare_Op_Add; Info : Internal_Entity_Info)
         return Internal_Entity_Op_Add is
      begin
         if Node = null then
            return No_Entity_Op_Add;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Op_Add) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Op_And
        (Node : Bare_Op_And; Info : Internal_Entity_Info)
         return Internal_Entity_Op_And is
      begin
         if Node = null then
            return No_Entity_Op_And;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Op_And) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Op_Div
        (Node : Bare_Op_Div; Info : Internal_Entity_Info)
         return Internal_Entity_Op_Div is
      begin
         if Node = null then
            return No_Entity_Op_Div;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Op_Div) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Op_Eq
        (Node : Bare_Op_Eq; Info : Internal_Entity_Info)
         return Internal_Entity_Op_Eq is
      begin
         if Node = null then
            return No_Entity_Op_Eq;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Op_Eq) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Op_Ge
        (Node : Bare_Op_Ge; Info : Internal_Entity_Info)
         return Internal_Entity_Op_Ge is
      begin
         if Node = null then
            return No_Entity_Op_Ge;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Op_Ge) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Op_Gt
        (Node : Bare_Op_Gt; Info : Internal_Entity_Info)
         return Internal_Entity_Op_Gt is
      begin
         if Node = null then
            return No_Entity_Op_Gt;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Op_Gt) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Op_In
        (Node : Bare_Op_In; Info : Internal_Entity_Info)
         return Internal_Entity_Op_In is
      begin
         if Node = null then
            return No_Entity_Op_In;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Op_In) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Op_Le
        (Node : Bare_Op_Le; Info : Internal_Entity_Info)
         return Internal_Entity_Op_Le is
      begin
         if Node = null then
            return No_Entity_Op_Le;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Op_Le) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Op_Lt
        (Node : Bare_Op_Lt; Info : Internal_Entity_Info)
         return Internal_Entity_Op_Lt is
      begin
         if Node = null then
            return No_Entity_Op_Lt;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Op_Lt) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Op_Mod
        (Node : Bare_Op_Mod; Info : Internal_Entity_Info)
         return Internal_Entity_Op_Mod is
      begin
         if Node = null then
            return No_Entity_Op_Mod;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Op_Mod) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Op_Mul
        (Node : Bare_Op_Mul; Info : Internal_Entity_Info)
         return Internal_Entity_Op_Mul is
      begin
         if Node = null then
            return No_Entity_Op_Mul;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Op_Mul) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Op_Neq
        (Node : Bare_Op_Neq; Info : Internal_Entity_Info)
         return Internal_Entity_Op_Neq is
      begin
         if Node = null then
            return No_Entity_Op_Neq;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Op_Neq) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Op_Notin
        (Node : Bare_Op_Notin; Info : Internal_Entity_Info)
         return Internal_Entity_Op_Notin is
      begin
         if Node = null then
            return No_Entity_Op_Notin;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Op_Notin) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Op_Or
        (Node : Bare_Op_Or; Info : Internal_Entity_Info)
         return Internal_Entity_Op_Or is
      begin
         if Node = null then
            return No_Entity_Op_Or;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Op_Or) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Op_Pow
        (Node : Bare_Op_Pow; Info : Internal_Entity_Info)
         return Internal_Entity_Op_Pow is
      begin
         if Node = null then
            return No_Entity_Op_Pow;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Op_Pow) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Op_Sub
        (Node : Bare_Op_Sub; Info : Internal_Entity_Info)
         return Internal_Entity_Op_Sub is
      begin
         if Node = null then
            return No_Entity_Op_Sub;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Op_Sub) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Package_Node
        (Node : Bare_Package_Node; Info : Internal_Entity_Info)
         return Internal_Entity_Package_Node is
      begin
         if Node = null then
            return No_Entity_Package_Node;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Package_Node) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Parameter
        (Node : Bare_Parameter; Info : Internal_Entity_Info)
         return Internal_Entity_Parameter is
      begin
         if Node = null then
            return No_Entity_Parameter;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Parameter) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Parameter_List
        (Node : Bare_Parameter_List; Info : Internal_Entity_Info)
         return Internal_Entity_Parameter_List is
      begin
         if Node = null then
            return No_Entity_Parameter_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Parameter_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Parameters
        (Node : Bare_Parameters; Info : Internal_Entity_Info)
         return Internal_Entity_Parameters is
      begin
         if Node = null then
            return No_Entity_Parameters;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Parameters) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Paren_Expression
        (Node : Bare_Paren_Expression; Info : Internal_Entity_Info)
         return Internal_Entity_Paren_Expression is
      begin
         if Node = null then
            return No_Entity_Paren_Expression;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Paren_Expression) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Positional_Enumeration_Def
        (Node : Bare_Positional_Enumeration_Def; Info : Internal_Entity_Info)
         return Internal_Entity_Positional_Enumeration_Def is
      begin
         if Node = null then
            return No_Entity_Positional_Enumeration_Def;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Positional_Enumeration_Def) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Quantified_Expression
        (Node : Bare_Quantified_Expression; Info : Internal_Entity_Info)
         return Internal_Entity_Quantified_Expression is
      begin
         if Node = null then
            return No_Entity_Quantified_Expression;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Quantified_Expression) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Quantifier
        (Node : Bare_Quantifier; Info : Internal_Entity_Info)
         return Internal_Entity_Quantifier is
      begin
         if Node = null then
            return No_Entity_Quantifier;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Quantifier) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Quantifier_All
        (Node : Bare_Quantifier_All; Info : Internal_Entity_Info)
         return Internal_Entity_Quantifier_All is
      begin
         if Node = null then
            return No_Entity_Quantifier_All;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Quantifier_All) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Quantifier_Some
        (Node : Bare_Quantifier_Some; Info : Internal_Entity_Info)
         return Internal_Entity_Quantifier_Some is
      begin
         if Node = null then
            return No_Entity_Quantifier_Some;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Quantifier_Some) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_R_F_L_X_Node_List
        (Node : Bare_R_F_L_X_Node_List; Info : Internal_Entity_Info)
         return Internal_Entity_R_F_L_X_Node_List is
      begin
         if Node = null then
            return No_Entity_R_F_L_X_Node_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_R_F_L_X_Node_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Range_Type_Def
        (Node : Bare_Range_Type_Def; Info : Internal_Entity_Info)
         return Internal_Entity_Range_Type_Def is
      begin
         if Node = null then
            return No_Entity_Range_Type_Def;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Range_Type_Def) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Readable
        (Node : Bare_Readable; Info : Internal_Entity_Info)
         return Internal_Entity_Readable is
      begin
         if Node = null then
            return No_Entity_Readable;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Readable) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Refinement_Decl
        (Node : Bare_Refinement_Decl; Info : Internal_Entity_Info)
         return Internal_Entity_Refinement_Decl is
      begin
         if Node = null then
            return No_Entity_Refinement_Decl;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Refinement_Decl) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Renaming_Decl
        (Node : Bare_Renaming_Decl; Info : Internal_Entity_Info)
         return Internal_Entity_Renaming_Decl is
      begin
         if Node = null then
            return No_Entity_Renaming_Decl;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Renaming_Decl) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Reset
        (Node : Bare_Reset; Info : Internal_Entity_Info)
         return Internal_Entity_Reset is
      begin
         if Node = null then
            return No_Entity_Reset;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Reset) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Select_Node
        (Node : Bare_Select_Node; Info : Internal_Entity_Info)
         return Internal_Entity_Select_Node is
      begin
         if Node = null then
            return No_Entity_Select_Node;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Select_Node) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Sequence_Aggregate
        (Node : Bare_Sequence_Aggregate; Info : Internal_Entity_Info)
         return Internal_Entity_Sequence_Aggregate is
      begin
         if Node = null then
            return No_Entity_Sequence_Aggregate;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Sequence_Aggregate) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Sequence_Type_Def
        (Node : Bare_Sequence_Type_Def; Info : Internal_Entity_Info)
         return Internal_Entity_Sequence_Type_Def is
      begin
         if Node = null then
            return No_Entity_Sequence_Type_Def;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Sequence_Type_Def) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Session_Decl
        (Node : Bare_Session_Decl; Info : Internal_Entity_Info)
         return Internal_Entity_Session_Decl is
      begin
         if Node = null then
            return No_Entity_Session_Decl;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Session_Decl) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Specification
        (Node : Bare_Specification; Info : Internal_Entity_Info)
         return Internal_Entity_Specification is
      begin
         if Node = null then
            return No_Entity_Specification;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Specification) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_State
        (Node : Bare_State; Info : Internal_Entity_Info)
         return Internal_Entity_State is
      begin
         if Node = null then
            return No_Entity_State;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_State) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_State_Body
        (Node : Bare_State_Body; Info : Internal_Entity_Info)
         return Internal_Entity_State_Body is
      begin
         if Node = null then
            return No_Entity_State_Body;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_State_Body) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_State_List
        (Node : Bare_State_List; Info : Internal_Entity_Info)
         return Internal_Entity_State_List is
      begin
         if Node = null then
            return No_Entity_State_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_State_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Statement_List
        (Node : Bare_Statement_List; Info : Internal_Entity_Info)
         return Internal_Entity_Statement_List is
      begin
         if Node = null then
            return No_Entity_Statement_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Statement_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_String_Literal
        (Node : Bare_String_Literal; Info : Internal_Entity_Info)
         return Internal_Entity_String_Literal is
      begin
         if Node = null then
            return No_Entity_String_Literal;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_String_Literal) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Term_Assoc
        (Node : Bare_Term_Assoc; Info : Internal_Entity_Info)
         return Internal_Entity_Term_Assoc is
      begin
         if Node = null then
            return No_Entity_Term_Assoc;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Term_Assoc) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Term_Assoc_List
        (Node : Bare_Term_Assoc_List; Info : Internal_Entity_Info)
         return Internal_Entity_Term_Assoc_List is
      begin
         if Node = null then
            return No_Entity_Term_Assoc_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Term_Assoc_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Then_Node
        (Node : Bare_Then_Node; Info : Internal_Entity_Info)
         return Internal_Entity_Then_Node is
      begin
         if Node = null then
            return No_Entity_Then_Node;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Then_Node) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Then_Node_List
        (Node : Bare_Then_Node_List; Info : Internal_Entity_Info)
         return Internal_Entity_Then_Node_List is
      begin
         if Node = null then
            return No_Entity_Then_Node_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Then_Node_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Type_Argument
        (Node : Bare_Type_Argument; Info : Internal_Entity_Info)
         return Internal_Entity_Type_Argument is
      begin
         if Node = null then
            return No_Entity_Type_Argument;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Type_Argument) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Type_Argument_List
        (Node : Bare_Type_Argument_List; Info : Internal_Entity_Info)
         return Internal_Entity_Type_Argument_List is
      begin
         if Node = null then
            return No_Entity_Type_Argument_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Type_Argument_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Type_Decl
        (Node : Bare_Type_Decl; Info : Internal_Entity_Info)
         return Internal_Entity_Type_Decl is
      begin
         if Node = null then
            return No_Entity_Type_Decl;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Type_Decl) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Type_Derivation_Def
        (Node : Bare_Type_Derivation_Def; Info : Internal_Entity_Info)
         return Internal_Entity_Type_Derivation_Def is
      begin
         if Node = null then
            return No_Entity_Type_Derivation_Def;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Type_Derivation_Def) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Unqualified_I_D
        (Node : Bare_Unqualified_I_D; Info : Internal_Entity_Info)
         return Internal_Entity_Unqualified_I_D is
      begin
         if Node = null then
            return No_Entity_Unqualified_I_D;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Unqualified_I_D) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Unqualified_I_D_List
        (Node : Bare_Unqualified_I_D_List; Info : Internal_Entity_Info)
         return Internal_Entity_Unqualified_I_D_List is
      begin
         if Node = null then
            return No_Entity_Unqualified_I_D_List;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Unqualified_I_D_List) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Variable
        (Node : Bare_Variable; Info : Internal_Entity_Info)
         return Internal_Entity_Variable is
      begin
         if Node = null then
            return No_Entity_Variable;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Variable) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Variable_Decl
        (Node : Bare_Variable_Decl; Info : Internal_Entity_Info)
         return Internal_Entity_Variable_Decl is
      begin
         if Node = null then
            return No_Entity_Variable_Decl;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Variable_Decl) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   



      function Create_Internal_Entity_Writable
        (Node : Bare_Writable; Info : Internal_Entity_Info)
         return Internal_Entity_Writable is
      begin
         if Node = null then
            return No_Entity_Writable;
         end if;
         return (Node => Node, Info => Info);
      end;



   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Entity_Writable) return String is
         pragma Warnings (On, "referenced");
      begin
            return Image (Entity'(Node => R.Node, Info => R.Info));
      end Trace_Image;


   

   


      -------------
      -- Inc_Ref --
      -------------

      procedure Inc_Ref (R : Internal_Env_Assoc) is
      begin
               Inc_Ref (R.Dest_Env);
      end Inc_Ref;

      -------------
      -- Dec_Ref --
      -------------

      procedure Dec_Ref (R : in out Internal_Env_Assoc) is
      begin
               Dec_Ref (R.Dest_Env);
      end Dec_Ref;




      ----------------
      -- Equivalent --
      ----------------

      function Equivalent (L, R : Internal_Env_Assoc) return Boolean is
      begin
         return L.Key = R.Key and then L.Value = R.Value and then Equivalent (L.Dest_Env, R.Dest_Env) and then L.Metadata = R.Metadata;
      end Equivalent;


   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Env_Assoc) return String is
         pragma Warnings (On, "referenced");
      begin
            return
              ("("
                     & "Key => " & Trace_Image (R.Key)
                        & ", "
                     & "Value => " & Trace_Image (R.Value)
                        & ", "
                     & "Dest_Env => " & Trace_Image (R.Dest_Env)
                        & ", "
                     & "Metadata => " & Trace_Image (R.Metadata)
               & ")");
      end Trace_Image;


   

   




   


      -----------------
      -- Trace_Image --
      -----------------

      pragma Warnings (Off, "referenced");
      function Trace_Image (R : Internal_Inner_Env_Assoc) return String is
         pragma Warnings (On, "referenced");
      begin
            return
              ("("
                     & "Key => " & Trace_Image (R.Key)
                        & ", "
                     & "Value => " & Trace_Image (R.Value)
                        & ", "
                     & "Metadata => " & Trace_Image (R.Metadata)
               & ")");
      end Trace_Image;



   
         

         

         

         

         

         

         

         

         

         

         

         

         

         

         

         



      

   --
   --  Primitives for Bare_R_F_L_X_Node
   --

   





   







--# property-start RFLXNode.can_reach /data/devel/eng/recordflux/RecordFlux/.venv/lib/python3.11/site-packages/langkit/compiled_types.py:0
pragma Warnings (Off, "is not referenced");
 function R_F_L_X_Node_P_Can_Reach
  
  (Node : Bare_R_F_L_X_Node
      ; From_Node : Bare_R_F_L_X_Node
  )

   return Boolean
is
   Self : Bare_R_F_L_X_Node  := Bare_R_F_L_X_Node (Node);
      --# bind self Self

   

   --# bind from_node From_Node

   Property_Result : Boolean;

      

      Cast_Expr : Bare_R_F_L_X_Node;
Cast_Result : Bare_R_F_L_X_Node;
Is_Equal : Boolean;
Fld : Internal_Unit;
Fld_1 : Internal_Unit;
Is_Equal_1 : Boolean;
Not_Val : Boolean;
If_Result : Boolean;
Node_Comp : Boolean;
If_Result_1 : Boolean;
Let_Result : Boolean;



begin
   --# property-body-start

   pragma Assert (Self = Node);





      begin
         
   --# scope-start

         --# expr-start 7 '<Block at generate.py:26>' Let_Result /data/devel/eng/recordflux/RecordFlux/language/generate.py:26
--# scope-start






--# expr-start 1 '<Eq at generate.py:26>' Is_Equal /data/devel/eng/recordflux/RecordFlux/language/generate.py:26






Cast_Expr := From_Node; 



   
      Cast_Result := Cast_Expr;



Is_Equal := Cast_Result = No_Bare_R_F_L_X_Node; 
--# expr-done 1
if Is_Equal then
   
   If_Result := True;
else
   --# expr-start 5 '<Not at generate.py:26>' Not_Val /data/devel/eng/recordflux/RecordFlux/language/generate.py:26
--# expr-start 4 '<Eq at generate.py:26>' Is_Equal_1 /data/devel/eng/recordflux/RecordFlux/language/generate.py:26
--# expr-start 2 '<FieldAccess for unit at generate.py:26>' Fld /data/devel/eng/recordflux/RecordFlux/language/generate.py:26






   

      if Self = null then
         Raise_Property_Exception
           (Self, Property_Error'Identity, "dereferencing a null access");
      end if;



Fld := Librflxlang.Implementation.Unit (Node => Self);
--# expr-done 2
--# expr-start 3 '<FieldAccess for unit at generate.py:26>' Fld_1 /data/devel/eng/recordflux/RecordFlux/language/generate.py:26






   

      if From_Node = null then
         Raise_Property_Exception
           (Self, Property_Error'Identity, "dereferencing a null access");
      end if;



Fld_1 := Librflxlang.Implementation.Unit (Node => From_Node);
--# expr-done 3
Is_Equal_1 := Fld = Fld_1; 
--# expr-done 4
Not_Val := not (Is_Equal_1); 
--# expr-done 5
   If_Result := Not_Val;
end if;



if If_Result then
   
   If_Result_1 := True;
else
   --# expr-start 6 '<OrderingTest '"'"'lt'"'"' at generate.py:26>' Node_Comp /data/devel/eng/recordflux/RecordFlux/language/generate.py:26



Node_Comp := Compare (Self, Self, From_Node, Less_Than); 
--# expr-done 6
   If_Result_1 := Node_Comp;
end if;



Let_Result := If_Result_1; 
--# end
--# expr-done 7

         Property_Result := Let_Result;
         
   --# end


      exception
         when Exc : Property_Error =>



            raise;
      end;



   return Property_Result;
end R_F_L_X_Node_P_Can_Reach;
--# end



   


      

   --
   --  Primitives for Bare_Abstract_I_D
   --

   







   


      

   --
   --  Primitives for Bare_I_D
   --

   



      
      procedure Initialize_Fields_For_I_D
        (Self : Bare_I_D
         ; I_D_F_Package : Bare_Unqualified_I_D
         ; I_D_F_Name : Bare_Unqualified_I_D
        ) is
      begin

            Self.I_D_F_Package := I_D_F_Package;
            Self.I_D_F_Name := I_D_F_Name;
         

      end Initialize_Fields_For_I_D;

      
   function I_D_F_Package
     (Node : Bare_I_D) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.I_D_F_Package;
      
   end;

      
   function I_D_F_Name
     (Node : Bare_I_D) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.I_D_F_Name;
      
   end;




   


      

   --
   --  Primitives for Bare_Unqualified_I_D
   --

   







   


      

   --
   --  Primitives for Bare_Aspect
   --

   



      
      procedure Initialize_Fields_For_Aspect
        (Self : Bare_Aspect
         ; Aspect_F_Identifier : Bare_Unqualified_I_D
         ; Aspect_F_Value : Bare_Expr
        ) is
      begin

            Self.Aspect_F_Identifier := Aspect_F_Identifier;
            Self.Aspect_F_Value := Aspect_F_Value;
         

      end Initialize_Fields_For_Aspect;

      
   function Aspect_F_Identifier
     (Node : Bare_Aspect) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Aspect_F_Identifier;
      
   end;

      
   function Aspect_F_Value
     (Node : Bare_Aspect) return Bare_Expr
   is
      

   begin
         
         return Node.Aspect_F_Value;
      
   end;




   


      

   --
   --  Primitives for Bare_Attr
   --

   







   


      

   --
   --  Primitives for Bare_Attr_First
   --

   







   


      

   --
   --  Primitives for Bare_Attr_Has_Data
   --

   







   


      

   --
   --  Primitives for Bare_Attr_Head
   --

   







   


      

   --
   --  Primitives for Bare_Attr_Last
   --

   







   


      

   --
   --  Primitives for Bare_Attr_Opaque
   --

   







   


      

   --
   --  Primitives for Bare_Attr_Present
   --

   







   


      

   --
   --  Primitives for Bare_Attr_Size
   --

   







   


      

   --
   --  Primitives for Bare_Attr_Valid
   --

   







   


      

   --
   --  Primitives for Bare_Attr_Valid_Checksum
   --

   







   


      

   --
   --  Primitives for Bare_Attr_Stmt
   --

   







   


      

   --
   --  Primitives for Bare_Attr_Stmt_Append
   --

   







   


      

   --
   --  Primitives for Bare_Attr_Stmt_Extend
   --

   







   


      

   --
   --  Primitives for Bare_Attr_Stmt_Read
   --

   







   


      

   --
   --  Primitives for Bare_Attr_Stmt_Write
   --

   







   


      

   --
   --  Primitives for Bare_Base_Aggregate
   --

   







   


      

   --
   --  Primitives for Bare_Message_Aggregate_Associations
   --

   



      
      procedure Initialize_Fields_For_Message_Aggregate_Associations
        (Self : Bare_Message_Aggregate_Associations
         ; Message_Aggregate_Associations_F_Associations : Bare_Message_Aggregate_Association_List
        ) is
      begin

            Self.Message_Aggregate_Associations_F_Associations := Message_Aggregate_Associations_F_Associations;
         

      end Initialize_Fields_For_Message_Aggregate_Associations;

      
   function Message_Aggregate_Associations_F_Associations
     (Node : Bare_Message_Aggregate_Associations) return Bare_Message_Aggregate_Association_List
   is
      

   begin
         
         return Node.Message_Aggregate_Associations_F_Associations;
      
   end;




   


      

   --
   --  Primitives for Bare_Null_Message_Aggregate
   --

   







   


      

   --
   --  Primitives for Bare_Base_Checksum_Val
   --

   







   


      

   --
   --  Primitives for Bare_Checksum_Val
   --

   



      
      procedure Initialize_Fields_For_Checksum_Val
        (Self : Bare_Checksum_Val
         ; Checksum_Val_F_Data : Bare_Expr
        ) is
      begin

            Self.Checksum_Val_F_Data := Checksum_Val_F_Data;
         

      end Initialize_Fields_For_Checksum_Val;

      
   function Checksum_Val_F_Data
     (Node : Bare_Checksum_Val) return Bare_Expr
   is
      

   begin
         
         return Node.Checksum_Val_F_Data;
      
   end;




   


      

   --
   --  Primitives for Bare_Checksum_Value_Range
   --

   



      
      procedure Initialize_Fields_For_Checksum_Value_Range
        (Self : Bare_Checksum_Value_Range
         ; Checksum_Value_Range_F_First : Bare_Expr
         ; Checksum_Value_Range_F_Last : Bare_Expr
        ) is
      begin

            Self.Checksum_Value_Range_F_First := Checksum_Value_Range_F_First;
            Self.Checksum_Value_Range_F_Last := Checksum_Value_Range_F_Last;
         

      end Initialize_Fields_For_Checksum_Value_Range;

      
   function Checksum_Value_Range_F_First
     (Node : Bare_Checksum_Value_Range) return Bare_Expr
   is
      

   begin
         
         return Node.Checksum_Value_Range_F_First;
      
   end;

      
   function Checksum_Value_Range_F_Last
     (Node : Bare_Checksum_Value_Range) return Bare_Expr
   is
      

   begin
         
         return Node.Checksum_Value_Range_F_Last;
      
   end;




   


      

   --
   --  Primitives for Bare_Byte_Order_Type
   --

   







   


      

   --
   --  Primitives for Bare_Byte_Order_Type_Highorderfirst
   --

   







   


      

   --
   --  Primitives for Bare_Byte_Order_Type_Loworderfirst
   --

   







   


      

   --
   --  Primitives for Bare_Channel_Attribute
   --

   







   


      

   --
   --  Primitives for Bare_Readable
   --

   







   


      

   --
   --  Primitives for Bare_Writable
   --

   







   


      

   --
   --  Primitives for Bare_Checksum_Assoc
   --

   



      
      procedure Initialize_Fields_For_Checksum_Assoc
        (Self : Bare_Checksum_Assoc
         ; Checksum_Assoc_F_Identifier : Bare_Unqualified_I_D
         ; Checksum_Assoc_F_Covered_Fields : Bare_Base_Checksum_Val_List
        ) is
      begin

            Self.Checksum_Assoc_F_Identifier := Checksum_Assoc_F_Identifier;
            Self.Checksum_Assoc_F_Covered_Fields := Checksum_Assoc_F_Covered_Fields;
         

      end Initialize_Fields_For_Checksum_Assoc;

      
   function Checksum_Assoc_F_Identifier
     (Node : Bare_Checksum_Assoc) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Checksum_Assoc_F_Identifier;
      
   end;

      
   function Checksum_Assoc_F_Covered_Fields
     (Node : Bare_Checksum_Assoc) return Bare_Base_Checksum_Val_List
   is
      

   begin
         
         return Node.Checksum_Assoc_F_Covered_Fields;
      
   end;




   


      

   --
   --  Primitives for Bare_Declaration
   --

   







   


      

   --
   --  Primitives for Bare_Refinement_Decl
   --

   



      
      procedure Initialize_Fields_For_Refinement_Decl
        (Self : Bare_Refinement_Decl
         ; Refinement_Decl_F_Pdu : Bare_I_D
         ; Refinement_Decl_F_Field : Bare_Unqualified_I_D
         ; Refinement_Decl_F_Sdu : Bare_I_D
         ; Refinement_Decl_F_Condition : Bare_Expr
        ) is
      begin

            Self.Refinement_Decl_F_Pdu := Refinement_Decl_F_Pdu;
            Self.Refinement_Decl_F_Field := Refinement_Decl_F_Field;
            Self.Refinement_Decl_F_Sdu := Refinement_Decl_F_Sdu;
            Self.Refinement_Decl_F_Condition := Refinement_Decl_F_Condition;
         

      end Initialize_Fields_For_Refinement_Decl;

      
   function Refinement_Decl_F_Pdu
     (Node : Bare_Refinement_Decl) return Bare_I_D
   is
      

   begin
         
         return Node.Refinement_Decl_F_Pdu;
      
   end;

      
   function Refinement_Decl_F_Field
     (Node : Bare_Refinement_Decl) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Refinement_Decl_F_Field;
      
   end;

      
   function Refinement_Decl_F_Sdu
     (Node : Bare_Refinement_Decl) return Bare_I_D
   is
      

   begin
         
         return Node.Refinement_Decl_F_Sdu;
      
   end;

      
   function Refinement_Decl_F_Condition
     (Node : Bare_Refinement_Decl) return Bare_Expr
   is
      

   begin
         
         return Node.Refinement_Decl_F_Condition;
      
   end;




   


      

   --
   --  Primitives for Bare_Session_Decl
   --

   



      
      procedure Initialize_Fields_For_Session_Decl
        (Self : Bare_Session_Decl
         ; Session_Decl_F_Parameters : Bare_Formal_Decl_List
         ; Session_Decl_F_Identifier : Bare_Unqualified_I_D
         ; Session_Decl_F_Declarations : Bare_Local_Decl_List
         ; Session_Decl_F_States : Bare_State_List
         ; Session_Decl_F_End_Identifier : Bare_Unqualified_I_D
        ) is
      begin

            Self.Session_Decl_F_Parameters := Session_Decl_F_Parameters;
            Self.Session_Decl_F_Identifier := Session_Decl_F_Identifier;
            Self.Session_Decl_F_Declarations := Session_Decl_F_Declarations;
            Self.Session_Decl_F_States := Session_Decl_F_States;
            Self.Session_Decl_F_End_Identifier := Session_Decl_F_End_Identifier;
         

      end Initialize_Fields_For_Session_Decl;

      
   function Session_Decl_F_Parameters
     (Node : Bare_Session_Decl) return Bare_Formal_Decl_List
   is
      

   begin
         
         return Node.Session_Decl_F_Parameters;
      
   end;

      
   function Session_Decl_F_Identifier
     (Node : Bare_Session_Decl) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Session_Decl_F_Identifier;
      
   end;

      
   function Session_Decl_F_Declarations
     (Node : Bare_Session_Decl) return Bare_Local_Decl_List
   is
      

   begin
         
         return Node.Session_Decl_F_Declarations;
      
   end;

      
   function Session_Decl_F_States
     (Node : Bare_Session_Decl) return Bare_State_List
   is
      

   begin
         
         return Node.Session_Decl_F_States;
      
   end;

      
   function Session_Decl_F_End_Identifier
     (Node : Bare_Session_Decl) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Session_Decl_F_End_Identifier;
      
   end;




   


      

   --
   --  Primitives for Bare_Type_Decl
   --

   



      
      procedure Initialize_Fields_For_Type_Decl
        (Self : Bare_Type_Decl
         ; Type_Decl_F_Identifier : Bare_Unqualified_I_D
         ; Type_Decl_F_Parameters : Bare_Parameters
         ; Type_Decl_F_Definition : Bare_Type_Def
        ) is
      begin

            Self.Type_Decl_F_Identifier := Type_Decl_F_Identifier;
            Self.Type_Decl_F_Parameters := Type_Decl_F_Parameters;
            Self.Type_Decl_F_Definition := Type_Decl_F_Definition;
         

      end Initialize_Fields_For_Type_Decl;

      
   function Type_Decl_F_Identifier
     (Node : Bare_Type_Decl) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Type_Decl_F_Identifier;
      
   end;

      
   function Type_Decl_F_Parameters
     (Node : Bare_Type_Decl) return Bare_Parameters
   is
      

   begin
         
         return Node.Type_Decl_F_Parameters;
      
   end;

      
   function Type_Decl_F_Definition
     (Node : Bare_Type_Decl) return Bare_Type_Def
   is
      

   begin
         
         return Node.Type_Decl_F_Definition;
      
   end;




   


      

   --
   --  Primitives for Bare_Description
   --

   



      
      procedure Initialize_Fields_For_Description
        (Self : Bare_Description
         ; Description_F_Content : Bare_String_Literal
        ) is
      begin

            Self.Description_F_Content := Description_F_Content;
         

      end Initialize_Fields_For_Description;

      
   function Description_F_Content
     (Node : Bare_Description) return Bare_String_Literal
   is
      

   begin
         
         return Node.Description_F_Content;
      
   end;




   


      

   --
   --  Primitives for Bare_Element_Value_Assoc
   --

   



      
      procedure Initialize_Fields_For_Element_Value_Assoc
        (Self : Bare_Element_Value_Assoc
         ; Element_Value_Assoc_F_Identifier : Bare_Unqualified_I_D
         ; Element_Value_Assoc_F_Literal : Bare_Numeric_Literal
        ) is
      begin

            Self.Element_Value_Assoc_F_Identifier := Element_Value_Assoc_F_Identifier;
            Self.Element_Value_Assoc_F_Literal := Element_Value_Assoc_F_Literal;
         

      end Initialize_Fields_For_Element_Value_Assoc;

      
   function Element_Value_Assoc_F_Identifier
     (Node : Bare_Element_Value_Assoc) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Element_Value_Assoc_F_Identifier;
      
   end;

      
   function Element_Value_Assoc_F_Literal
     (Node : Bare_Element_Value_Assoc) return Bare_Numeric_Literal
   is
      

   begin
         
         return Node.Element_Value_Assoc_F_Literal;
      
   end;




   


      

   --
   --  Primitives for Bare_Expr
   --

   







   


      

   --
   --  Primitives for Bare_Attribute
   --

   



      
      procedure Initialize_Fields_For_Attribute
        (Self : Bare_Attribute
         ; Attribute_F_Expression : Bare_Expr
         ; Attribute_F_Kind : Bare_Attr
        ) is
      begin

            Self.Attribute_F_Expression := Attribute_F_Expression;
            Self.Attribute_F_Kind := Attribute_F_Kind;
         

      end Initialize_Fields_For_Attribute;

      
   function Attribute_F_Expression
     (Node : Bare_Attribute) return Bare_Expr
   is
      

   begin
         
         return Node.Attribute_F_Expression;
      
   end;

      
   function Attribute_F_Kind
     (Node : Bare_Attribute) return Bare_Attr
   is
      

   begin
         
         return Node.Attribute_F_Kind;
      
   end;




   


      

   --
   --  Primitives for Bare_Bin_Op
   --

   



      
      procedure Initialize_Fields_For_Bin_Op
        (Self : Bare_Bin_Op
         ; Bin_Op_F_Left : Bare_Expr
         ; Bin_Op_F_Op : Bare_Op
         ; Bin_Op_F_Right : Bare_Expr
        ) is
      begin

            Self.Bin_Op_F_Left := Bin_Op_F_Left;
            Self.Bin_Op_F_Op := Bin_Op_F_Op;
            Self.Bin_Op_F_Right := Bin_Op_F_Right;
         

      end Initialize_Fields_For_Bin_Op;

      
   function Bin_Op_F_Left
     (Node : Bare_Bin_Op) return Bare_Expr
   is
      

   begin
         
         return Node.Bin_Op_F_Left;
      
   end;

      
   function Bin_Op_F_Op
     (Node : Bare_Bin_Op) return Bare_Op
   is
      

   begin
         
         return Node.Bin_Op_F_Op;
      
   end;

      
   function Bin_Op_F_Right
     (Node : Bare_Bin_Op) return Bare_Expr
   is
      

   begin
         
         return Node.Bin_Op_F_Right;
      
   end;




   


      

   --
   --  Primitives for Bare_Binding
   --

   



      
      procedure Initialize_Fields_For_Binding
        (Self : Bare_Binding
         ; Binding_F_Expression : Bare_Expr
         ; Binding_F_Bindings : Bare_Term_Assoc_List
        ) is
      begin

            Self.Binding_F_Expression := Binding_F_Expression;
            Self.Binding_F_Bindings := Binding_F_Bindings;
         

      end Initialize_Fields_For_Binding;

      
   function Binding_F_Expression
     (Node : Bare_Binding) return Bare_Expr
   is
      

   begin
         
         return Node.Binding_F_Expression;
      
   end;

      
   function Binding_F_Bindings
     (Node : Bare_Binding) return Bare_Term_Assoc_List
   is
      

   begin
         
         return Node.Binding_F_Bindings;
      
   end;




   


      

   --
   --  Primitives for Bare_Call
   --

   



      
      procedure Initialize_Fields_For_Call
        (Self : Bare_Call
         ; Call_F_Identifier : Bare_Unqualified_I_D
         ; Call_F_Arguments : Bare_Expr_List
        ) is
      begin

            Self.Call_F_Identifier := Call_F_Identifier;
            Self.Call_F_Arguments := Call_F_Arguments;
         

      end Initialize_Fields_For_Call;

      
   function Call_F_Identifier
     (Node : Bare_Call) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Call_F_Identifier;
      
   end;

      
   function Call_F_Arguments
     (Node : Bare_Call) return Bare_Expr_List
   is
      

   begin
         
         return Node.Call_F_Arguments;
      
   end;




   


      

   --
   --  Primitives for Bare_Case_Expression
   --

   



      
      procedure Initialize_Fields_For_Case_Expression
        (Self : Bare_Case_Expression
         ; Case_Expression_F_Expression : Bare_Expr
         ; Case_Expression_F_Choices : Bare_Choice_List
        ) is
      begin

            Self.Case_Expression_F_Expression := Case_Expression_F_Expression;
            Self.Case_Expression_F_Choices := Case_Expression_F_Choices;
         

      end Initialize_Fields_For_Case_Expression;

      
   function Case_Expression_F_Expression
     (Node : Bare_Case_Expression) return Bare_Expr
   is
      

   begin
         
         return Node.Case_Expression_F_Expression;
      
   end;

      
   function Case_Expression_F_Choices
     (Node : Bare_Case_Expression) return Bare_Choice_List
   is
      

   begin
         
         return Node.Case_Expression_F_Choices;
      
   end;




   


      

   --
   --  Primitives for Bare_Choice
   --

   



      
      procedure Initialize_Fields_For_Choice
        (Self : Bare_Choice
         ; Choice_F_Selectors : Bare_R_F_L_X_Node_List
         ; Choice_F_Expression : Bare_Expr
        ) is
      begin

            Self.Choice_F_Selectors := Choice_F_Selectors;
            Self.Choice_F_Expression := Choice_F_Expression;
         

      end Initialize_Fields_For_Choice;

      
   function Choice_F_Selectors
     (Node : Bare_Choice) return Bare_R_F_L_X_Node_List
   is
      

   begin
         
         return Node.Choice_F_Selectors;
      
   end;

      
   function Choice_F_Expression
     (Node : Bare_Choice) return Bare_Expr
   is
      

   begin
         
         return Node.Choice_F_Expression;
      
   end;




   


      

   --
   --  Primitives for Bare_Comprehension
   --

   



      
      procedure Initialize_Fields_For_Comprehension
        (Self : Bare_Comprehension
         ; Comprehension_F_Iterator : Bare_Unqualified_I_D
         ; Comprehension_F_Sequence : Bare_Expr
         ; Comprehension_F_Condition : Bare_Expr
         ; Comprehension_F_Selector : Bare_Expr
        ) is
      begin

            Self.Comprehension_F_Iterator := Comprehension_F_Iterator;
            Self.Comprehension_F_Sequence := Comprehension_F_Sequence;
            Self.Comprehension_F_Condition := Comprehension_F_Condition;
            Self.Comprehension_F_Selector := Comprehension_F_Selector;
         

      end Initialize_Fields_For_Comprehension;

      
   function Comprehension_F_Iterator
     (Node : Bare_Comprehension) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Comprehension_F_Iterator;
      
   end;

      
   function Comprehension_F_Sequence
     (Node : Bare_Comprehension) return Bare_Expr
   is
      

   begin
         
         return Node.Comprehension_F_Sequence;
      
   end;

      
   function Comprehension_F_Condition
     (Node : Bare_Comprehension) return Bare_Expr
   is
      

   begin
         
         return Node.Comprehension_F_Condition;
      
   end;

      
   function Comprehension_F_Selector
     (Node : Bare_Comprehension) return Bare_Expr
   is
      

   begin
         
         return Node.Comprehension_F_Selector;
      
   end;




   


      

   --
   --  Primitives for Bare_Context_Item
   --

   



      
      procedure Initialize_Fields_For_Context_Item
        (Self : Bare_Context_Item
         ; Context_Item_F_Item : Bare_Unqualified_I_D
        ) is
      begin

            Self.Context_Item_F_Item := Context_Item_F_Item;
         

      end Initialize_Fields_For_Context_Item;

      
   function Context_Item_F_Item
     (Node : Bare_Context_Item) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Context_Item_F_Item;
      
   end;




   


      

   --
   --  Primitives for Bare_Conversion
   --

   



      
      procedure Initialize_Fields_For_Conversion
        (Self : Bare_Conversion
         ; Conversion_F_Target_Identifier : Bare_I_D
         ; Conversion_F_Argument : Bare_Expr
        ) is
      begin

            Self.Conversion_F_Target_Identifier := Conversion_F_Target_Identifier;
            Self.Conversion_F_Argument := Conversion_F_Argument;
         

      end Initialize_Fields_For_Conversion;

      
   function Conversion_F_Target_Identifier
     (Node : Bare_Conversion) return Bare_I_D
   is
      

   begin
         
         return Node.Conversion_F_Target_Identifier;
      
   end;

      
   function Conversion_F_Argument
     (Node : Bare_Conversion) return Bare_Expr
   is
      

   begin
         
         return Node.Conversion_F_Argument;
      
   end;




   


      

   --
   --  Primitives for Bare_Message_Aggregate
   --

   



      
      procedure Initialize_Fields_For_Message_Aggregate
        (Self : Bare_Message_Aggregate
         ; Message_Aggregate_F_Identifier : Bare_I_D
         ; Message_Aggregate_F_Values : Bare_Base_Aggregate
        ) is
      begin

            Self.Message_Aggregate_F_Identifier := Message_Aggregate_F_Identifier;
            Self.Message_Aggregate_F_Values := Message_Aggregate_F_Values;
         

      end Initialize_Fields_For_Message_Aggregate;

      
   function Message_Aggregate_F_Identifier
     (Node : Bare_Message_Aggregate) return Bare_I_D
   is
      

   begin
         
         return Node.Message_Aggregate_F_Identifier;
      
   end;

      
   function Message_Aggregate_F_Values
     (Node : Bare_Message_Aggregate) return Bare_Base_Aggregate
   is
      

   begin
         
         return Node.Message_Aggregate_F_Values;
      
   end;




   


      

   --
   --  Primitives for Bare_Negation
   --

   



      
      procedure Initialize_Fields_For_Negation
        (Self : Bare_Negation
         ; Negation_F_Data : Bare_Expr
        ) is
      begin

            Self.Negation_F_Data := Negation_F_Data;
         

      end Initialize_Fields_For_Negation;

      
   function Negation_F_Data
     (Node : Bare_Negation) return Bare_Expr
   is
      

   begin
         
         return Node.Negation_F_Data;
      
   end;




   


      

   --
   --  Primitives for Bare_Numeric_Literal
   --

   







   


      

   --
   --  Primitives for Bare_Paren_Expression
   --

   



      
      procedure Initialize_Fields_For_Paren_Expression
        (Self : Bare_Paren_Expression
         ; Paren_Expression_F_Data : Bare_Expr
        ) is
      begin

            Self.Paren_Expression_F_Data := Paren_Expression_F_Data;
         

      end Initialize_Fields_For_Paren_Expression;

      
   function Paren_Expression_F_Data
     (Node : Bare_Paren_Expression) return Bare_Expr
   is
      

   begin
         
         return Node.Paren_Expression_F_Data;
      
   end;




   


      

   --
   --  Primitives for Bare_Quantified_Expression
   --

   



      
      procedure Initialize_Fields_For_Quantified_Expression
        (Self : Bare_Quantified_Expression
         ; Quantified_Expression_F_Operation : Bare_Quantifier
         ; Quantified_Expression_F_Parameter_Identifier : Bare_Unqualified_I_D
         ; Quantified_Expression_F_Iterable : Bare_Expr
         ; Quantified_Expression_F_Predicate : Bare_Expr
        ) is
      begin

            Self.Quantified_Expression_F_Operation := Quantified_Expression_F_Operation;
            Self.Quantified_Expression_F_Parameter_Identifier := Quantified_Expression_F_Parameter_Identifier;
            Self.Quantified_Expression_F_Iterable := Quantified_Expression_F_Iterable;
            Self.Quantified_Expression_F_Predicate := Quantified_Expression_F_Predicate;
         

      end Initialize_Fields_For_Quantified_Expression;

      
   function Quantified_Expression_F_Operation
     (Node : Bare_Quantified_Expression) return Bare_Quantifier
   is
      

   begin
         
         return Node.Quantified_Expression_F_Operation;
      
   end;

      
   function Quantified_Expression_F_Parameter_Identifier
     (Node : Bare_Quantified_Expression) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Quantified_Expression_F_Parameter_Identifier;
      
   end;

      
   function Quantified_Expression_F_Iterable
     (Node : Bare_Quantified_Expression) return Bare_Expr
   is
      

   begin
         
         return Node.Quantified_Expression_F_Iterable;
      
   end;

      
   function Quantified_Expression_F_Predicate
     (Node : Bare_Quantified_Expression) return Bare_Expr
   is
      

   begin
         
         return Node.Quantified_Expression_F_Predicate;
      
   end;




   


      

   --
   --  Primitives for Bare_Select_Node
   --

   



      
      procedure Initialize_Fields_For_Select_Node
        (Self : Bare_Select_Node
         ; Select_Node_F_Expression : Bare_Expr
         ; Select_Node_F_Selector : Bare_Unqualified_I_D
        ) is
      begin

            Self.Select_Node_F_Expression := Select_Node_F_Expression;
            Self.Select_Node_F_Selector := Select_Node_F_Selector;
         

      end Initialize_Fields_For_Select_Node;

      
   function Select_Node_F_Expression
     (Node : Bare_Select_Node) return Bare_Expr
   is
      

   begin
         
         return Node.Select_Node_F_Expression;
      
   end;

      
   function Select_Node_F_Selector
     (Node : Bare_Select_Node) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Select_Node_F_Selector;
      
   end;




   


      

   --
   --  Primitives for Bare_Sequence_Literal
   --

   







   


      

   --
   --  Primitives for Bare_Concatenation
   --

   



      
      procedure Initialize_Fields_For_Concatenation
        (Self : Bare_Concatenation
         ; Concatenation_F_Left : Bare_Sequence_Literal
         ; Concatenation_F_Right : Bare_Sequence_Literal
        ) is
      begin

            Self.Concatenation_F_Left := Concatenation_F_Left;
            Self.Concatenation_F_Right := Concatenation_F_Right;
         

      end Initialize_Fields_For_Concatenation;

      
   function Concatenation_F_Left
     (Node : Bare_Concatenation) return Bare_Sequence_Literal
   is
      

   begin
         
         return Node.Concatenation_F_Left;
      
   end;

      
   function Concatenation_F_Right
     (Node : Bare_Concatenation) return Bare_Sequence_Literal
   is
      

   begin
         
         return Node.Concatenation_F_Right;
      
   end;




   


      

   --
   --  Primitives for Bare_Sequence_Aggregate
   --

   



      
      procedure Initialize_Fields_For_Sequence_Aggregate
        (Self : Bare_Sequence_Aggregate
         ; Sequence_Aggregate_F_Values : Bare_Numeric_Literal_List
        ) is
      begin

            Self.Sequence_Aggregate_F_Values := Sequence_Aggregate_F_Values;
         

      end Initialize_Fields_For_Sequence_Aggregate;

      
   function Sequence_Aggregate_F_Values
     (Node : Bare_Sequence_Aggregate) return Bare_Numeric_Literal_List
   is
      

   begin
         
         return Node.Sequence_Aggregate_F_Values;
      
   end;




   


      

   --
   --  Primitives for Bare_String_Literal
   --

   







   


      

   --
   --  Primitives for Bare_Variable
   --

   



      
      procedure Initialize_Fields_For_Variable
        (Self : Bare_Variable
         ; Variable_F_Identifier : Bare_I_D
        ) is
      begin

            Self.Variable_F_Identifier := Variable_F_Identifier;
         

      end Initialize_Fields_For_Variable;

      
   function Variable_F_Identifier
     (Node : Bare_Variable) return Bare_I_D
   is
      

   begin
         
         return Node.Variable_F_Identifier;
      
   end;




   


      

   --
   --  Primitives for Bare_Formal_Decl
   --

   







   


      

   --
   --  Primitives for Bare_Formal_Channel_Decl
   --

   



      
      procedure Initialize_Fields_For_Formal_Channel_Decl
        (Self : Bare_Formal_Channel_Decl
         ; Formal_Channel_Decl_F_Identifier : Bare_Unqualified_I_D
         ; Formal_Channel_Decl_F_Parameters : Bare_Channel_Attribute_List
        ) is
      begin

            Self.Formal_Channel_Decl_F_Identifier := Formal_Channel_Decl_F_Identifier;
            Self.Formal_Channel_Decl_F_Parameters := Formal_Channel_Decl_F_Parameters;
         

      end Initialize_Fields_For_Formal_Channel_Decl;

      
   function Formal_Channel_Decl_F_Identifier
     (Node : Bare_Formal_Channel_Decl) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Formal_Channel_Decl_F_Identifier;
      
   end;

      
   function Formal_Channel_Decl_F_Parameters
     (Node : Bare_Formal_Channel_Decl) return Bare_Channel_Attribute_List
   is
      

   begin
         
         return Node.Formal_Channel_Decl_F_Parameters;
      
   end;




   


      

   --
   --  Primitives for Bare_Formal_Function_Decl
   --

   



      
      procedure Initialize_Fields_For_Formal_Function_Decl
        (Self : Bare_Formal_Function_Decl
         ; Formal_Function_Decl_F_Identifier : Bare_Unqualified_I_D
         ; Formal_Function_Decl_F_Parameters : Bare_Parameters
         ; Formal_Function_Decl_F_Return_Type_Identifier : Bare_I_D
        ) is
      begin

            Self.Formal_Function_Decl_F_Identifier := Formal_Function_Decl_F_Identifier;
            Self.Formal_Function_Decl_F_Parameters := Formal_Function_Decl_F_Parameters;
            Self.Formal_Function_Decl_F_Return_Type_Identifier := Formal_Function_Decl_F_Return_Type_Identifier;
         

      end Initialize_Fields_For_Formal_Function_Decl;

      
   function Formal_Function_Decl_F_Identifier
     (Node : Bare_Formal_Function_Decl) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Formal_Function_Decl_F_Identifier;
      
   end;

      
   function Formal_Function_Decl_F_Parameters
     (Node : Bare_Formal_Function_Decl) return Bare_Parameters
   is
      

   begin
         
         return Node.Formal_Function_Decl_F_Parameters;
      
   end;

      
   function Formal_Function_Decl_F_Return_Type_Identifier
     (Node : Bare_Formal_Function_Decl) return Bare_I_D
   is
      

   begin
         
         return Node.Formal_Function_Decl_F_Return_Type_Identifier;
      
   end;




   


      

   --
   --  Primitives for Bare_Local_Decl
   --

   







   


      

   --
   --  Primitives for Bare_Renaming_Decl
   --

   



      
      procedure Initialize_Fields_For_Renaming_Decl
        (Self : Bare_Renaming_Decl
         ; Renaming_Decl_F_Identifier : Bare_Unqualified_I_D
         ; Renaming_Decl_F_Type_Identifier : Bare_I_D
         ; Renaming_Decl_F_Expression : Bare_Expr
        ) is
      begin

            Self.Renaming_Decl_F_Identifier := Renaming_Decl_F_Identifier;
            Self.Renaming_Decl_F_Type_Identifier := Renaming_Decl_F_Type_Identifier;
            Self.Renaming_Decl_F_Expression := Renaming_Decl_F_Expression;
         

      end Initialize_Fields_For_Renaming_Decl;

      
   function Renaming_Decl_F_Identifier
     (Node : Bare_Renaming_Decl) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Renaming_Decl_F_Identifier;
      
   end;

      
   function Renaming_Decl_F_Type_Identifier
     (Node : Bare_Renaming_Decl) return Bare_I_D
   is
      

   begin
         
         return Node.Renaming_Decl_F_Type_Identifier;
      
   end;

      
   function Renaming_Decl_F_Expression
     (Node : Bare_Renaming_Decl) return Bare_Expr
   is
      

   begin
         
         return Node.Renaming_Decl_F_Expression;
      
   end;




   


      

   --
   --  Primitives for Bare_Variable_Decl
   --

   



      
      procedure Initialize_Fields_For_Variable_Decl
        (Self : Bare_Variable_Decl
         ; Variable_Decl_F_Identifier : Bare_Unqualified_I_D
         ; Variable_Decl_F_Type_Identifier : Bare_I_D
         ; Variable_Decl_F_Initializer : Bare_Expr
        ) is
      begin

            Self.Variable_Decl_F_Identifier := Variable_Decl_F_Identifier;
            Self.Variable_Decl_F_Type_Identifier := Variable_Decl_F_Type_Identifier;
            Self.Variable_Decl_F_Initializer := Variable_Decl_F_Initializer;
         

      end Initialize_Fields_For_Variable_Decl;

      
   function Variable_Decl_F_Identifier
     (Node : Bare_Variable_Decl) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Variable_Decl_F_Identifier;
      
   end;

      
   function Variable_Decl_F_Type_Identifier
     (Node : Bare_Variable_Decl) return Bare_I_D
   is
      

   begin
         
         return Node.Variable_Decl_F_Type_Identifier;
      
   end;

      
   function Variable_Decl_F_Initializer
     (Node : Bare_Variable_Decl) return Bare_Expr
   is
      

   begin
         
         return Node.Variable_Decl_F_Initializer;
      
   end;




   


      

   --
   --  Primitives for Bare_Message_Aggregate_Association
   --

   



      
      procedure Initialize_Fields_For_Message_Aggregate_Association
        (Self : Bare_Message_Aggregate_Association
         ; Message_Aggregate_Association_F_Identifier : Bare_Unqualified_I_D
         ; Message_Aggregate_Association_F_Expression : Bare_Expr
        ) is
      begin

            Self.Message_Aggregate_Association_F_Identifier := Message_Aggregate_Association_F_Identifier;
            Self.Message_Aggregate_Association_F_Expression := Message_Aggregate_Association_F_Expression;
         

      end Initialize_Fields_For_Message_Aggregate_Association;

      
   function Message_Aggregate_Association_F_Identifier
     (Node : Bare_Message_Aggregate_Association) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Message_Aggregate_Association_F_Identifier;
      
   end;

      
   function Message_Aggregate_Association_F_Expression
     (Node : Bare_Message_Aggregate_Association) return Bare_Expr
   is
      

   begin
         
         return Node.Message_Aggregate_Association_F_Expression;
      
   end;




   


      

   --
   --  Primitives for Bare_Message_Aspect
   --

   







   


      

   --
   --  Primitives for Bare_Byte_Order_Aspect
   --

   



      
      procedure Initialize_Fields_For_Byte_Order_Aspect
        (Self : Bare_Byte_Order_Aspect
         ; Byte_Order_Aspect_F_Byte_Order : Bare_Byte_Order_Type
        ) is
      begin

            Self.Byte_Order_Aspect_F_Byte_Order := Byte_Order_Aspect_F_Byte_Order;
         

      end Initialize_Fields_For_Byte_Order_Aspect;

      
   function Byte_Order_Aspect_F_Byte_Order
     (Node : Bare_Byte_Order_Aspect) return Bare_Byte_Order_Type
   is
      

   begin
         
         return Node.Byte_Order_Aspect_F_Byte_Order;
      
   end;




   


      

   --
   --  Primitives for Bare_Checksum_Aspect
   --

   



      
      procedure Initialize_Fields_For_Checksum_Aspect
        (Self : Bare_Checksum_Aspect
         ; Checksum_Aspect_F_Associations : Bare_Checksum_Assoc_List
        ) is
      begin

            Self.Checksum_Aspect_F_Associations := Checksum_Aspect_F_Associations;
         

      end Initialize_Fields_For_Checksum_Aspect;

      
   function Checksum_Aspect_F_Associations
     (Node : Bare_Checksum_Aspect) return Bare_Checksum_Assoc_List
   is
      

   begin
         
         return Node.Checksum_Aspect_F_Associations;
      
   end;




   


      

   --
   --  Primitives for Bare_Message_Field
   --

   



      
      procedure Initialize_Fields_For_Message_Field
        (Self : Bare_Message_Field
         ; Message_Field_F_Identifier : Bare_Unqualified_I_D
         ; Message_Field_F_Type_Identifier : Bare_I_D
         ; Message_Field_F_Type_Arguments : Bare_Type_Argument_List
         ; Message_Field_F_Aspects : Bare_Aspect_List
         ; Message_Field_F_Condition : Bare_Expr
         ; Message_Field_F_Thens : Bare_Then_Node_List
        ) is
      begin

            Self.Message_Field_F_Identifier := Message_Field_F_Identifier;
            Self.Message_Field_F_Type_Identifier := Message_Field_F_Type_Identifier;
            Self.Message_Field_F_Type_Arguments := Message_Field_F_Type_Arguments;
            Self.Message_Field_F_Aspects := Message_Field_F_Aspects;
            Self.Message_Field_F_Condition := Message_Field_F_Condition;
            Self.Message_Field_F_Thens := Message_Field_F_Thens;
         

      end Initialize_Fields_For_Message_Field;

      
   function Message_Field_F_Identifier
     (Node : Bare_Message_Field) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Message_Field_F_Identifier;
      
   end;

      
   function Message_Field_F_Type_Identifier
     (Node : Bare_Message_Field) return Bare_I_D
   is
      

   begin
         
         return Node.Message_Field_F_Type_Identifier;
      
   end;

      
   function Message_Field_F_Type_Arguments
     (Node : Bare_Message_Field) return Bare_Type_Argument_List
   is
      

   begin
         
         return Node.Message_Field_F_Type_Arguments;
      
   end;

      
   function Message_Field_F_Aspects
     (Node : Bare_Message_Field) return Bare_Aspect_List
   is
      

   begin
         
         return Node.Message_Field_F_Aspects;
      
   end;

      
   function Message_Field_F_Condition
     (Node : Bare_Message_Field) return Bare_Expr
   is
      

   begin
         
         return Node.Message_Field_F_Condition;
      
   end;

      
   function Message_Field_F_Thens
     (Node : Bare_Message_Field) return Bare_Then_Node_List
   is
      

   begin
         
         return Node.Message_Field_F_Thens;
      
   end;




   


      

   --
   --  Primitives for Bare_Message_Fields
   --

   



      
      procedure Initialize_Fields_For_Message_Fields
        (Self : Bare_Message_Fields
         ; Message_Fields_F_Initial_Field : Bare_Null_Message_Field
         ; Message_Fields_F_Fields : Bare_Message_Field_List
        ) is
      begin

            Self.Message_Fields_F_Initial_Field := Message_Fields_F_Initial_Field;
            Self.Message_Fields_F_Fields := Message_Fields_F_Fields;
         

      end Initialize_Fields_For_Message_Fields;

      
   function Message_Fields_F_Initial_Field
     (Node : Bare_Message_Fields) return Bare_Null_Message_Field
   is
      

   begin
         
         return Node.Message_Fields_F_Initial_Field;
      
   end;

      
   function Message_Fields_F_Fields
     (Node : Bare_Message_Fields) return Bare_Message_Field_List
   is
      

   begin
         
         return Node.Message_Fields_F_Fields;
      
   end;




   


      

   --
   --  Primitives for Bare_Null_Message_Field
   --

   



      
      procedure Initialize_Fields_For_Null_Message_Field
        (Self : Bare_Null_Message_Field
         ; Null_Message_Field_F_Thens : Bare_Then_Node_List
        ) is
      begin

            Self.Null_Message_Field_F_Thens := Null_Message_Field_F_Thens;
         

      end Initialize_Fields_For_Null_Message_Field;

      
   function Null_Message_Field_F_Thens
     (Node : Bare_Null_Message_Field) return Bare_Then_Node_List
   is
      

   begin
         
         return Node.Null_Message_Field_F_Thens;
      
   end;




   


      

   --
   --  Primitives for Bare_Op
   --

   







   


      

   --
   --  Primitives for Bare_Op_Add
   --

   







   


      

   --
   --  Primitives for Bare_Op_And
   --

   







   


      

   --
   --  Primitives for Bare_Op_Div
   --

   







   


      

   --
   --  Primitives for Bare_Op_Eq
   --

   







   


      

   --
   --  Primitives for Bare_Op_Ge
   --

   







   


      

   --
   --  Primitives for Bare_Op_Gt
   --

   







   


      

   --
   --  Primitives for Bare_Op_In
   --

   







   


      

   --
   --  Primitives for Bare_Op_Le
   --

   







   


      

   --
   --  Primitives for Bare_Op_Lt
   --

   







   


      

   --
   --  Primitives for Bare_Op_Mod
   --

   







   


      

   --
   --  Primitives for Bare_Op_Mul
   --

   







   


      

   --
   --  Primitives for Bare_Op_Neq
   --

   







   


      

   --
   --  Primitives for Bare_Op_Notin
   --

   







   


      

   --
   --  Primitives for Bare_Op_Or
   --

   







   


      

   --
   --  Primitives for Bare_Op_Pow
   --

   







   


      

   --
   --  Primitives for Bare_Op_Sub
   --

   







   


      

   --
   --  Primitives for Bare_Package_Node
   --

   



      
      procedure Initialize_Fields_For_Package_Node
        (Self : Bare_Package_Node
         ; Package_Node_F_Identifier : Bare_Unqualified_I_D
         ; Package_Node_F_Declarations : Bare_Declaration_List
         ; Package_Node_F_End_Identifier : Bare_Unqualified_I_D
        ) is
      begin

            Self.Package_Node_F_Identifier := Package_Node_F_Identifier;
            Self.Package_Node_F_Declarations := Package_Node_F_Declarations;
            Self.Package_Node_F_End_Identifier := Package_Node_F_End_Identifier;
         

      end Initialize_Fields_For_Package_Node;

      
   function Package_Node_F_Identifier
     (Node : Bare_Package_Node) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Package_Node_F_Identifier;
      
   end;

      
   function Package_Node_F_Declarations
     (Node : Bare_Package_Node) return Bare_Declaration_List
   is
      

   begin
         
         return Node.Package_Node_F_Declarations;
      
   end;

      
   function Package_Node_F_End_Identifier
     (Node : Bare_Package_Node) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Package_Node_F_End_Identifier;
      
   end;




   


      

   --
   --  Primitives for Bare_Parameter
   --

   



      
      procedure Initialize_Fields_For_Parameter
        (Self : Bare_Parameter
         ; Parameter_F_Identifier : Bare_Unqualified_I_D
         ; Parameter_F_Type_Identifier : Bare_I_D
        ) is
      begin

            Self.Parameter_F_Identifier := Parameter_F_Identifier;
            Self.Parameter_F_Type_Identifier := Parameter_F_Type_Identifier;
         

      end Initialize_Fields_For_Parameter;

      
   function Parameter_F_Identifier
     (Node : Bare_Parameter) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Parameter_F_Identifier;
      
   end;

      
   function Parameter_F_Type_Identifier
     (Node : Bare_Parameter) return Bare_I_D
   is
      

   begin
         
         return Node.Parameter_F_Type_Identifier;
      
   end;




   


      

   --
   --  Primitives for Bare_Parameters
   --

   



      
      procedure Initialize_Fields_For_Parameters
        (Self : Bare_Parameters
         ; Parameters_F_Parameters : Bare_Parameter_List
        ) is
      begin

            Self.Parameters_F_Parameters := Parameters_F_Parameters;
         

      end Initialize_Fields_For_Parameters;

      
   function Parameters_F_Parameters
     (Node : Bare_Parameters) return Bare_Parameter_List
   is
      

   begin
         
         return Node.Parameters_F_Parameters;
      
   end;




   


      

   --
   --  Primitives for Bare_Quantifier
   --

   







   


      

   --
   --  Primitives for Bare_Quantifier_All
   --

   







   


      

   --
   --  Primitives for Bare_Quantifier_Some
   --

   







   


      

   --
   --  Primitives for Bare_R_F_L_X_Node_Base_List
   --

   







   


      

   --
   --  Primitives for Bare_Aspect_List
   --

   







   


      

   --
   --  Primitives for Bare_Base_Checksum_Val_List
   --

   







   


      

   --
   --  Primitives for Bare_Channel_Attribute_List
   --

   







   


      

   --
   --  Primitives for Bare_Checksum_Assoc_List
   --

   







   


      

   --
   --  Primitives for Bare_Choice_List
   --

   







   


      

   --
   --  Primitives for Bare_Conditional_Transition_List
   --

   







   


      

   --
   --  Primitives for Bare_Context_Item_List
   --

   







   


      

   --
   --  Primitives for Bare_Declaration_List
   --

   







   


      

   --
   --  Primitives for Bare_Element_Value_Assoc_List
   --

   







   


      

   --
   --  Primitives for Bare_Expr_List
   --

   







   


      

   --
   --  Primitives for Bare_Formal_Decl_List
   --

   







   


      

   --
   --  Primitives for Bare_Local_Decl_List
   --

   







   


      

   --
   --  Primitives for Bare_Message_Aggregate_Association_List
   --

   







   


      

   --
   --  Primitives for Bare_Message_Aspect_List
   --

   







   


      

   --
   --  Primitives for Bare_Message_Field_List
   --

   







   


      

   --
   --  Primitives for Bare_Numeric_Literal_List
   --

   







   


      

   --
   --  Primitives for Bare_Parameter_List
   --

   







   


      

   --
   --  Primitives for Bare_R_F_L_X_Node_List
   --

   







   


      

   --
   --  Primitives for Bare_State_List
   --

   







   


      

   --
   --  Primitives for Bare_Statement_List
   --

   







   


      

   --
   --  Primitives for Bare_Term_Assoc_List
   --

   







   


      

   --
   --  Primitives for Bare_Then_Node_List
   --

   







   


      

   --
   --  Primitives for Bare_Type_Argument_List
   --

   







   


      

   --
   --  Primitives for Bare_Unqualified_I_D_List
   --

   







   


      

   --
   --  Primitives for Bare_Specification
   --

   



      
      procedure Initialize_Fields_For_Specification
        (Self : Bare_Specification
         ; Specification_F_Context_Clause : Bare_Context_Item_List
         ; Specification_F_Package_Declaration : Bare_Package_Node
        ) is
      begin

            Self.Specification_F_Context_Clause := Specification_F_Context_Clause;
            Self.Specification_F_Package_Declaration := Specification_F_Package_Declaration;
         

      end Initialize_Fields_For_Specification;

      
   function Specification_F_Context_Clause
     (Node : Bare_Specification) return Bare_Context_Item_List
   is
      

   begin
         
         return Node.Specification_F_Context_Clause;
      
   end;

      
   function Specification_F_Package_Declaration
     (Node : Bare_Specification) return Bare_Package_Node
   is
      

   begin
         
         return Node.Specification_F_Package_Declaration;
      
   end;




   


      

   --
   --  Primitives for Bare_State
   --

   



      
      procedure Initialize_Fields_For_State
        (Self : Bare_State
         ; State_F_Identifier : Bare_Unqualified_I_D
         ; State_F_Description : Bare_Description
         ; State_F_Body : Bare_State_Body
        ) is
      begin

            Self.State_F_Identifier := State_F_Identifier;
            Self.State_F_Description := State_F_Description;
            Self.State_F_Body := State_F_Body;
         

      end Initialize_Fields_For_State;

      
   function State_F_Identifier
     (Node : Bare_State) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.State_F_Identifier;
      
   end;

      
   function State_F_Description
     (Node : Bare_State) return Bare_Description
   is
      

   begin
         
         return Node.State_F_Description;
      
   end;

      
   function State_F_Body
     (Node : Bare_State) return Bare_State_Body
   is
      

   begin
         
         return Node.State_F_Body;
      
   end;




   


      

   --
   --  Primitives for Bare_State_Body
   --

   



      
      procedure Initialize_Fields_For_State_Body
        (Self : Bare_State_Body
         ; State_Body_F_Declarations : Bare_Local_Decl_List
         ; State_Body_F_Actions : Bare_Statement_List
         ; State_Body_F_Conditional_Transitions : Bare_Conditional_Transition_List
         ; State_Body_F_Final_Transition : Bare_Transition
         ; State_Body_F_Exception_Transition : Bare_Transition
         ; State_Body_F_End_Identifier : Bare_Unqualified_I_D
        ) is
      begin

            Self.State_Body_F_Declarations := State_Body_F_Declarations;
            Self.State_Body_F_Actions := State_Body_F_Actions;
            Self.State_Body_F_Conditional_Transitions := State_Body_F_Conditional_Transitions;
            Self.State_Body_F_Final_Transition := State_Body_F_Final_Transition;
            Self.State_Body_F_Exception_Transition := State_Body_F_Exception_Transition;
            Self.State_Body_F_End_Identifier := State_Body_F_End_Identifier;
         

      end Initialize_Fields_For_State_Body;

      
   function State_Body_F_Declarations
     (Node : Bare_State_Body) return Bare_Local_Decl_List
   is
      

   begin
         
         return Node.State_Body_F_Declarations;
      
   end;

      
   function State_Body_F_Actions
     (Node : Bare_State_Body) return Bare_Statement_List
   is
      

   begin
         
         return Node.State_Body_F_Actions;
      
   end;

      
   function State_Body_F_Conditional_Transitions
     (Node : Bare_State_Body) return Bare_Conditional_Transition_List
   is
      

   begin
         
         return Node.State_Body_F_Conditional_Transitions;
      
   end;

      
   function State_Body_F_Final_Transition
     (Node : Bare_State_Body) return Bare_Transition
   is
      

   begin
         
         return Node.State_Body_F_Final_Transition;
      
   end;

      
   function State_Body_F_Exception_Transition
     (Node : Bare_State_Body) return Bare_Transition
   is
      

   begin
         
         return Node.State_Body_F_Exception_Transition;
      
   end;

      
   function State_Body_F_End_Identifier
     (Node : Bare_State_Body) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.State_Body_F_End_Identifier;
      
   end;




   


      

   --
   --  Primitives for Bare_Statement
   --

   







   


      

   --
   --  Primitives for Bare_Assignment
   --

   



      
      procedure Initialize_Fields_For_Assignment
        (Self : Bare_Assignment
         ; Assignment_F_Identifier : Bare_Unqualified_I_D
         ; Assignment_F_Expression : Bare_Expr
        ) is
      begin

            Self.Assignment_F_Identifier := Assignment_F_Identifier;
            Self.Assignment_F_Expression := Assignment_F_Expression;
         

      end Initialize_Fields_For_Assignment;

      
   function Assignment_F_Identifier
     (Node : Bare_Assignment) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Assignment_F_Identifier;
      
   end;

      
   function Assignment_F_Expression
     (Node : Bare_Assignment) return Bare_Expr
   is
      

   begin
         
         return Node.Assignment_F_Expression;
      
   end;




   


      

   --
   --  Primitives for Bare_Attribute_Statement
   --

   



      
      procedure Initialize_Fields_For_Attribute_Statement
        (Self : Bare_Attribute_Statement
         ; Attribute_Statement_F_Identifier : Bare_Unqualified_I_D
         ; Attribute_Statement_F_Attr : Bare_Attr_Stmt
         ; Attribute_Statement_F_Expression : Bare_Expr
        ) is
      begin

            Self.Attribute_Statement_F_Identifier := Attribute_Statement_F_Identifier;
            Self.Attribute_Statement_F_Attr := Attribute_Statement_F_Attr;
            Self.Attribute_Statement_F_Expression := Attribute_Statement_F_Expression;
         

      end Initialize_Fields_For_Attribute_Statement;

      
   function Attribute_Statement_F_Identifier
     (Node : Bare_Attribute_Statement) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Attribute_Statement_F_Identifier;
      
   end;

      
   function Attribute_Statement_F_Attr
     (Node : Bare_Attribute_Statement) return Bare_Attr_Stmt
   is
      

   begin
         
         return Node.Attribute_Statement_F_Attr;
      
   end;

      
   function Attribute_Statement_F_Expression
     (Node : Bare_Attribute_Statement) return Bare_Expr
   is
      

   begin
         
         return Node.Attribute_Statement_F_Expression;
      
   end;




   


      

   --
   --  Primitives for Bare_Message_Field_Assignment
   --

   



      
      procedure Initialize_Fields_For_Message_Field_Assignment
        (Self : Bare_Message_Field_Assignment
         ; Message_Field_Assignment_F_Message : Bare_Unqualified_I_D
         ; Message_Field_Assignment_F_Field : Bare_Unqualified_I_D
         ; Message_Field_Assignment_F_Expression : Bare_Expr
        ) is
      begin

            Self.Message_Field_Assignment_F_Message := Message_Field_Assignment_F_Message;
            Self.Message_Field_Assignment_F_Field := Message_Field_Assignment_F_Field;
            Self.Message_Field_Assignment_F_Expression := Message_Field_Assignment_F_Expression;
         

      end Initialize_Fields_For_Message_Field_Assignment;

      
   function Message_Field_Assignment_F_Message
     (Node : Bare_Message_Field_Assignment) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Message_Field_Assignment_F_Message;
      
   end;

      
   function Message_Field_Assignment_F_Field
     (Node : Bare_Message_Field_Assignment) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Message_Field_Assignment_F_Field;
      
   end;

      
   function Message_Field_Assignment_F_Expression
     (Node : Bare_Message_Field_Assignment) return Bare_Expr
   is
      

   begin
         
         return Node.Message_Field_Assignment_F_Expression;
      
   end;




   


      

   --
   --  Primitives for Bare_Reset
   --

   



      
      procedure Initialize_Fields_For_Reset
        (Self : Bare_Reset
         ; Reset_F_Identifier : Bare_Unqualified_I_D
         ; Reset_F_Associations : Bare_Message_Aggregate_Association_List
        ) is
      begin

            Self.Reset_F_Identifier := Reset_F_Identifier;
            Self.Reset_F_Associations := Reset_F_Associations;
         

      end Initialize_Fields_For_Reset;

      
   function Reset_F_Identifier
     (Node : Bare_Reset) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Reset_F_Identifier;
      
   end;

      
   function Reset_F_Associations
     (Node : Bare_Reset) return Bare_Message_Aggregate_Association_List
   is
      

   begin
         
         return Node.Reset_F_Associations;
      
   end;




   


      

   --
   --  Primitives for Bare_Term_Assoc
   --

   



      
      procedure Initialize_Fields_For_Term_Assoc
        (Self : Bare_Term_Assoc
         ; Term_Assoc_F_Identifier : Bare_Unqualified_I_D
         ; Term_Assoc_F_Expression : Bare_Expr
        ) is
      begin

            Self.Term_Assoc_F_Identifier := Term_Assoc_F_Identifier;
            Self.Term_Assoc_F_Expression := Term_Assoc_F_Expression;
         

      end Initialize_Fields_For_Term_Assoc;

      
   function Term_Assoc_F_Identifier
     (Node : Bare_Term_Assoc) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Term_Assoc_F_Identifier;
      
   end;

      
   function Term_Assoc_F_Expression
     (Node : Bare_Term_Assoc) return Bare_Expr
   is
      

   begin
         
         return Node.Term_Assoc_F_Expression;
      
   end;




   


      

   --
   --  Primitives for Bare_Then_Node
   --

   



      
      procedure Initialize_Fields_For_Then_Node
        (Self : Bare_Then_Node
         ; Then_Node_F_Target : Bare_Unqualified_I_D
         ; Then_Node_F_Aspects : Bare_Aspect_List
         ; Then_Node_F_Condition : Bare_Expr
        ) is
      begin

            Self.Then_Node_F_Target := Then_Node_F_Target;
            Self.Then_Node_F_Aspects := Then_Node_F_Aspects;
            Self.Then_Node_F_Condition := Then_Node_F_Condition;
         

      end Initialize_Fields_For_Then_Node;

      
   function Then_Node_F_Target
     (Node : Bare_Then_Node) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Then_Node_F_Target;
      
   end;

      
   function Then_Node_F_Aspects
     (Node : Bare_Then_Node) return Bare_Aspect_List
   is
      

   begin
         
         return Node.Then_Node_F_Aspects;
      
   end;

      
   function Then_Node_F_Condition
     (Node : Bare_Then_Node) return Bare_Expr
   is
      

   begin
         
         return Node.Then_Node_F_Condition;
      
   end;




   


      

   --
   --  Primitives for Bare_Transition
   --

   



      
      procedure Initialize_Fields_For_Transition
        (Self : Bare_Transition
         ; Transition_F_Target : Bare_Unqualified_I_D
         ; Transition_F_Description : Bare_Description
        ) is
      begin

            Self.Transition_F_Target := Transition_F_Target;
            Self.Transition_F_Description := Transition_F_Description;
         

      end Initialize_Fields_For_Transition;

      
   function Transition_F_Target
     (Node : Bare_Transition) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Transition_F_Target;
      
   end;

      
   function Transition_F_Description
     (Node : Bare_Transition) return Bare_Description
   is
      

   begin
         
         return Node.Transition_F_Description;
      
   end;




   


      

   --
   --  Primitives for Bare_Conditional_Transition
   --

   



      
      procedure Initialize_Fields_For_Conditional_Transition
        (Self : Bare_Conditional_Transition
         ; Transition_F_Target : Bare_Unqualified_I_D
         ; Transition_F_Description : Bare_Description
         ; Conditional_Transition_F_Condition : Bare_Expr
        ) is
      begin
            Initialize_Fields_For_Transition
              (Self, Transition_F_Target, Transition_F_Description);

            Self.Conditional_Transition_F_Condition := Conditional_Transition_F_Condition;
         

      end Initialize_Fields_For_Conditional_Transition;

      
   function Conditional_Transition_F_Condition
     (Node : Bare_Conditional_Transition) return Bare_Expr
   is
      

   begin
         
         return Node.Conditional_Transition_F_Condition;
      
   end;




   


      

   --
   --  Primitives for Bare_Type_Argument
   --

   



      
      procedure Initialize_Fields_For_Type_Argument
        (Self : Bare_Type_Argument
         ; Type_Argument_F_Identifier : Bare_Unqualified_I_D
         ; Type_Argument_F_Expression : Bare_Expr
        ) is
      begin

            Self.Type_Argument_F_Identifier := Type_Argument_F_Identifier;
            Self.Type_Argument_F_Expression := Type_Argument_F_Expression;
         

      end Initialize_Fields_For_Type_Argument;

      
   function Type_Argument_F_Identifier
     (Node : Bare_Type_Argument) return Bare_Unqualified_I_D
   is
      

   begin
         
         return Node.Type_Argument_F_Identifier;
      
   end;

      
   function Type_Argument_F_Expression
     (Node : Bare_Type_Argument) return Bare_Expr
   is
      

   begin
         
         return Node.Type_Argument_F_Expression;
      
   end;




   


      

   --
   --  Primitives for Bare_Type_Def
   --

   







   


      

   --
   --  Primitives for Bare_Abstract_Message_Type_Def
   --

   







   


      

   --
   --  Primitives for Bare_Message_Type_Def
   --

   



      
      procedure Initialize_Fields_For_Message_Type_Def
        (Self : Bare_Message_Type_Def
         ; Message_Type_Def_F_Message_Fields : Bare_Message_Fields
         ; Message_Type_Def_F_Aspects : Bare_Message_Aspect_List
        ) is
      begin

            Self.Message_Type_Def_F_Message_Fields := Message_Type_Def_F_Message_Fields;
            Self.Message_Type_Def_F_Aspects := Message_Type_Def_F_Aspects;
         

      end Initialize_Fields_For_Message_Type_Def;

      
   function Message_Type_Def_F_Message_Fields
     (Node : Bare_Message_Type_Def) return Bare_Message_Fields
   is
      

   begin
         
         return Node.Message_Type_Def_F_Message_Fields;
      
   end;

      
   function Message_Type_Def_F_Aspects
     (Node : Bare_Message_Type_Def) return Bare_Message_Aspect_List
   is
      

   begin
         
         return Node.Message_Type_Def_F_Aspects;
      
   end;




   


      

   --
   --  Primitives for Bare_Null_Message_Type_Def
   --

   







   


      

   --
   --  Primitives for Bare_Enumeration_Def
   --

   







   


      

   --
   --  Primitives for Bare_Named_Enumeration_Def
   --

   



      
      procedure Initialize_Fields_For_Named_Enumeration_Def
        (Self : Bare_Named_Enumeration_Def
         ; Named_Enumeration_Def_F_Elements : Bare_Element_Value_Assoc_List
        ) is
      begin

            Self.Named_Enumeration_Def_F_Elements := Named_Enumeration_Def_F_Elements;
         

      end Initialize_Fields_For_Named_Enumeration_Def;

      
   function Named_Enumeration_Def_F_Elements
     (Node : Bare_Named_Enumeration_Def) return Bare_Element_Value_Assoc_List
   is
      

   begin
         
         return Node.Named_Enumeration_Def_F_Elements;
      
   end;




   


      

   --
   --  Primitives for Bare_Positional_Enumeration_Def
   --

   



      
      procedure Initialize_Fields_For_Positional_Enumeration_Def
        (Self : Bare_Positional_Enumeration_Def
         ; Positional_Enumeration_Def_F_Elements : Bare_Unqualified_I_D_List
        ) is
      begin

            Self.Positional_Enumeration_Def_F_Elements := Positional_Enumeration_Def_F_Elements;
         

      end Initialize_Fields_For_Positional_Enumeration_Def;

      
   function Positional_Enumeration_Def_F_Elements
     (Node : Bare_Positional_Enumeration_Def) return Bare_Unqualified_I_D_List
   is
      

   begin
         
         return Node.Positional_Enumeration_Def_F_Elements;
      
   end;




   


      

   --
   --  Primitives for Bare_Enumeration_Type_Def
   --

   



      
      procedure Initialize_Fields_For_Enumeration_Type_Def
        (Self : Bare_Enumeration_Type_Def
         ; Enumeration_Type_Def_F_Elements : Bare_Enumeration_Def
         ; Enumeration_Type_Def_F_Aspects : Bare_Aspect_List
        ) is
      begin

            Self.Enumeration_Type_Def_F_Elements := Enumeration_Type_Def_F_Elements;
            Self.Enumeration_Type_Def_F_Aspects := Enumeration_Type_Def_F_Aspects;
         

      end Initialize_Fields_For_Enumeration_Type_Def;

      
   function Enumeration_Type_Def_F_Elements
     (Node : Bare_Enumeration_Type_Def) return Bare_Enumeration_Def
   is
      

   begin
         
         return Node.Enumeration_Type_Def_F_Elements;
      
   end;

      
   function Enumeration_Type_Def_F_Aspects
     (Node : Bare_Enumeration_Type_Def) return Bare_Aspect_List
   is
      

   begin
         
         return Node.Enumeration_Type_Def_F_Aspects;
      
   end;




   


      

   --
   --  Primitives for Bare_Integer_Type_Def
   --

   







   


      

   --
   --  Primitives for Bare_Modular_Type_Def
   --

   



      
      procedure Initialize_Fields_For_Modular_Type_Def
        (Self : Bare_Modular_Type_Def
         ; Modular_Type_Def_F_Mod : Bare_Expr
        ) is
      begin

            Self.Modular_Type_Def_F_Mod := Modular_Type_Def_F_Mod;
         

      end Initialize_Fields_For_Modular_Type_Def;

      
   function Modular_Type_Def_F_Mod
     (Node : Bare_Modular_Type_Def) return Bare_Expr
   is
      

   begin
         
         return Node.Modular_Type_Def_F_Mod;
      
   end;




   


      

   --
   --  Primitives for Bare_Range_Type_Def
   --

   



      
      procedure Initialize_Fields_For_Range_Type_Def
        (Self : Bare_Range_Type_Def
         ; Range_Type_Def_F_First : Bare_Expr
         ; Range_Type_Def_F_Last : Bare_Expr
         ; Range_Type_Def_F_Size : Bare_Aspect
        ) is
      begin

            Self.Range_Type_Def_F_First := Range_Type_Def_F_First;
            Self.Range_Type_Def_F_Last := Range_Type_Def_F_Last;
            Self.Range_Type_Def_F_Size := Range_Type_Def_F_Size;
         

      end Initialize_Fields_For_Range_Type_Def;

      
   function Range_Type_Def_F_First
     (Node : Bare_Range_Type_Def) return Bare_Expr
   is
      

   begin
         
         return Node.Range_Type_Def_F_First;
      
   end;

      
   function Range_Type_Def_F_Last
     (Node : Bare_Range_Type_Def) return Bare_Expr
   is
      

   begin
         
         return Node.Range_Type_Def_F_Last;
      
   end;

      
   function Range_Type_Def_F_Size
     (Node : Bare_Range_Type_Def) return Bare_Aspect
   is
      

   begin
         
         return Node.Range_Type_Def_F_Size;
      
   end;




   


      

   --
   --  Primitives for Bare_Sequence_Type_Def
   --

   



      
      procedure Initialize_Fields_For_Sequence_Type_Def
        (Self : Bare_Sequence_Type_Def
         ; Sequence_Type_Def_F_Element_Type : Bare_I_D
        ) is
      begin

            Self.Sequence_Type_Def_F_Element_Type := Sequence_Type_Def_F_Element_Type;
         

      end Initialize_Fields_For_Sequence_Type_Def;

      
   function Sequence_Type_Def_F_Element_Type
     (Node : Bare_Sequence_Type_Def) return Bare_I_D
   is
      

   begin
         
         return Node.Sequence_Type_Def_F_Element_Type;
      
   end;




   


      

   --
   --  Primitives for Bare_Type_Derivation_Def
   --

   



      
      procedure Initialize_Fields_For_Type_Derivation_Def
        (Self : Bare_Type_Derivation_Def
         ; Type_Derivation_Def_F_Base : Bare_I_D
        ) is
      begin

            Self.Type_Derivation_Def_F_Base := Type_Derivation_Def_F_Base;
         

      end Initialize_Fields_For_Type_Derivation_Def;

      
   function Type_Derivation_Def_F_Base
     (Node : Bare_Type_Derivation_Def) return Bare_I_D
   is
      

   begin
         
         return Node.Type_Derivation_Def_F_Base;
      
   end;




   



   ----------------------------
   -- Destroy_Synthetic_Node --
   ----------------------------

   procedure Destroy_Synthetic_Node (Node : in out Bare_R_F_L_X_Node) is
      procedure Free is new Ada.Unchecked_Deallocation
        (Root_Node_Record, Bare_R_F_L_X_Node);
   begin
      --  Don't call Node.Destroy, as Node's children may be gone already: they
      --  have their own destructor and there is no specified order for the
      --  call of these destructors.
      Free_User_Fields (Node);
      Free (Node);
   end Destroy_Synthetic_Node;

   -----------
   -- Image --
   -----------

   function Image (Value : Boolean) return String
   is (if Value then "True" else "False");

      -----------------
      -- Trace_Image --
      -----------------

      function Trace_Image
        (Node       : Bare_R_F_L_X_Node;
         Decoration : Boolean := True) return String is
      begin
         if Node = null then
            return "None";
         else
            declare
               Result : constant String :=
                 (Kind_Name (Node) & " "
                  & Basename (Node.Unit) & ":"
                  & Image (Sloc_Range (Node)));
            begin
               return (if Decoration then "<" & Result & ">" else Result);
            end;
         end if;
      end Trace_Image;

   Kind_Names : array (R_F_L_X_Node_Kind_Type) of Unbounded_String :=
     (Rflx_I_D => To_Unbounded_String ("ID"), 
Rflx_Unqualified_I_D => To_Unbounded_String ("UnqualifiedID"), 
Rflx_Aspect => To_Unbounded_String ("Aspect"), 
Rflx_Attr_First => To_Unbounded_String ("AttrFirst"), 
Rflx_Attr_Has_Data => To_Unbounded_String ("AttrHasData"), 
Rflx_Attr_Head => To_Unbounded_String ("AttrHead"), 
Rflx_Attr_Last => To_Unbounded_String ("AttrLast"), 
Rflx_Attr_Opaque => To_Unbounded_String ("AttrOpaque"), 
Rflx_Attr_Present => To_Unbounded_String ("AttrPresent"), 
Rflx_Attr_Size => To_Unbounded_String ("AttrSize"), 
Rflx_Attr_Valid => To_Unbounded_String ("AttrValid"), 
Rflx_Attr_Valid_Checksum => To_Unbounded_String ("AttrValidChecksum"), 
Rflx_Attr_Stmt_Append => To_Unbounded_String ("AttrStmtAppend"), 
Rflx_Attr_Stmt_Extend => To_Unbounded_String ("AttrStmtExtend"), 
Rflx_Attr_Stmt_Read => To_Unbounded_String ("AttrStmtRead"), 
Rflx_Attr_Stmt_Write => To_Unbounded_String ("AttrStmtWrite"), 
Rflx_Message_Aggregate_Associations => To_Unbounded_String ("MessageAggregateAssociations"), 
Rflx_Null_Message_Aggregate => To_Unbounded_String ("NullMessageAggregate"), 
Rflx_Checksum_Val => To_Unbounded_String ("ChecksumVal"), 
Rflx_Checksum_Value_Range => To_Unbounded_String ("ChecksumValueRange"), 
Rflx_Byte_Order_Type_Highorderfirst => To_Unbounded_String ("ByteOrderTypeHighorderfirst"), 
Rflx_Byte_Order_Type_Loworderfirst => To_Unbounded_String ("ByteOrderTypeLoworderfirst"), 
Rflx_Readable => To_Unbounded_String ("Readable"), 
Rflx_Writable => To_Unbounded_String ("Writable"), 
Rflx_Checksum_Assoc => To_Unbounded_String ("ChecksumAssoc"), 
Rflx_Refinement_Decl => To_Unbounded_String ("RefinementDecl"), 
Rflx_Session_Decl => To_Unbounded_String ("SessionDecl"), 
Rflx_Type_Decl => To_Unbounded_String ("TypeDecl"), 
Rflx_Description => To_Unbounded_String ("Description"), 
Rflx_Element_Value_Assoc => To_Unbounded_String ("ElementValueAssoc"), 
Rflx_Attribute => To_Unbounded_String ("Attribute"), 
Rflx_Bin_Op => To_Unbounded_String ("BinOp"), 
Rflx_Binding => To_Unbounded_String ("Binding"), 
Rflx_Call => To_Unbounded_String ("Call"), 
Rflx_Case_Expression => To_Unbounded_String ("CaseExpression"), 
Rflx_Choice => To_Unbounded_String ("Choice"), 
Rflx_Comprehension => To_Unbounded_String ("Comprehension"), 
Rflx_Context_Item => To_Unbounded_String ("ContextItem"), 
Rflx_Conversion => To_Unbounded_String ("Conversion"), 
Rflx_Message_Aggregate => To_Unbounded_String ("MessageAggregate"), 
Rflx_Negation => To_Unbounded_String ("Negation"), 
Rflx_Numeric_Literal => To_Unbounded_String ("NumericLiteral"), 
Rflx_Paren_Expression => To_Unbounded_String ("ParenExpression"), 
Rflx_Quantified_Expression => To_Unbounded_String ("QuantifiedExpression"), 
Rflx_Select_Node => To_Unbounded_String ("SelectNode"), 
Rflx_Concatenation => To_Unbounded_String ("Concatenation"), 
Rflx_Sequence_Aggregate => To_Unbounded_String ("SequenceAggregate"), 
Rflx_String_Literal => To_Unbounded_String ("StringLiteral"), 
Rflx_Variable => To_Unbounded_String ("Variable"), 
Rflx_Formal_Channel_Decl => To_Unbounded_String ("FormalChannelDecl"), 
Rflx_Formal_Function_Decl => To_Unbounded_String ("FormalFunctionDecl"), 
Rflx_Renaming_Decl => To_Unbounded_String ("RenamingDecl"), 
Rflx_Variable_Decl => To_Unbounded_String ("VariableDecl"), 
Rflx_Message_Aggregate_Association => To_Unbounded_String ("MessageAggregateAssociation"), 
Rflx_Byte_Order_Aspect => To_Unbounded_String ("ByteOrderAspect"), 
Rflx_Checksum_Aspect => To_Unbounded_String ("ChecksumAspect"), 
Rflx_Message_Field => To_Unbounded_String ("MessageField"), 
Rflx_Message_Fields => To_Unbounded_String ("MessageFields"), 
Rflx_Null_Message_Field => To_Unbounded_String ("NullMessageField"), 
Rflx_Op_Add => To_Unbounded_String ("OpAdd"), 
Rflx_Op_And => To_Unbounded_String ("OpAnd"), 
Rflx_Op_Div => To_Unbounded_String ("OpDiv"), 
Rflx_Op_Eq => To_Unbounded_String ("OpEq"), 
Rflx_Op_Ge => To_Unbounded_String ("OpGe"), 
Rflx_Op_Gt => To_Unbounded_String ("OpGt"), 
Rflx_Op_In => To_Unbounded_String ("OpIn"), 
Rflx_Op_Le => To_Unbounded_String ("OpLe"), 
Rflx_Op_Lt => To_Unbounded_String ("OpLt"), 
Rflx_Op_Mod => To_Unbounded_String ("OpMod"), 
Rflx_Op_Mul => To_Unbounded_String ("OpMul"), 
Rflx_Op_Neq => To_Unbounded_String ("OpNeq"), 
Rflx_Op_Notin => To_Unbounded_String ("OpNotin"), 
Rflx_Op_Or => To_Unbounded_String ("OpOr"), 
Rflx_Op_Pow => To_Unbounded_String ("OpPow"), 
Rflx_Op_Sub => To_Unbounded_String ("OpSub"), 
Rflx_Package_Node => To_Unbounded_String ("PackageNode"), 
Rflx_Parameter => To_Unbounded_String ("Parameter"), 
Rflx_Parameters => To_Unbounded_String ("Parameters"), 
Rflx_Quantifier_All => To_Unbounded_String ("QuantifierAll"), 
Rflx_Quantifier_Some => To_Unbounded_String ("QuantifierSome"), 
Rflx_Aspect_List => To_Unbounded_String ("AspectList"), 
Rflx_Base_Checksum_Val_List => To_Unbounded_String ("BaseChecksumValList"), 
Rflx_Channel_Attribute_List => To_Unbounded_String ("ChannelAttributeList"), 
Rflx_Checksum_Assoc_List => To_Unbounded_String ("ChecksumAssocList"), 
Rflx_Choice_List => To_Unbounded_String ("ChoiceList"), 
Rflx_Conditional_Transition_List => To_Unbounded_String ("ConditionalTransitionList"), 
Rflx_Context_Item_List => To_Unbounded_String ("ContextItemList"), 
Rflx_Declaration_List => To_Unbounded_String ("DeclarationList"), 
Rflx_Element_Value_Assoc_List => To_Unbounded_String ("ElementValueAssocList"), 
Rflx_Expr_List => To_Unbounded_String ("ExprList"), 
Rflx_Formal_Decl_List => To_Unbounded_String ("FormalDeclList"), 
Rflx_Local_Decl_List => To_Unbounded_String ("LocalDeclList"), 
Rflx_Message_Aggregate_Association_List => To_Unbounded_String ("MessageAggregateAssociationList"), 
Rflx_Message_Aspect_List => To_Unbounded_String ("MessageAspectList"), 
Rflx_Message_Field_List => To_Unbounded_String ("MessageFieldList"), 
Rflx_Numeric_Literal_List => To_Unbounded_String ("NumericLiteralList"), 
Rflx_Parameter_List => To_Unbounded_String ("ParameterList"), 
Rflx_R_F_L_X_Node_List => To_Unbounded_String ("RFLXNodeList"), 
Rflx_State_List => To_Unbounded_String ("StateList"), 
Rflx_Statement_List => To_Unbounded_String ("StatementList"), 
Rflx_Term_Assoc_List => To_Unbounded_String ("TermAssocList"), 
Rflx_Then_Node_List => To_Unbounded_String ("ThenNodeList"), 
Rflx_Type_Argument_List => To_Unbounded_String ("TypeArgumentList"), 
Rflx_Unqualified_I_D_List => To_Unbounded_String ("UnqualifiedIDList"), 
Rflx_Specification => To_Unbounded_String ("Specification"), 
Rflx_State => To_Unbounded_String ("State"), 
Rflx_State_Body => To_Unbounded_String ("StateBody"), 
Rflx_Assignment => To_Unbounded_String ("Assignment"), 
Rflx_Attribute_Statement => To_Unbounded_String ("AttributeStatement"), 
Rflx_Message_Field_Assignment => To_Unbounded_String ("MessageFieldAssignment"), 
Rflx_Reset => To_Unbounded_String ("Reset"), 
Rflx_Term_Assoc => To_Unbounded_String ("TermAssoc"), 
Rflx_Then_Node => To_Unbounded_String ("ThenNode"), 
Rflx_Transition => To_Unbounded_String ("Transition"), 
Rflx_Conditional_Transition => To_Unbounded_String ("ConditionalTransition"), 
Rflx_Type_Argument => To_Unbounded_String ("TypeArgument"), 
Rflx_Message_Type_Def => To_Unbounded_String ("MessageTypeDef"), 
Rflx_Null_Message_Type_Def => To_Unbounded_String ("NullMessageTypeDef"), 
Rflx_Named_Enumeration_Def => To_Unbounded_String ("NamedEnumerationDef"), 
Rflx_Positional_Enumeration_Def => To_Unbounded_String ("PositionalEnumerationDef"), 
Rflx_Enumeration_Type_Def => To_Unbounded_String ("EnumerationTypeDef"), 
Rflx_Modular_Type_Def => To_Unbounded_String ("ModularTypeDef"), 
Rflx_Range_Type_Def => To_Unbounded_String ("RangeTypeDef"), 
Rflx_Sequence_Type_Def => To_Unbounded_String ("SequenceTypeDef"), 
Rflx_Type_Derivation_Def => To_Unbounded_String ("TypeDerivationDef"));

   ---------------
   -- Kind_Name --
   ---------------

   function Kind_Name (Node : Bare_R_F_L_X_Node) return String is
   begin
      return To_String (Kind_Names (Node.Kind));
   end Kind_Name;

   --------------------
   -- Children_Count --
   --------------------

   function Children_Count (Node : Bare_R_F_L_X_Node) return Natural is
      C : Integer := Kind_To_Node_Children_Count (Node.Kind);
   begin
      if C = -1 then
         return Node.Count;
      else
         return C;
      end if;
   end Children_Count;

   ----------------------
   -- Free_User_Fields --
   ----------------------

   procedure Free_User_Fields (Node : Bare_R_F_L_X_Node) is

      procedure Reset_Logic_Var (LV : in out Logic_Var_Record);
      --  Reset the LV logic variable, clearing the value it stores

      ---------------------
      -- Reset_Logic_Var --
      ---------------------

      procedure Reset_Logic_Var (LV : in out Logic_Var_Record) is
      begin
         LV.Value := No_Entity;
         Entity_Vars.Reset (LV'Unrestricted_Access);
         Entity_Vars.Destroy (LV);
      end Reset_Logic_Var;

      K : constant R_F_L_X_Node_Kind_Type := Node.Kind;

   begin
      
      pragma Unreferenced (K, Reset_Logic_Var);
   end Free_User_Fields;

   ----------------
   -- Token_Data --
   ----------------

   function Token_Data (Unit : Internal_Unit) return Token_Data_Handler_Access
   is (Unit.TDH'Access);

   -------------------
   -- Lookup_Symbol --
   -------------------

   function Lookup_Symbol
     (Context : Internal_Context; Symbol : Text_Type) return Symbol_Type
   is
      Canon_Symbol : constant Symbolization_Result :=
            Create_Symbol (Symbol)
      ;
   begin
      if Canon_Symbol.Success then
         return Get_Symbol
           (Context.Symbols, Find (Context.Symbols, Canon_Symbol.Symbol));
      else
         raise Invalid_Symbol_Error with Image (Canon_Symbol.Error_Message);
      end if;
   end Lookup_Symbol;

   -------------------------
   -- Create_Special_Unit --
   -------------------------

   function Create_Special_Unit
     (Context             : Internal_Context;
      Normalized_Filename : Virtual_File;
      Charset             : String;
      Rule                : Grammar_Rule) return Internal_Unit
   is
      Unit : Internal_Unit := new Analysis_Unit_Type'
        (Context                      => Context,
         Is_Internal                  => False,
         Ast_Root                     => null,
         Filename                     => Normalized_Filename,
         Charset                      => To_Unbounded_String (Charset),
         TDH                          => <>,
         Diagnostics                  => <>,
         Rule                         => Rule,
         Ast_Mem_Pool                 => No_Pool,
         Destroyables                 => Destroyable_Vectors.Empty_Vector,
         Referenced_Units             => <>,
         Exiled_Entries               => Exiled_Entry_Vectors.Empty_Vector,
         Foreign_Nodes                =>
            Foreign_Node_Entry_Vectors.Empty_Vector,
         Exiled_Entries_In_NED        =>
            Exiled_Entry_In_NED_Vectors.Empty_Vector,
         Exiled_Envs                  => Exiled_Env_Vectors.Empty_Vector,
         Named_Envs                   => Named_Env_Vectors.Empty_Vector,
         Nodes_With_Foreign_Env       => <>,
         Rebindings                   => Env_Rebindings_Vectors.Empty_Vector,
         Cache_Version                => <>,
         Unit_Version                 => <>,
         others => <>
      );
   begin
      Initialize
        (Unit.TDH, Context.Symbols, Unit.all'Address, Context.Tab_Stop);
      return Unit;
   end Create_Special_Unit;

   --------------------
   -- Templates_Unit --
   --------------------

   function Templates_Unit (Context : Internal_Context) return Internal_Unit is
   begin
      if Context.Templates_Unit = No_Analysis_Unit then
         Context.Templates_Unit := Create_Special_Unit
           (Context             => Context,
            Normalized_Filename => No_File,
            Charset             => Default_Charset,
            Rule                => Main_Rule_Rule);
      end if;
      return Context.Templates_Unit;
   end Templates_Unit;

   --------------
   -- Set_Rule --
   --------------

   procedure Set_Rule (Unit : Internal_Unit; Rule : Grammar_Rule) is
   begin
      Unit.Rule := Rule;
   end Set_Rule;

   ------------------------------
   -- Normalized_Unit_Filename --
   ------------------------------

   function Normalized_Unit_Filename
     (Context : Internal_Context; Filename : String) return Virtual_File
   is
      use Virtual_File_Maps;
      Key : constant Unbounded_String := To_Unbounded_String (Filename);
      Cur : Cursor := Context.Filenames.Find (Key);
   begin
      if Cur = No_Element then
         declare
            F : constant Virtual_File := Create
              (Create_From_Base (+Filename).Full_Name,
               Normalize => True);
         begin
            Context.Filenames.Insert (Key, F);
            return F;
         end;
      else
         return Element (Cur);
      end if;
   end Normalized_Unit_Filename;

   --------------------------
   -- Register_Destroyable --
   --------------------------

   procedure Register_Destroyable_Helper
     (Unit    : Internal_Unit;
      Object  : System.Address;
      Destroy : Destroy_Procedure)
   is
   begin
      Destroyable_Vectors.Append (Unit.Destroyables, (Object, Destroy));
   end Register_Destroyable_Helper;

   --------------------------
   -- Register_Destroyable --
   --------------------------

   procedure Register_Destroyable
     (Unit : Internal_Unit; Node : Bare_R_F_L_X_Node)
   is
      procedure Helper is new Register_Destroyable_Gen
        (Root_Node_Record,
         Bare_R_F_L_X_Node,
         Destroy_Synthetic_Node);
   begin
      Helper (Unit, Node);
   end Register_Destroyable;

   --------------------------
   -- Register_Destroyable --
   --------------------------

   procedure Register_Destroyable
     (Unit : Internal_Unit; Env : AST_Envs.Lexical_Env_Access)
   is
      procedure Helper is new Register_Destroyable_Gen
        (AST_Envs.Lexical_Env_Record, AST_Envs.Lexical_Env_Access, Destroy);
   begin
      Helper (Unit, Env);
   end Register_Destroyable;

   -----------------------
   -- Invalidate_Caches --
   -----------------------

   procedure Invalidate_Caches
     (Context : Internal_Context; Invalidate_Envs : Boolean) is
   begin
      --  Increase Context's version number. If we are about to overflow, reset
      --  all version numbers from analysis units.
      if Context.Cache_Version = Version_Number'Last then
         Context.Cache_Version := 1;
         for Unit of Context.Units loop
            Unit.Cache_Version := 0;
         end loop;
      else
         Context.Cache_Version := Context.Cache_Version + 1;
      end if;

      if Invalidate_Envs then
         Context.Reparse_Cache_Version := Context.Cache_Version;
      end if;
   end Invalidate_Caches;

   ------------------
   --  Reset_Envs  --
   ------------------

   procedure Reset_Envs (Unit : Internal_Unit) is

      procedure Deactivate_Refd_Envs (Node : Bare_R_F_L_X_Node);
      procedure Recompute_Refd_Envs (Node : Bare_R_F_L_X_Node);

      --------------------------
      -- Deactivate_Refd_Envs --
      --------------------------

      procedure Deactivate_Refd_Envs (Node : Bare_R_F_L_X_Node) is
      begin
         if Node = null then
            return;
         end if;

         Deactivate_Referenced_Envs (Node.Self_Env);
         for I in 1 .. Children_Count (Node) loop
            Deactivate_Refd_Envs (Child (Node, I));
         end loop;
      end Deactivate_Refd_Envs;

      -------------------------
      -- Recompute_Refd_Envs --
      -------------------------

      procedure Recompute_Refd_Envs (Node : Bare_R_F_L_X_Node) is
      begin
         if Node = null then
            return;
         end if;
         Recompute_Referenced_Envs (Node.Self_Env);
         for I in 1 .. Children_Count (Node) loop
            Recompute_Refd_Envs (Child (Node, I));
         end loop;
      end Recompute_Refd_Envs;

   begin
      --  First pass will deactivate every referenced envs that Unit possesses
      Deactivate_Refd_Envs (Unit.Ast_Root);

      --  Second pass will recompute the env they are pointing to
      Recompute_Refd_Envs (Unit.Ast_Root);
   end Reset_Envs;

   -------------
   -- Destroy --
   -------------

   procedure Destroy (Reparsed : in out Reparsed_Unit) is
   begin
      Free (Reparsed.TDH);
      Reparsed.Diagnostics := Diagnostics_Vectors.Empty_Vector;
      Free (Reparsed.Ast_Mem_Pool);
      Reparsed.Ast_Root := null;
   end Destroy;

   --------------
   -- Basename --
   --------------

   function Basename (Filename : String) return String is
   begin
      return +Create (+Filename).Base_Name;
   end Basename;

   --------------
   -- Basename --
   --------------

   function Basename (Unit : Internal_Unit) return String is
   begin
      return +Unit.Filename.Base_Name;
   end Basename;

   ------------------
   -- Reset_Caches --
   ------------------

   procedure Reset_Caches (Unit : Internal_Unit) is
      Cache_Version : constant Version_Number := Unit.Cache_Version;
   begin
      if Cache_Version < Unit.Context.Reparse_Cache_Version then
         Unit.Cache_Version := Unit.Context.Reparse_Cache_Version;
         Reset_Envs (Unit);
      end if;

      if Cache_Version < Unit.Context.Cache_Version then
         Unit.Cache_Version := Unit.Context.Cache_Version;
      end if;
   end Reset_Caches;

   --------------------
   -- Reference_Unit --
   --------------------

   procedure Reference_Unit (From, Referenced : Internal_Unit) is
      Dummy : Boolean;
   begin
      Dummy := Analysis_Unit_Sets.Add (From.Referenced_Units, Referenced);
   end Reference_Unit;

   ------------------------
   -- Is_Referenced_From --
   ------------------------

   function Is_Referenced_From
     (Self, Unit : Internal_Unit) return Boolean is
   begin
      if Unit = null or else Self = null then
         return False;
      elsif Unit = Self then
         return True;
      else
         return Analysis_Unit_Sets.Has (Unit.Referenced_Units, Self);
      end if;
   end Is_Referenced_From;

   ----------------
   -- Do_Parsing --
   ----------------

   procedure Do_Parsing
     (Unit   : Internal_Unit;
      Input  : Internal_Lexer_Input;
      Result : out Reparsed_Unit)
   is
      Context  : constant Internal_Context := Unit.Context;
      Unit_TDH : constant Token_Data_Handler_Access := Token_Data (Unit);

      Saved_TDH : Token_Data_Handler;
      --  Holder to save tokens data in Unit.
      --
      --  By design, parsing is required to bind the nodes it creates to an
      --  analysis unit. However, this procedure is supposed to preserve the
      --  Unit itself and return its parsing result in Result.
      --
      --  In order to implement this, we first move "old" token data in this
      --  variable, then we do parsing. Only then, we can move "new" token data
      --  from the unit to Result, and restore the "old" token data to Unit.
      --  This last step is what Rotate_TDH (see below) is above.

      procedure Rotate_TDH;
      --  Move token data from Unit to Result and restore data in Saved_TDH to
      --  Unit.

      ----------------
      -- Rotate_TDH --
      ----------------

      procedure Rotate_TDH is
      begin
         Move (Result.TDH, Unit_TDH.all);
         Move (Unit_TDH.all, Saved_TDH);
      end Rotate_TDH;

   begin
      GNATCOLL.Traces.Trace (Main_Trace, "Parsing unit " & Basename (Unit));

      Result.Ast_Root := null;

      Move (Saved_TDH, Unit_TDH.all);
      Initialize (Unit_TDH.all,
                  Saved_TDH.Symbols,
                  Unit.all'Address,
                  Unit.Context.Tab_Stop);

      --  This is where lexing occurs, so this is where we get most "setup"
      --  issues: missing input file, bad charset, etc. If we have such an
      --  error, catch it, turn it into diagnostics and abort parsing.
      --
      --  As it is quite common, first check if the file is readable: if not,
      --  don't bother opening it and directly emit a diagnostic. This avoid
      --  pointless exceptions which harm debugging. Note that this
      --  optimization is valid only when there is no file reader, which can
      --  work even when there is no real source file.

      if Context.File_Reader = null
         and then Input.Kind = File
         and then (Input.Filename.Is_Directory
                   or else (not Input.Filename.Is_Readable))
      then
         declare
            Name : constant String := Basename (Unit);
         begin
            GNATCOLL.Traces.Trace
              (Main_Trace, "WARNING: File is not readable: " & Name);
            Append
              (Result.Diagnostics,
               No_Source_Location_Range,
               "Cannot read " & To_Text (Name));
            Rotate_TDH;
            return;
         end;
      end if;

      --  Initialize the parser, which fetches the source buffer and extract
      --  all tokens.

      Init_Parser
        (Input, Context.With_Trivia, Unit, Unit_TDH, Unit.Context.Parser);

      --  If we could run the lexer, run the parser and get the root node

      if Unit_TDH.Source_Buffer /= null then
         Result.Ast_Mem_Pool := Create;
         Unit.Context.Parser.Mem_Pool := Result.Ast_Mem_Pool;
         Result.Ast_Root := Bare_R_F_L_X_Node
           (Parse (Unit.Context.Parser, Rule => Unit.Rule));
      end if;

      --  Forward token data and diagnostics to the returned unit

      Rotate_TDH;
      Result.Diagnostics.Append_Vector (Unit.Context.Parser.Diagnostics);
   end Do_Parsing;

   --------------------------
   -- Update_After_Reparse --
   --------------------------

   procedure Update_After_Reparse
     (Unit : Internal_Unit; Reparsed : in out Reparsed_Unit) is
   begin
      --  Remove the `symbol -> AST node` associations for Unit's nodes in
      --  foreign lexical environments.
      Remove_Exiled_Entries (Unit);

      --  Remove the named envs that Unit created
      declare
         Named_Envs_Needing_Update : NED_Maps.Map;
      begin
         Remove_Named_Envs (Unit, Named_Envs_Needing_Update);
         Update_Named_Envs (Unit.Context, Named_Envs_Needing_Update);
      end;

      --  At this point, envs and nodes that don't belong to this unit no
      --  longer reference this unit's envs and nodes. It is thus now safe to
      --  deallocate this unit's obsolete data.

      --  Replace Unit's diagnostics by Reparsed's
      Unit.Diagnostics := Reparsed.Diagnostics;
      Reparsed.Diagnostics.Clear;

      --  As (re-)loading a unit can change how any AST node property in the
      --  whole analysis context behaves, we have to invalidate caches. This
      --  is likely overkill, but kill all caches here as it's easy to do.
      --
      --  As an optimization, invalidate referenced envs cache only if this is
      --  not the first time we parse Unit.
      Invalidate_Caches
        (Unit.Context, Invalidate_Envs => Unit.Ast_Root /= null);

      --  Likewise for token data
      Free (Unit.TDH);
      Move (Unit.TDH, Reparsed.TDH);

      --  Reparsing will invalidate all lexical environments related to this
      --  unit, so destroy all related rebindings as well. This browses AST
      --  nodes, so we have to do this before destroying the old AST nodes
      --  pool.
      Destroy_Rebindings (Unit.Rebindings'Access);

      --  Destroy the old AST node and replace it by the new one
      if Unit.Ast_Root /= null then
         Destroy (Unit.Ast_Root);
      end if;
      Unit.Ast_Root := Reparsed.Ast_Root;

      --  Likewise for memory pools
      Free (Unit.Ast_Mem_Pool);
      Unit.Ast_Mem_Pool := Reparsed.Ast_Mem_Pool;
      Reparsed.Ast_Mem_Pool := No_Pool;

      --  Increment unit version number to invalidate caches and stale node
      --  reference. Also propagate it to the TDH.
      Unit.Unit_Version := Unit.Unit_Version + 1;
      Unit.TDH.Version := Unit.Unit_Version;

      --  Compute the PLE_Roots_Starting_Token table

      Unit.PLE_Roots_Starting_Token.Clear;

      --  Update all the lexical envs entries affected by the reparse

      declare
         Unit_Name     : constant String := +Unit.Filename.Base_Name;
         Context       : constant Internal_Context := Unit.Context;
         Foreign_Nodes : Bare_R_F_L_X_Node_Vectors.Vector :=
           Bare_R_F_L_X_Node_Vectors.Empty_Vector;

         Saved_In_Populate_Lexical_Env : constant Boolean :=
           Context.In_Populate_Lexical_Env;
         Saved_Env_Populated_Roots     : constant Boolean_Vectors.Vector :=
           Unit.Env_Populated_Roots;
      begin
         Context.In_Populate_Lexical_Env := True;
         if Main_Trace.Active then
            Main_Trace.Trace
              ("Updating lexical envs for " & Unit_Name & " after reparse");
            Main_Trace.Increase_Indent;
         end if;

         --  Collect all nodes that are foreign in this Unit's lexical envs.
         --  Exclude them from the corresponding lists of exiled entries.
         Extract_Foreign_Nodes (Unit, Foreign_Nodes);

         --  Temporarily reset Env_Populated_Roots so that Populate_Lexical_Env
         --  accepts to do its work on reparsed trees.

         Unit.Env_Populated_Roots := Boolean_Vectors.Empty_Vector;

         --  Now that Unit has been reparsed, we can destroy all its
         --  destroyables, which refer to the old tree (i.e. dangling
         --  pointers).
         Destroy_Unit_Destroyables (Unit);

         for FN of Foreign_Nodes loop
            declare
               Node_Image : constant String := Image (Short_Text_Image (FN));
               Unit_Name  : constant String := +FN.Unit.Filename.Base_Name;
            begin
               GNATCOLL.Traces.Trace
                 (Main_Trace, "Rerooting: " & Node_Image
                              & " (from " & Unit_Name & ")");
            end;
            Reroot_Foreign_Node (FN);
         end loop;
         Foreign_Nodes.Destroy;

         --  Re-populate all PLE roots that were requested so far for this
         --  unit. In the case where the unit has no PLE root, run PLE on the
         --  whole unit iff it was requested on at least one PLE root.

         declare
            function At_Least_One_Root_Populated return Boolean
            is (for some B of Saved_Env_Populated_Roots => B);
         begin
               if At_Least_One_Root_Populated then
                  Populate_Lexical_Env (Unit);
               end if;
         end;

         --  Restore the unit's original Env_Populated_Roots flags

         Unit.Env_Populated_Roots.Destroy;
         Unit.Env_Populated_Roots := Saved_Env_Populated_Roots;

         Context.In_Populate_Lexical_Env := Saved_In_Populate_Lexical_Env;
         if Main_Trace.Is_Active then
            Main_Trace.Decrease_Indent;
         end if;
      end;
   end Update_After_Reparse;

   -------------------------------
   -- Destroy_Unit_Destroyables --
   -------------------------------

   procedure Destroy_Unit_Destroyables (Unit : Internal_Unit) is
   begin
      for D of Unit.Destroyables loop
         D.Destroy (D.Object);
      end loop;
      Destroyable_Vectors.Clear (Unit.Destroyables);
   end Destroy_Unit_Destroyables;

   ---------------------------
   -- Remove_Exiled_Entries --
   ---------------------------

   procedure Remove_Exiled_Entries (Unit : Internal_Unit) is
   begin
      for EE of Unit.Exiled_Entries loop
         AST_Envs.Remove (EE.Env, EE.Key, EE.Node);

         --  Also strip foreign nodes information from "outer" units so that it
         --  does not contain stale information (i.e. dangling pointers to
         --  nodes that belong to the units in the queue).
         if EE.Env.Owner /= No_Generic_Unit then
            declare
               Foreign_Nodes : Foreign_Node_Entry_Vectors.Vector renames
                  Convert_Unit (EE.Env.Owner).Foreign_Nodes;
               Current       : Positive := Foreign_Nodes.First_Index;
            begin
               while Current <= Foreign_Nodes.Last_Index loop
                  if Foreign_Nodes.Get (Current).Node = EE.Node then
                     Foreign_Nodes.Pop (Current);
                  else
                     Current := Current + 1;
                  end if;
               end loop;
            end;
         end if;
      end loop;

      Unit.Exiled_Entries.Clear;
   end Remove_Exiled_Entries;

   -----------------------
   -- Remove_Named_Envs --
   -----------------------

   procedure Remove_Named_Envs
     (Unit                      : Internal_Unit;
      Named_Envs_Needing_Update : in out NED_Maps.Map) is
   begin
      --  Remove nodes in this unit from the Named_Env_Descriptor.Foreign_Nodes
      --  components in which they are registered and from the foreign
      --  environments themselves.
      for EE of Unit.Exiled_Entries_In_NED loop
         Remove (EE.Named_Env.Foreign_Nodes, EE.Key, EE.Node);
         Remove (EE.Named_Env.Env_With_Precedence, EE.Key, EE.Node);
      end loop;
      Unit.Exiled_Entries_In_NED.Clear;

      --  Remove nodes in this unit from the
      --  Named_Env_Descriptor.Nodes_With_Foreign_Env components in which they
      --  are registered.
      for Cur in Unit.Nodes_With_Foreign_Env.Iterate loop
         declare
            use Node_To_Named_Env_Maps;
            Node : constant Bare_R_F_L_X_Node := Key (Cur);
            NE   : constant Named_Env_Descriptor_Access := Element (Cur);
         begin
            NE.Nodes_With_Foreign_Env.Delete (Node);
         end;
      end loop;
      Unit.Nodes_With_Foreign_Env.Clear;

      --  Remove ends in this unit from the Named_Env_Descriptor.Foreign_Envs
      --  components in which they are registered.
      for EE of Unit.Exiled_Envs loop
         EE.Named_Env.Foreign_Envs.Delete (Env_Node (EE.Env));
      end loop;
      Unit.Exiled_Envs.Clear;

      --  Remove named envs that this unit created
      for NE of Unit.Named_Envs loop
         declare
            NED_Access : constant Named_Env_Descriptor_Access :=
               Unit.Context.Named_Envs.Element (NE.Name);
            NED        : Named_Env_Descriptor renames NED_Access.all;
         begin
            NED.Envs.Delete (Env_Node (NE.Env));

            --  If this named environment had precedence, we must schedule an
            --  update for this name environment entry.
            if NE.Env = NED.Env_With_Precedence then
               Named_Envs_Needing_Update.Include (NE.Name, NED_Access);
               NED.Env_With_Precedence := Empty_Env;
            end if;
         end;
      end loop;
      Unit.Named_Envs.Clear;
   end Remove_Named_Envs;

   ---------------------------
   -- Extract_Foreign_Nodes --
   ---------------------------

   procedure Extract_Foreign_Nodes
     (Unit          : Internal_Unit;
      Foreign_Nodes : in out Bare_R_F_L_X_Node_Vectors.Vector) is
   begin
      --  Go through all foreign nodes registered in Unit's lexical
      --  environments.
      for FN of Unit.Foreign_Nodes loop
         --  Collect them
         Foreign_Nodes.Append (FN.Node);

         --  For each foreign node, remove the corresponding exiled entry in
         --  that foreign unit (each foreign node in unit A has a corresponding
         --  exiled entry in unit B).
         declare
            Exiled_Entries : Exiled_Entry_Vectors.Vector renames
               FN.Unit.Exiled_Entries;
            Current        : Positive := Exiled_Entries.First_Index;
         begin
            while Current <= Exiled_Entries.Last_Index loop
               if Exiled_Entries.Get (Current).Node = FN.Node then
                  Exiled_Entries.Pop (Current);
               else
                  Current := Current + 1;
               end if;
            end loop;
         end;
      end loop;
      Unit.Foreign_Nodes.Clear;
   end Extract_Foreign_Nodes;

   --------------------------
   -- Reroot_Foreign_Nodes --
   --------------------------

   procedure Reroot_Foreign_Node (Node : Bare_R_F_L_X_Node) is
      Unit : constant Internal_Unit := Node.Unit;
   begin
      --  First, filter the exiled entries in foreign units so that they don't
      --  contain references to this unit's lexical environments.  We need to
      --  do that before running the partial Populate_Lexical_Env pass so that
      --  we don't remove exiled entries that this pass will produce.
      declare
         Exiled_Entries : Exiled_Entry_Vectors.Vector renames
            Unit.Exiled_Entries;
         Current        : Positive := Exiled_Entries.First_Index;
      begin
         while Current <= Exiled_Entries.Last_Index loop
            if Exiled_Entries.Get (Current).Node = Node then
               Exiled_Entries.Pop (Current);
            else
               Current := Current + 1;
            end if;
         end loop;
      end;

      --  Re-do a partial Populate_Lexical_Env pass for each foreign node that
      --  this unit contains so that they are relocated in our new lexical
      --  environments.
      declare
         Unit_State : aliased PLE_Unit_State :=
           (Named_Envs_Needing_Update => <>);
         State      : PLE_Node_State :=
           (Unit_State  => Unit_State'Unchecked_Access,
            Current_Env => Node.Self_Env,
            Current_NED => null);
      begin
         Pre_Env_Actions (Node, State, Add_To_Env_Only => True);
         Post_Env_Actions (Node, State);
      end;
   end Reroot_Foreign_Node;

   ----------
   -- Text --
   ----------

   function Text (Node : Bare_R_F_L_X_Node) return String_Type is
   begin
      return Create_String (Text (Node));
   end Text;

   ------------------------
   -- Destroy_Rebindings --
   ------------------------

   procedure Destroy_Rebindings
     (Rebindings : access Env_Rebindings_Vectors.Vector)
   is
      procedure Recurse (R : in out Env_Rebindings);
      --  Destroy R's children and then destroy R. It is up to the caller to
      --  remove R from its parent's Children vector.

      procedure Unregister
        (R          : Env_Rebindings;
         Rebindings : in out Env_Rebindings_Vectors.Vector);
      --  Remove R from Rebindings

      -------------
      -- Recurse --
      -------------

      procedure Recurse (R : in out Env_Rebindings) is
      begin
         for C of R.Children loop
            declare
               C_Var : Env_Rebindings := C;
            begin
               Recurse (C_Var);
            end;
         end loop;
         R.Children.Destroy;

         Unregister (R, Convert_Unit (R.Old_Env.Owner).Rebindings);
         Unregister (R, Convert_Unit (R.New_Env.Owner).Rebindings);

         Release_Rebinding (R);
      end Recurse;

      ----------------
      -- Unregister --
      ----------------

      procedure Unregister
        (R          : Env_Rebindings;
         Rebindings : in out Env_Rebindings_Vectors.Vector) is
      begin
         for I in 1 .. Rebindings.Length loop
            if Rebindings.Get (I) = R then
               Rebindings.Pop (I);
               return;
            end if;
         end loop;

         --  We are always supposed to find R in Rebindings, so this should be
         --  unreachable.
         raise Program_Error;
      end Unregister;

   begin
      while Rebindings.Length > 0 loop
         declare
            R : Env_Rebindings := Rebindings.Get (1);
         begin
            --  Here, we basically undo what has been done in AST_Envs.Append

            --  If this rebinding has no parent, then during its creation we
            --  registered it in its Old_Env. Otherwise, it is registered
            --  in its Parent's Children list.
            if R.Parent = null then
               Unwrap (R.Old_Env).Rebindings_Pool.Delete (R.New_Env);
            else
               Unregister (R, R.Parent.Children);
            end if;

            --  In all cases it's registered in Old_Env's and New_Env's units
            Recurse (R);
         end;
      end loop;
   end Destroy_Rebindings;

   --------------------------
   -- Get_Rewriting_Handle --
   --------------------------

   function Get_Rewriting_Handle
     (Context : Internal_Context) return Rewriting_Handle_Pointer is
   begin
      return Context.Rewriting_Handle;
   end Get_Rewriting_Handle;

   --------------------------
   -- Set_Rewriting_Handle --
   --------------------------

   procedure Set_Rewriting_Handle
     (Context : Internal_Context; Handle : Rewriting_Handle_Pointer) is
   begin
      Context.Rewriting_Handle := Handle;
   end Set_Rewriting_Handle;

   -----------------------
   -- Create_Safety_Net --
   -----------------------

   function Create_Safety_Net
     (Context : Internal_Context) return Iterator_Safety_Net
   is
   begin
      return (Context         => Context,
              Context_Serial  => Context.Serial_Number,
              Context_Version => Context.Cache_Version);
   end Create_Safety_Net;

   ----------------------
   -- Check_Safety_Net --
   ----------------------

   procedure Check_Safety_Net (Self : Iterator_Safety_Net) is
   begin
      if Self.Context = null then
         return;
      end if;

      --  Check that the context is still the same (not released nor reused)
      if Self.Context.Serial_Number /= Self.Context_Serial
         or else Self.Context.Cache_Version /= Self.Context_Version
      then
         raise Stale_Reference_Error;
      end if;
   end Check_Safety_Net;

   ----------------------
   -- String_To_Symbol --
   ----------------------

   function String_To_Symbol
     (Self    : Bare_R_F_L_X_Node;
      Context : Internal_Context;
      S       : String_Type) return Symbol_Type is
   begin
      return (if S.Length > 0
              then Lookup_Symbol (Context, S.Content)
              else null);
   exception
      when Exc : Invalid_Symbol_Error =>
         Raise_Property_Exception
           (Self,
            Property_Error'Identity,
            Ada.Exceptions.Exception_Message (Exc));
   end String_To_Symbol;

   -------------
   -- Inc_Ref --
   -------------

   procedure Inc_Ref (Self : String_Type) is
   begin
      if Self.Ref_Count >= 0 then
         Self.Ref_Count := Self.Ref_Count + 1;
      end if;
   end Inc_Ref;

   -------------
   -- Dec_Ref --
   -------------

   procedure Dec_Ref (Self : in out String_Type) is
   begin
      if Self = null or else Self.Ref_Count < 0 then
         return;
      end if;

      if Self.Ref_Count = 1 then
         Free (Self);
      else
         Self.Ref_Count := Self.Ref_Count - 1;
         Self := null;
      end if;
   end Dec_Ref;

   -------------------
   -- Create_String --
   -------------------

   function Create_String (Content : Text_Type) return String_Type is
   begin
      return Result : constant String_Type := new String_Record'
        (Length    => Content'Length,
         Ref_Count => 1,
         Content   => Content);
   end Create_String;

   -------------------
   -- Create_String --
   -------------------

   function Create_String (Content : Unbounded_Text_Type) return String_Type is
      S : Big_Wide_Wide_String_Access;
      L : Natural;
   begin
      Get_Wide_Wide_String (Content, S, L);
      return Create_String (S.all (1 .. L));
   end Create_String;

   -------------------
   -- Concat_String --
   -------------------

   function Concat_String (Left, Right : String_Type) return String_Type is
   begin
      return Result : constant String_Type :=
        new String_Record (Length => Left.Length + Right.Length)
      do
         Result.Ref_Count := 1;
         Result.Content (1 .. Left.Length) := Left.Content;
         Result.Content (Left.Length + 1 .. Result.Length) := Right.Content;
      end return;
   end Concat_String;

   ----------------
   -- Equivalent --
   ----------------

   function Equivalent (Left, Right : String_Type) return Boolean is
   begin
      return Left.Content = Right.Content;
   end Equivalent;

begin
   No_Big_Integer.Value.Set (0);
end Librflxlang.Implementation;
