libadalang_24.0.0_a1358075/src/libadalang-data_decomposition.adb

--
--  Copyright (C) 2022-2023, AdaCore
--  SPDX-License-Identifier: Apache-2.0
--

with Ada.Containers.Hashed_Sets;
with Ada.Containers.Vectors;
with Ada.Exceptions; use Ada.Exceptions;
with Ada.IO_Exceptions;
with Ada.Text_IO;    use Ada.Text_IO;

with GNATCOLL.JSON; use GNATCOLL.JSON;
with GNATCOLL.Mmap;
with GNATCOLL.OS.FS;
with GNATCOLL.OS.Process;
with GNATCOLL.VFS;
with GPR2.Containers;
with GPR2.Context;
with GPR2.Path_Name;
with GPR2.Path_Name.Set;

with Libadalang.Auto_Provider; use Libadalang.Auto_Provider;
with Libadalang.Common;        use Libadalang.Common;
with Libadalang.GPR_Utils;     use Libadalang.GPR_Utils;

package body Libadalang.Data_Decomposition is

   Zero      : constant GMP_Int.Big_Integer := GMP_Int.Make ("0");
   One       : constant GMP_Int.Big_Integer := GMP_Int.Make ("1");
   Size_Last : constant GMP_Int.Big_Integer :=
     GMP_Int.Make (Size_Type'Last'Image);

   function Type_Kind_For (Decl : Base_Type_Decl'Class) return Type_Kind;
   --  Return the type kind for the given type declaration parse tree. Raise a
   --  ``Type_Mimatch_Error`` exception if it is not possible to determine this
   --  type kind.

   function Wrap
     (Self       : Numerical_Expression_Access;
      Collection : Repinfo_Collection)
      return Numerical_Expression;
   function Wrap
     (Self        : Type_Representation_Access;
      Declaration : Base_Type_Decl'Class;
      Collection  : Repinfo_Collection)
      return Type_Representation;
   function Wrap
     (Self        : Variant_Representation_Access;
      Declaration : Variant;
      Collection  : Repinfo_Collection)
      return Variant_Representation;
   function Wrap
     (Self        : Component_Representation_Access;
      Declaration : Defining_Name;
      Collection  : Repinfo_Collection)
      return Component_Representation;
   --  Converter between internal objects and public ones

   package Defining_Name_Vectors is new Ada.Containers.Vectors
     (Positive, Defining_Name);

   procedure Iterate_Derivations
     (Collection : Repinfo_Collection;
      Decl       : Base_Type_Decl'Class;
      Repr       : Type_Representation_Access;
      Process    : access procedure (Decl : Concrete_Type_Decl;
                                     Def  : Type_Def;
                                     Repr : Type_Representation_Access));
   --  Assuming that ``Self`` is a record type declaration and ``Repr`` the
   --  corresponding representation data, call ``Process`` on all types whose
   --  derivations yield to ``Self`` plus their corresponding representation
   --  data.

   function Get_Component_List (Def : Type_Def) return Component_List;
   --  Assuming that ``Self`` is a record type declaration, return its root
   --  component list (i.e. ignoring component lists for parents and variant
   --  parts).

   type Component_Association is record
      Decl : Defining_Name;
      Repr : Component_Representation_Access;
   end record;

   package Component_Association_Vectors is new Ada.Containers.Vectors
     (Positive, Component_Association);

   function Component_Associations
     (Collection : Repinfo_Collection;
      Decl       : Base_Type_Decl'Class;
      Repr       : Type_Representation_Access)
      return Component_Association_Vectors.Vector;
   --  Append to ``Decls`` all components from ``Self``, including
   --  discriminants, components defined in parent types, but excluding
   --  components from variant parts.

   ----------------------
   -- Extract_Variants --
   ----------------------

   function Extract_Variants
     (Collection : Repinfo_Collection;
      Decl       : Ada_Node'Class;
      Variants   : Variant_Representation_Access_Array;
      Part_Node  : Variant_Part) return Variant_Representation_Array;
   --  Return the array of ``Variant_Representation`` corresponding to
   --  ``Variants`` and ``Part_Node``. Raise a ``Type_Mismatch_Error`` if an
   --  inconstency is detected between the two: ``Part_Node`` being null or not
   --  having the right number of variants.
   --
   --  ``Collection`` is used to wrap variant representations, ``Decl`` is used
   --  for error message formatting

   function Load_JSON (Filename : String) return JSON_Value;
   --  Open ``Filename`` in read mode, parse its content and return the
   --  corresponding JSON document. Raise a ``Loading_Error`` exception in case
   --  of error.

   function Symbolize
     (Self : in out Repinfo_Collection_Data; Name : String) return Symbol_Type;
   function Symbolize
     (Self : in out Repinfo_Collection_Data;
      Name : Text_Type) return Symbol_Type;
   --  Turn the given name into a symbol for ``Self``

   function Load_Type
     (Self   : in out Repinfo_Collection_Data;
      Entity : JSON_Value;
      Name   : String) return Type_Representation_Access;
   --  Import the type representation corresponding to the description in
   --  ``Entity`` into ``Self``. Return null if this is not an entity we can
   --  handle.

   function Load_Components
     (Self       : in out Repinfo_Collection_Data;
      Components : JSON_Value;
      Context    : String) return Component_Representation_Access_Array_Access;
   --  Import the component representations from ``Components`` into ``Self``.
   --
   --  ``Context`` must be a human-readable description of the contanining
   --  entity being loaded, for error reporting purposes.

   function Load_Variants
     (Self     : in out Repinfo_Collection_Data;
      Variants : JSON_Value;
      Context  : String) return Variant_Representation_Access_Array_Access;
   --  Import the variant representations from ``Variants`` into ``Self``.
   --
   --  ``Context`` must be a human-readable description of the contanining
   --  entity being loaded, for error reporting purposes.

   function Load_Numerical_Expression
     (Self       : in out Repinfo_Collection_Data;
      Expression : JSON_Value;
      Context    : String) return Numerical_Expression_Access;
   --  Import the numerical expression that ``Expression`` denotes into
   --  ``Self``.  Return null if this expression cannot be evaluated.
   --
   --  ``Context`` must be a human-readable description of the expression being
   --  loaded, for error reporting purposes.

   function Load_Rational
     (Self       : in out Repinfo_Collection_Data;
      Expression : JSON_Value;
      Context    : String) return Rational_Access;
   --  Import the rational number that ``Expression`` denotes into ``Self``.
   --
   --  ``Context`` must be a human-readable description of the expression being
   --  loaded, for error reporting purposes.

   ----------------
   -- Allocators --
   ----------------

   function Allocate_Integer
     (Self : in out Repinfo_Collection_Data) return Integer_Access;
   --  Allocate a big integer for ``Self``

   function Allocate_Rational
     (Self : in out Repinfo_Collection_Data) return Rational_Access;
   --  Allocate a rational number for ``Self``

   ---------------------
   -- Pool allocators --
   ---------------------

   subtype Record_Type_Subtype is Type_Representation_Data (Record_Type);
   type Record_Type_Access is access all Record_Type_Subtype;
   pragma No_Strict_Aliasing (Record_Type_Access);
   package Record_Type_Allocator is new Alloc
     (Record_Type_Subtype, Record_Type_Access);
   function Allocate_Record_Type
     (Pool : Bump_Ptr_Pool) return Type_Representation_Access;

   subtype Array_Type_Subtype is Type_Representation_Data (Array_Type);
   type Array_Type_Access is access all Array_Type_Subtype;
   pragma No_Strict_Aliasing (Array_Type_Access);
   package Array_Type_Allocator is new Alloc
     (Array_Type_Subtype, Array_Type_Access);
   function Allocate_Array_Type
     (Pool : Bump_Ptr_Pool) return Type_Representation_Access;

   subtype Fixed_Type_Subtype is
     Type_Representation_Data (Internal_Fixed_Type);
   type Fixed_Type_Access is access all Fixed_Type_Subtype;
   pragma No_Strict_Aliasing (Fixed_Type_Access);
   package Fixed_Type_Allocator is new Alloc
     (Fixed_Type_Subtype, Fixed_Type_Access);
   function Allocate_Fixed_Type
     (Pool : Bump_Ptr_Pool) return Type_Representation_Access;

   subtype Other_Type_Subtype is Type_Representation_Data (Other_Type);
   type Other_Type_Access is access all Other_Type_Subtype;
   pragma No_Strict_Aliasing (Other_Type_Access);
   package Other_Type_Allocator is new Alloc
     (Other_Type_Subtype, Other_Type_Access);
   function Allocate_Other_Type
     (Pool : Bump_Ptr_Pool) return Type_Representation_Access;

   package Numerical_Expression_Allocator is new Alloc
     (Numerical_Expression_Data, Numerical_Expression_Access);
   function Allocate_Numerical_Expression
     (Pool : Bump_Ptr_Pool) return Numerical_Expression_Access
   renames Numerical_Expression_Allocator.Alloc;

   type Expr_Node_Wrapper is record
      Data : aliased Expr_Node_Data;
   end record;
   type Expr_Node_Wrapper_Access is access all Expr_Node_Wrapper;
   pragma No_Strict_Aliasing (Expr_Node_Wrapper_Access);
   package Expr_Node_Allocator is new Alloc
     (Expr_Node_Wrapper, Expr_Node_Wrapper_Access);
   function Allocate_Expr_Node (Pool : Bump_Ptr_Pool) return Expr_Node_Access;

   package Variant_Representation_Allocator is new Alloc
     (Variant_Representation_Data, Variant_Representation_Access);
   function Allocate_Variant_Representation
     (Pool : Bump_Ptr_Pool) return Variant_Representation_Access
   renames Variant_Representation_Allocator.Alloc;

   package Component_Representation_Allocator is new Alloc
     (Component_Representation_Data, Component_Representation_Access);
   function Allocate_Component_Representation
     (Pool : Bump_Ptr_Pool) return Component_Representation_Access
   renames Component_Representation_Allocator.Alloc;

   -----------------------------
   -- Constants for JSON keys --
   -----------------------------

   Key_Alignment   : constant String := "Alignment";
   Key_Object_Size : constant String := "Object_Size";
   Key_Size        : constant String := "Size";
   Key_Value_Size  : constant String := "Value_Size";

   -------------------
   -- Type_Kind_For --
   -------------------

   function Type_Kind_For (Decl : Base_Type_Decl'Class) return Type_Kind is
      Full : Base_Type_Decl := Decl.P_Full_View;
      Def  : Type_Def := No_Type_Def;
   begin
      --  Loop in order to traverse derived types until we can find the type
      --  kind.

      Def_Loop : loop
         if Full.Is_Null then
            raise Type_Mismatch_Error with
              "cannot find full view for " & Decl.Image;
         end if;

         --  First analyze the "type decl" layer

         Full_Loop : loop
            case Ada_Base_Type_Decl (Full.Kind) is
               when Ada_Type_Decl =>
                  Def := Full.As_Type_Decl.F_Type_Def;
                  if Full.Is_Null then
                     raise Type_Mismatch_Error with
                       "incomplete parse tree for " & Full.Image;
                  end if;
                  exit Full_Loop;

               when Ada_Subtype_Decl =>
                  Full :=
                    (Full.As_Subtype_Decl
                     .F_Subtype
                     .P_Designated_Type_Decl
                     .P_Full_View);

               when Ada_Task_Type_Decl_Range =>
                  return Task_Type;

               when Ada_Protected_Type_Decl =>
                  return Protected_Type;

               when Ada_Incomplete_Type_Decl_Range =>
                  raise Type_Mismatch_Error with
                    "cannot find full view for " & Full.Image;

               when Ada_Discrete_Base_Subtype_Decl
                  | Ada_Classwide_Type_Decl =>
                  Full := Full.Parent.As_Base_Type_Decl.P_Full_View;
            end case;
         end loop Full_Loop;

         --  Then analyze the "type def" layer, if any

         case Ada_Type_Def (Def.Kind) is
            when Ada_Access_Def               => return Access_Type;
            when Ada_Enum_Type_Def            => return Enumeration_Type;
            when Ada_Signed_Int_Type_Def      => return Signed_Type;
            when Ada_Mod_Int_Type_Def         => return Modular_Type;
            when Ada_Floating_Point_Def       => return Floating_Type;
            when Ada_Decimal_Fixed_Point_Def  => return Decimal_Type;
            when Ada_Ordinary_Fixed_Point_Def => return Ordinary_Type;
            when Ada_Array_Type_Def           => return Array_Type;
            when Ada_Interface_Type_Def       => return Interface_Type;
            when Ada_Record_Type_Def          => return Record_Type;

            when Ada_Private_Type_Def =>
               raise Type_Mismatch_Error with
                 "cannot find full view for " & Full.Image;

            when Ada_Formal_Discrete_Type_Def =>
               raise Type_Mismatch_Error with
                 "cannot resolve type in uninstantiated generic " & Full.Image;

            when Ada_Derived_Type_Def =>
               Full :=
                 (Def.As_Derived_Type_Def
                  .F_Subtype_Indication
                  .P_Designated_Type_Decl
                  .P_Full_View);
         end case;
      end loop Def_Loop;
   end Type_Kind_For;

   ----------
   -- Wrap --
   ----------

   function Wrap
     (Self       : Numerical_Expression_Access;
      Collection : Repinfo_Collection)
      return Numerical_Expression is
   begin
      if Self = null then
         return (raise Unsupported_Expression);
      else
         return (Collection, Self);
      end if;
   end Wrap;

   ----------
   -- Wrap --
   ----------

   function Wrap
     (Self        : Type_Representation_Access;
      Declaration : Base_Type_Decl'Class;
      Collection  : Repinfo_Collection)
      return Type_Representation
   is
      Variant_Part_Node : Variant_Part := No_Variant_Part;
      Variants          : Variant_Representation_Access_Array_Access;

      procedure Process
        (Decl : Concrete_Type_Decl;
         Def  : Type_Def;
         Repr : Type_Representation_Access);
      --  Ensure that ``Decl``/``Def`` and ``Repr`` are consistent regarding
      --  variant parts (either both have one, either one have it). Update the
      --  ``Variant_Part_Node`` and ``Variants`` local variables above
      --  accordingly. Since it is illegal in Ada for a record extension chain
      --  to have more than one variant part, also check that we do not exceed
      --  this here.

      -------------
      -- Process --
      -------------

      procedure Process
        (Decl : Concrete_Type_Decl;
         Def  : Type_Def;
         Repr : Type_Representation_Access)
      is
         VP : constant Variant_Part := Get_Component_List (Def).F_Variant_Part;
      begin
         --  Make sure that the presence of a variant part in ``Decl``/``Def``
         --  is consistent with ``Repr``.

         if VP.Is_Null then
            if Repr.Variants /= null then
               raise Type_Mismatch_Error with
                 Decl.Image & " has no variant, repinfo inconsistent";
            end if;

         else
            if Repr.Variants = null then
               raise Type_Mismatch_Error with
                 Decl.Image & " has a variant, repinfo inconsistent";

            --  Also make sure we have a single variant part in the whole
            --  extension chain.

            elsif not Variant_Part_Node.Is_Null then
               raise Type_Mismatch_Error with
                 VP.Image & " conflicts with " & Variant_Part_Node.Image;
            end if;

            Variant_Part_Node := VP;
            Variants := Repr.Variants;
         end if;
      end Process;

      Kind : Type_Kind;

   begin
      if Self = null then
         return No_Type_Representation;
      else
         if Self.Kind = Record_Type then
            Iterate_Derivations
              (Collection, Declaration, Self, Process'Access);
         end if;

         Kind := Type_Kind_For (Declaration);
         if (case Kind is
             when Record_Type => Self.Kind /= Record_Type,
             when Array_Type  => Self.Kind /= Array_Type,
             when Fixed_Type => Self.Kind /= Internal_Fixed_Type,
             when others => Self.Kind /= Other_Type)
         then
            raise Type_Mismatch_Error with
              Declaration.Image & " has unexpected type kind " & Kind'Image;
         end if;

         return (Collection,
                 Self,
                 Declaration.As_Base_Type_Decl,
                 Kind,
                 Variant_Part_Node,
                 Variants);
      end if;
   end Wrap;

   ----------
   -- Wrap --
   ----------

   function Wrap
     (Self        : Variant_Representation_Access;
      Declaration : Variant;
      Collection  : Repinfo_Collection)
      return Variant_Representation is
   begin
      if Self = null then
         return No_Variant_Representation;
      else
         return (Collection, Self, Declaration);
      end if;
   end Wrap;

   ----------
   -- Wrap --
   ----------

   function Wrap
     (Self        : Component_Representation_Access;
      Declaration : Defining_Name;
      Collection  : Repinfo_Collection)
      return Component_Representation is
   begin
      if Self = null then
         return No_Component_Representation;
      else
         return (Collection, Self, Declaration);
      end if;
   end Wrap;

   -------------------------
   -- Iterate_Derivations --
   -------------------------

   procedure Iterate_Derivations
     (Collection : Repinfo_Collection;
      Decl       : Base_Type_Decl'Class;
      Repr       : Type_Representation_Access;
      Process    : access procedure (Decl : Concrete_Type_Decl;
                                     Def  : Type_Def;
                                     Repr : Type_Representation_Access))
   is
      --  Get the full view for ``Self`` and ensure it is a record type, as
      --  well as the type that ``Repr`` describes.

      CTD : constant Concrete_Type_Decl :=
        Decl.P_Full_View.As_Concrete_Type_Decl;
      Def : constant Type_Def := CTD.F_Type_Def;
   begin
      if not CTD.P_Is_Record_Type then
         raise Type_Mismatch_Error with
           "record type expected, got " & CTD.Image;
      elsif Repr.Kind /= Record_Type then
         raise Type_Mismatch_Error with
           "record type repinfo expected, got " & Repr.Kind'Image;
      end if;

      --  If this is a derived type, first iterate on the type that is derived
      --  (the base type).

      if Def.Kind = Ada_Derived_Type_Def then
         declare
            --  Start resolving the base type

            Base_Decl_Ref : constant Subtype_Indication :=
              Def.As_Derived_Type_Def.F_Subtype_Indication;
            Base_Decl     : constant Base_Type_Decl :=
              Base_Decl_Ref.P_Designated_Type_Decl;
            Base_Repr     : Type_Representation;
         begin
            if Base_Decl.Is_Null then
               raise Type_Mismatch_Error with
                 "cannot resolve " & Base_Decl_Ref.Image;
            end if;

            --  Then look for its type representation information

            Base_Repr := Collection.Lookup (Base_Decl);
            if Is_Null (Base_Repr) then
               raise Type_Mismatch_Error with
                 "cannot find repinfo for " & Base_Decl.Image;
            end if;

            --  Continue the recursion on that base type

            Iterate_Derivations
              (Collection => Collection,
               Decl       => Base_Decl,
               Repr       => Base_Repr.Data,
               Process    => Process);
         end;
      end if;

      Process.all (CTD, Def, Repr);
   end Iterate_Derivations;

   ------------------------
   -- Get_Component_List --
   ------------------------

   function Get_Component_List (Def : Type_Def) return Component_List is
   begin
      return
        (case Def.Kind is
         when Ada_Record_Type_Def =>
            Def.As_Record_Type_Def.F_Record_Def.F_Components,
         when Ada_Derived_Type_Def =>
            Def.As_Derived_Type_Def.F_Record_Extension.F_Components,
         when others =>
            raise Program_Error);
   end Get_Component_List;

   ----------------------------
   -- Component_Associations --
   ----------------------------

   function Component_Associations
     (Collection : Repinfo_Collection;
      Decl       : Base_Type_Decl'Class;
      Repr       : Type_Representation_Access)
      return Component_Association_Vectors.Vector
   is
      Coll  : Repinfo_Collection_Data renames
        Collection.Unchecked_Get.all;

      Result : Component_Association_Vectors.Vector;

      package Symbol_Sets is new Ada.Containers.Hashed_Sets
        (Element_Type        => Symbol_Type,
         Hash                => Hash,
         Equivalent_Elements => "=");
      Artificial_Components : Symbol_Sets.Set;
      --  Set of component names for artificial components that were included
      --  in ``Result``. Unlike components that come from sources, which can be
      --  de-duplicated using the correspendance between parse trees and
      --  repinfo, artificial components are present only in repinfo: we need
      --  this set to de-duplicate them based on their names.

      function Register_Artificial
        (Repr : Component_Representation_Access) return Boolean;
      --  If ``Repr`` designates an artificial component and this is the first
      --  one we inspect with such a name, append it to ``Result``. Do nothing
      --  in all other cases.

      procedure Process
        (Decl : Concrete_Type_Decl;
         Def  : Type_Def;
         Repr : Type_Representation_Access);
      --  Process a record type declaration

      -------------------------
      -- Register_Artificial --
      -------------------------

      function Register_Artificial
        (Repr : Component_Representation_Access) return Boolean
      is
         use Symbol_Sets;
         Position : Cursor;
         Inserted : Boolean;

         --  If ``Repr`` does not designate an artificial component, do not
         --  register it.

         Name : Text_Type renames Repr.Name.all;
      begin
         if Name /= "" and then Name (Name'First) /= '_' then
            return False;
         end if;

         --  Otherwise try to register it. If there is already a component with
         --  the same name, just return False. Otherwise, register/append it
         --  and return True.

         Artificial_Components.Insert (Repr.Name, Position, Inserted);
         if Inserted then
            Result.Append ((No_Defining_Name, Repr));
         end if;
         return Inserted;
      end Register_Artificial;

      -------------
      -- Process --
      -------------

      procedure Process
        (Decl : Concrete_Type_Decl;
         Def  : Type_Def;
         Repr : Type_Representation_Access)
      is
         Comps : Component_Representation_Access_Array renames
           Repr.Components.all;

         --  Go through all discriminants/components in ``Decl`` and in
         --  ``Repr`` in parallel: their components are supposed to appear in
         --  the same order.
         --
         --  The lists in ``Decl`` are considered to be the reference (they are
         --  assumed correct) whereas the list in ``Repr`` is considered
         --  unreliably (the compiler mechanisms to produce has a very subtle
         --  behavior, and component lists may vary/be incorrect).
         --
         --  Try to find information for all components in ``Decl``, but
         --  discard entries in ``Repr`` that have no corresponding declaration
         --  *and* that are not artificial (artificial components have no
         --  declaration).

         Repr_Index : Positive := 1;
         --  Index of the next component in ``Repr`` to process

         function Next_Component_Repr
           (For_Comp : Defining_Name) return Component_Representation_Access;
         --  Return the next component representation (in ``Comps``) to process
         --  and increment ``Repr_Index``, or raise a ``Type_Mismatch_Error``
         --  exception if there is no component left.

         procedure Append (Decl : Base_Formal_Param_Decl);
         --  Append entries to ``Result`` for all defining names in ``Decl``

         -------------------------
         -- Next_Component_Repr --
         -------------------------

         function Next_Component_Repr
           (For_Comp : Defining_Name) return Component_Representation_Access is
         begin
            if Repr_Index > Comps'Last then
               raise Type_Mismatch_Error with
                 "cannot find repinfo for " & For_Comp.Image;
            end if;
            return Result : constant Component_Representation_Access :=
              Comps (Repr_Index)
            do
               Repr_Index := Repr_Index + 1;
            end return;
         end Next_Component_Repr;

         ------------
         -- Append --
         ------------

         procedure Append (Decl : Base_Formal_Param_Decl) is
         begin
            --  For each defining name in ``Decl``, look for a corresponding
            --  component representation info.

            Defining_Names : for DN of Decl.P_Defining_Names loop
               Search : loop
                  declare
                     Repr : constant Component_Representation_Access :=
                       Next_Component_Repr (DN);
                  begin
                     --  If ``Repr`` corresponds to an artificial component,
                     --  try to append it to ``Result`` and resume the search
                     --  for a repinfo for ``DN``.

                     if Register_Artificial (Repr) then
                        null;

                     --  Otherwise, skip entries until we find a match for
                     --  ``DN``.

                     elsif Symbolize (Coll, DN.Text) = Repr.Name then
                        Result.Append ((DN, Repr));
                        exit Search;
                     end if;
                  end;
               end loop Search;
            end loop Defining_Names;
         end Append;

         --  Collect discriminants, if any. Note that when there are
         --  discriminants, the full view should always have a list of known
         --  discriminants.

         DP : constant Discriminant_Part := Decl.F_Discriminants;

      begin
         if not DP.Is_Null then
            for D of DP.As_Known_Discriminant_Part.F_Discr_Specs loop
               Append (D.As_Base_Formal_Param_Decl);
            end loop;
         end if;

         --  Now collect regular components defined in ``Def`` itself

         for Comp of Get_Component_List (Def).F_Components loop
            if Comp.Kind = Ada_Component_Decl then
               Append (Comp.As_Base_Formal_Param_Decl);
            end if;
         end loop;

         --  Consume all remaining component repinfo, just in case they contain
         --  an artificial component that we have not registered yet.

         while Repr_Index in Repr.Components'Range loop
            declare
               Repr : constant Component_Representation_Access :=
                 Next_Component_Repr (No_Defining_Name);
               Dummy : constant Boolean := Register_Artificial (Repr);
            begin
               null;
            end;
         end loop;
      end Process;

   begin
      Iterate_Derivations (Collection, Decl, Repr, Process'Access);
      return Result;
   end Component_Associations;

   ----------------------
   -- Extract_Variants --
   ----------------------

   function Extract_Variants
     (Collection : Repinfo_Collection;
      Decl       : Ada_Node'Class;
      Variants   : Variant_Representation_Access_Array;
      Part_Node  : Variant_Part) return Variant_Representation_Array
   is
      List_Node : Variant_List;
   begin
      --  Make sure that the record type has a variant part, and that it has
      --  the correct number of variants.

      if Part_Node.Is_Null then
         raise Type_Mismatch_Error with
           "cannot find variant part in " & Decl.Image;
      end if;

      List_Node := Part_Node.F_Variant;
      if List_Node.Children_Count /= Variants'Length then
         raise Type_Mismatch_Error with
            Decl.Image & " has" & List_Node.Children_Count'Image
            & " variants, but" & Variants'Length'Image & " expected";
      end if;

      return Result : Variant_Representation_Array (Variants'Range) do
         for I in Result'Range loop
            Result (I) := Wrap
              (Self        => Variants (I),
               Declaration => List_Node.Child (I).As_Variant,
               Collection  => Collection);
         end loop;
      end return;
   end Extract_Variants;

   ---------------
   -- Load_JSON --
   ---------------

   function Load_JSON (Filename : String) return JSON_Value is
      use GNATCOLL.Mmap;

      File    : Mapped_File;
      Region  : Mapped_Region;
      Content : Short.Str_Access;
      Result  : Read_Result;
   begin
      --  Read the content of the file to parse through memory-mapping

      begin
         File := Open_Read (Filename);
      exception
         when Exc : Ada.IO_Exceptions.Name_Error =>
            raise Loading_Error with Exception_Message (Exc);
      end;
      Region := Read (File => File, Length => Length (File));
      Content := Short.Data (Region);

      --  Run the JSON parser, bail out on error

      Result := Read (Content.all (1 .. Short.Last (Region)));
      Free (Region);
      Close (File);
      if not Result.Success then
         raise Loading_Error with
           Filename & ": " & Format_Parsing_Error (Result.Error);
      end if;

      return Result.Value;
   end Load_JSON;

   ---------------
   -- Symbolize --
   ---------------

   function Symbolize
     (Self : in out Repinfo_Collection_Data; Name : String) return Symbol_Type
   is
   begin
      --  TODO??? This assumes that names are plain ASCII, since the encoding
      --  in JSON files created by -gnatRj seems to be arbitrary. We might have
      --  to fix this one day.

      return Symbolize (Self, To_Text (Name));
   end Symbolize;

   ---------------
   -- Symbolize --
   ---------------

   function Symbolize
     (Self : in out Repinfo_Collection_Data;
      Name : Text_Type) return Symbol_Type is
   begin
      return Find (Self.Symbols, To_Lower (Name));
   end Symbolize;

   ---------------
   -- Load_Type --
   ---------------

   function Load_Type
     (Self   : in out Repinfo_Collection_Data;
      Entity : JSON_Value;
      Name   : String) return Type_Representation_Access
   is
      function Load_Bit_Order (Field : String) return System.Bit_Order;
      --  Load a bit order attribute (``Field``) from ``Entity``

      --------------------
      -- Load_Bit_Order --
      --------------------

      function Load_Bit_Order (Field : String) return System.Bit_Order is
      begin
         if Entity.Has_Field (Field)
            and then Entity.Get (Field).Kind = JSON_String_Type
         then
            declare
               Value : constant String := Entity.Get (Field);
            begin
               if Value = "System.Low_Order_First" then
                  return System.Low_Order_First;
               elsif Value = "System.High_Order_First" then
                  return System.High_Order_First;
               end if;
            end;
         end if;

         return (raise Loading_Error with
                 Name & "/" & Field & ": invalid bit order");
      end Load_Bit_Order;

      Alignment               : Natural;
      Object_Size, Value_Size : Numerical_Expression_Access;
   begin
      --  The kind of type that is loaded is inferred from the JSON fields
      --  present, hence the heuristics below.
      --
      --  First try to load common attributes. If Alignment is missing, this is
      --  probably not an entity we are interested in.

      if not Entity.Has_Field (Key_Alignment) then
         Trace.Trace
           ("Missing mandatory attribute ("
            & Key_Alignment & "): skipping type");
         return null;
      elsif Entity.Get (Key_Alignment).Kind /= JSON_Int_Type then
         raise Loading_Error with Name & ": invalid alignment";
      end if;
      Alignment := Entity.Get (Key_Alignment);

      --  All types provide either:
      --
      --  * the Size attribute, when the Object_Size=Value_Size;
      --  * the couple Object_Size/Value_Size, when they are different;
      --  * none, when the size is unknown (for instance unconstrained array
      --    types).

      if Entity.Has_Field ("Size") then
         Object_Size := Load_Numerical_Expression
           (Self, Entity.Get (Key_Size), Name & "/" & Key_Size);
         Value_Size := Object_Size;
      elsif Entity.Has_Field ("Object_Size") then
         Object_Size := Load_Numerical_Expression
           (Self,
            Entity.Get (Key_Object_Size),
            Name & "/" & Key_Object_Size);
         Value_Size := Load_Numerical_Expression
           (Self,
            Entity.Get (Key_Value_Size),
            Name & "/" & Key_Value_Size);
      end if;

      --  Now infer the type of entity

      if Entity.Has_Field ("record") then

         --  This looks like a record type

         return Result : constant Type_Representation_Access :=
           Allocate_Record_Type (Self.Pool)
         do
            Result.Alignment := Alignment;
            Result.Object_Size := Object_Size;
            Result.Value_Size := Value_Size;
            Result.Scalar_Storage_Order :=
              Load_Bit_Order ("Scalar_Storage_Order");
            Result.Components :=
              Load_Components (Self, Entity.Get ("record"), Name);
            Result.Variants :=
              (if Entity.Has_Field ("variant")
               then Load_Variants
                      (Self, Entity.Get ("variant"), Name & "/variant")
               else null);
            Result.Bit_Order := Load_Bit_Order ("Bit_Order");

            Result.Discriminant_Count := 0;
            for C of Result.Components.all loop
               if C.Discriminant_Number > 0 then
                  Result.Discriminant_Count := Result.Discriminant_Count + 1;
               end if;
            end loop;
         end return;

      elsif Entity.Has_Field ("Component_Size") then

         --  This looks like an array type

         return Result : constant Type_Representation_Access :=
           Allocate_Array_Type (Self.Pool)
         do
            Result.Alignment := Alignment;
            Result.Object_Size := Object_Size;
            Result.Value_Size := Value_Size;
            Result.Scalar_Storage_Order :=
              Load_Bit_Order ("Scalar_Storage_Order");
            Result.Component_Size := Load_Numerical_Expression
              (Self, Entity.Get ("Component_Size"), Name & "/Component_Size");
         end return;

      elsif Entity.Has_Field ("Small") then

         --  This looks like a fixed point type

         return Result : constant Type_Representation_Access :=
           Allocate_Fixed_Type (Self.Pool)
         do
            Result.Alignment := Alignment;
            Result.Object_Size := Object_Size;
            Result.Value_Size := Value_Size;
            Result.Small :=
              Load_Rational (Self, Entity.Get ("Small"), Name & "/Small");

            if not Entity.Has_Field ("Range")
               or else Entity.Get ("Range").Kind /= JSON_Array_Type
               or else Length (JSON_Array'(Entity.Get ("Range"))) /= 2
            then
               raise Loading_Error with Name & ": invalid/missing Range";
            end if;
            declare
               Bounds_Object : constant JSON_Value := Entity.Get ("Range");
               Bounds        : constant JSON_Array := Bounds_Object.Get;
            begin
               Result.Range_First :=
                 Load_Rational (Self, Get (Bounds, 1), Name & "/Range_First");
               Result.Range_Last :=
                 Load_Rational (Self, Get (Bounds, 2), Name & "/Range_Last");
            end;
         end return;

      elsif Entity.Has_Field ("mechanism") then

         --  This entity describes a subprogram: we do not handle it

         return null;

      else
         --  Assume this entity describes a number type that is not a fixed
         --  point type.

         return Result : constant Type_Representation_Access :=
           Allocate_Other_Type (Self.Pool)
         do
            Result.Alignment := Alignment;
            Result.Object_Size := Object_Size;
            Result.Value_Size := Value_Size;
         end return;
      end if;
   end Load_Type;

   ---------------------
   -- Load_Components --
   ---------------------

   function Load_Components
     (Self       : in out Repinfo_Collection_Data;
      Components : JSON_Value;
      Context    : String) return Component_Representation_Access_Array_Access
   is
      package Component_Vectors is new Langkit_Support.Vectors
        (Component_Representation_Access);

      Result    : Component_Vectors.Vector;
      Comp_Repr : Component_Representation_Access;
   begin
      if Components.Kind /= JSON_Array_Type then
         raise Loading_Error with Context & ": invalid list of components";
      end if;

      for Comp of JSON_Array'(Components.Get) loop

         --  Try to get the name of this component

         if Comp.Kind /= JSON_Object_Type
            or else not Comp.Has_Field ("name")
            or else Comp.Get ("name").Kind /= JSON_String_Type
         then
            raise Loading_Error with Context & ": invalid component";
         end if;

         declare
            Name       : constant String := Comp.Get ("name");
            Key        : constant Symbol_Type := Symbolize (Self, Name);
            Subcontext : constant String := Context & "/" & Name;
         begin
            Comp_Repr := Allocate_Component_Representation (Self.Pool);
            Comp_Repr.Name := Key;

            --  Load mandatory fields

            if not Comp.Has_Field ("Position")
               or else not Comp.Has_Field ("First_Bit")
               or else Comp.Get ("First_Bit").Kind /= JSON_Int_Type
               or else not Comp.Has_Field ("Size")
            then
               raise Loading_Error with
                 Subcontext & ": missing/invalid attributes";
            end if;

            Comp_Repr.Position := Load_Numerical_Expression
              (Self, Comp.Get ("Position"), Subcontext & "/Position");
            Comp_Repr.First_Bit := Comp.Get ("First_Bit");
            Comp_Repr.Size := Load_Numerical_Expression
              (Self, Comp.Get ("Size"), Subcontext & "/Size");

            --  Import discriminant information

            if Comp.Has_Field ("discriminant") then
               if Comp.Get ("discriminant").Kind /= JSON_Int_Type then
                  raise Loading_Error with
                    Subcontext & ": invalid ""discriminant"" attribute";
               end if;
               Comp_Repr.Discriminant_Number := Comp.Get ("discriminant");

            else
               Comp_Repr.Discriminant_Number := 0;
            end if;

            Result.Append (Comp_Repr);
         end;
      end loop;

      --  Turn the ``Result`` vector into the array access we need to return,
      --  then free resources for it.

      return R : constant Component_Representation_Access_Array_Access :=
        new Component_Representation_Access_Array (1 .. Result.Last_Index)
      do
         Self.Component_Repinfo_Arrays.Append (R);
         for I in R.all'Range loop
            R.all (I) := Result.Get (I);
         end loop;
         Result.Destroy;
      end return;

   exception
      when others =>
         Result.Destroy;
         raise;
   end Load_Components;

   -------------------
   -- Load_Variants --
   -------------------

   function Load_Variants
     (Self     : in out Repinfo_Collection_Data;
      Variants : JSON_Value;
      Context  : String) return Variant_Representation_Access_Array_Access
   is
      package Variant_Vectors is new Langkit_Support.Vectors
        (Variant_Representation_Access);

      Result       : Variant_Vectors.Vector;
      Variant_Repr : Variant_Representation_Access;
   begin
      if Variants.Kind /= JSON_Array_Type then
         raise Loading_Error with Context & ": invalid list of variants";
      end if;

      for Variant of JSON_Array'(Variants.Get) loop

         --  All variants have a "present" expression and a "record" array

         if Variant.Kind /= JSON_Object_Type
            or else not Variant.Has_Field ("present")
            or else not Variant.Has_Field ("record")
         then
            raise Loading_Error with Context & ": invalid variant";
         end if;

         Variant_Repr := Allocate_Variant_Representation (Self.Pool);
         Variant_Repr.Present := Load_Numerical_Expression
           (Self, Variant.Get ("present"), Context & "/variant");
         Variant_Repr.Components :=
           Load_Components (Self, Variant.Get ("record"), Context & "/record");

         --  Load the sub-variant part, if present

         Variant_Repr.Subvariants :=
           (if Variant.Has_Field ("variant")
            then Load_Variants
                   (Self, Variant.Get ("variant"), Context & "/variant")
            else null);

         Result.Append (Variant_Repr);
      end loop;

      --  Turn the ``Result`` vector into the array access we need to return,
      --  then free resources for it.

      return R : constant Variant_Representation_Access_Array_Access :=
        new Variant_Representation_Access_Array (1 .. Result.Last_Index)
      do
         Self.Variant_Repinfo_Arrays.Append (R);
         for I in R.all'Range loop
            R.all (I) := Result.Get (I);
         end loop;
         Result.Destroy;
      end return;

   exception
      when others =>
         Result.Destroy;
         raise;
   end Load_Variants;

   -------------------------------
   -- Load_Numerical_Expression --
   -------------------------------

   function Load_Numerical_Expression
     (Self       : in out Repinfo_Collection_Data;
      Expression : JSON_Value;
      Context    : String) return Numerical_Expression_Access
   is
      Discriminant_Count : Natural := 0;
      --  Highest index for required discriminants

      procedure Error with No_Return;
      --  Raise a ``Loading_Error`` because the expression to load is invalid

      function Load_Expr (Subexpr : JSON_Value) return Expr_Node_Access;
      --  Convert the given numerical subexpression into our internal
      --  representation for it.

      -----------
      -- Error --
      -----------

      procedure Error is
      begin
         raise Loading_Error with Context & ": invalid expression";
      end Error;

      ---------------
      -- Load_Expr --
      ---------------

      function Load_Expr (Subexpr : JSON_Value) return Expr_Node_Access is
         Result_Access : constant Expr_Node_Access :=
           Allocate_Expr_Node (Self.Pool);
         Result        : Expr_Node_Data
         with Import, Address => Result_Access.all'Address;
      begin
         case Subexpr.Kind is
            when JSON_Int_Type =>
               declare
                  Value : constant Long_Long_Integer := Subexpr.Get;
               begin
                  Result :=
                    (Code => Literal, Value => Allocate_Integer (Self));

                  --  The largest value for Value (``Value'Last``) may be too
                  --  large to be passed as a scalar to any of the
                  --  ``GNATCOLL.GMP.Integers.Set`` overloads. Go through its
                  --  image to avoid range check failures.

                  Result.Value.Set (Value'Image);
               end;

            when JSON_Object_Type =>

               --  This subexpression is an operation: sanitize it and import
               --  it.

               if not Subexpr.Has_Field ("code")
                  or else Subexpr.Get ("code").Kind /= JSON_String_Type
                  or else not Subexpr.Has_Field ("operands")
                  or else Subexpr.Get ("operands").Kind /= JSON_Array_Type
               then
                  Error;
               end if;

               declare
                  Code : constant String := Subexpr.Get ("code");
                  Op   : Opcode_1;

                  JSON_Ops : constant JSON_Array := Subexpr.Get ("operands");
                  Operands : array (1 .. Length (JSON_Ops))
                             of Expr_Node_Access;
               begin
                  --  First, process special opcodes

                  if Code = "var" then

                     --  "Dynamic_Val" is a placeholder for "unsupported"

                     return null;

                  elsif Code = "#" then

                     --  This is the "get discriminant value" opcode. Decode it
                     --  fully and keep track of the highest discriminant
                     --  number.

                     if Length (JSON_Ops) /= 1
                        or else Get (JSON_Ops, 1).Kind /= JSON_Int_Type
                     then
                        Error;
                     end if;
                     Result :=
                       (Code                => Discrim_Val,
                        Discriminant_Number => Get (JSON_Ops, 1).Get);
                     Discriminant_Count := Natural'Max
                       (Discriminant_Count, Result.Discriminant_Number);
                     return Result_Access;
                  end if;

                  --  Decode all operands. If one of them is unsupported the
                  --  whole expression is unsupported.

                  for I in Operands'Range loop
                     Operands (I) := Load_Expr (Get (JSON_Ops, I));
                     if Operands (I) = null then
                        return null;
                     end if;
                  end loop;

                  if Code = "?<>" then
                     Op := Cond_Expr;
                  elsif Code = "+" then
                     Op := Plus_Expr;
                  elsif Code = "-" then
                     Op := (if Operands'Length = 1
                            then Negate_Expr
                            else Minus_Expr);
                  elsif Code = "*" then
                     Op := Mult_Expr;
                  elsif Code = "/t" then
                     Op := Trunc_Div_Expr;
                  elsif Code = "/c" then
                     Op := Ceil_Div_Expr;
                  elsif Code = "/f" then
                     Op := Floor_Div_Expr;
                  elsif Code = "modt" then
                     Op := Trunc_Mod_Expr;
                  elsif Code = "modc" then
                     Op := Ceil_Mod_Expr;
                  elsif Code = "modf" then
                     Op := Floor_Mod_Expr;
                  elsif Code = "/e" then
                     Op := Exact_Div_Expr;
                  elsif Code = "min" then
                     Op := Min_Expr;
                  elsif Code = "max" then
                     Op := Max_Expr;
                  elsif Code = "abs" then
                     Op := Abs_Expr;
                  elsif Code = "and" then
                     Op := Truth_And_Expr;
                  elsif Code = "or" then
                     Op := Truth_Or_Expr;
                  elsif Code = "xor" then
                     Op := Truth_Xor_Expr;
                  elsif Code = "not" then
                     Op := Truth_Not_Expr;
                  elsif Code = "<" then
                     Op := Lt_Expr;
                  elsif Code = "<=" then
                     Op := Le_Expr;
                  elsif Code = ">" then
                     Op := Gt_Expr;
                  elsif Code = ">=" then
                     Op := Ge_Expr;
                  elsif Code = "==" then
                     Op := Eq_Expr;
                  elsif Code = "!=" then
                     Op := Ne_Expr;
                  elsif Code = "&" then
                     Op := Bit_And_Expr;
                  else
                     Error;
                  end if;

                  --  Finally, check that we have the correct number of
                  --  operands.

                  declare
                     Result_Template   : Expr_Node_Data (Op);
                     Expected_Op_Count : constant Positive :=
                       (if Op in Opcode_3 then 3
                        elsif Op in Opcode_2 then 2
                        else 1);
                  begin
                     if Operands'Length /= Expected_Op_Count then
                        Error;
                     end if;

                     Result_Template.Op_1 := Operands (1);
                     if Op in Opcode_2 then
                        Result_Template.Op_2 := Operands (2);
                        if Op in Opcode_3 then
                           Result_Template.Op_3 := Operands (3);
                        end if;
                     end if;

                     Result := Result_Template;
                  end;
               end;

            when JSON_String_Type =>
               if String'(Subexpr.Get) = "??" then
                  return null;
               else
                  Error;
               end if;

            when others =>
               Error;
         end case;

         return Result_Access;
      end Load_Expr;

      Root : constant Expr_Node_Access := Load_Expr (Expression);
   begin
      if Root = null then
         return null;
      end if;

      return Result : constant Numerical_Expression_Access :=
        Allocate_Numerical_Expression (Self.Pool)
      do
         Result.Discriminant_Count := Discriminant_Count;
         Result.Root := Root;
      end return;
   end Load_Numerical_Expression;

   -------------------
   -- Load_Rational --
   -------------------

   function Load_Rational
     (Self       : in out Repinfo_Collection_Data;
      Expression : JSON_Value;
      Context    : String) return Rational_Access
   is
      procedure Set (Result : in out GMP_RN.Rational; Value : JSON_Value);
      --  Set ``Result`` to the given JSON decimal value

      procedure Error with No_Return;
      --  Raise a ``Loading_Error`` because the expression to load is invalid

      ---------
      -- Set --
      ---------

      procedure Set (Result : in out GMP_RN.Rational; Value : JSON_Value) is
      begin
         Result.Set (GNATCOLL.GMP.Double (Value.Get_Long_Float));
      end Set;

      -----------
      -- Error --
      -----------

      procedure Error is
      begin
         raise Loading_Error with Context & ": invalid expression";
      end Error;

   begin
      --  Rational numbers are encoded in two forms..

      case Expression.Kind is
         when JSON_Float_Type =>

            --  A straight float number in the JSON

            return Result : constant Rational_Access :=
              Allocate_Rational (Self)
            do
               Set (Result.all, Expression);
            end return;

         when JSON_Object_Type =>

            --  A simple expression: {"cond": "/", operands: [X, Y]}

            if not Expression.Has_Field ("code")
               or else Expression.Get ("code").Kind /= JSON_String_Type
               or else String'(Expression.Get ("code")) /= "/"
               or else not Expression.Has_Field ("operands")
               or else Expression.Get ("operands").Kind /= JSON_Array_Type
            then
               Error;
            end if;

            declare
               Operands : constant JSON_Array := Expression.Get ("operands");
               Num, Den : GMP_RN.Rational;
            begin
               if Length (Operands) /= 2
                  or else Get (Operands, 1).Kind /= JSON_Float_Type
                  or else Get (Operands, 2).Kind /= JSON_Float_Type
               then
                  Error;
               end if;

               Set (Num, Get (Operands, 1));
               Set (Den, Get (Operands, 2));

               return Result : constant Rational_Access :=
                 Allocate_Rational (Self)
               do
                  Result.Set (GMP_RN."/" (Num, Den));
               end return;
            end;

         when others =>
            Error;
      end case;
   end Load_Rational;

   ----------------------
   -- Allocate_Integer --
   ----------------------

   function Allocate_Integer
     (Self : in out Repinfo_Collection_Data) return Integer_Access
   is
   begin
      return Result : constant Integer_Access := new GMP_Int.Big_Integer do
         Self.Integers.Append (Result);
      end return;
   end Allocate_Integer;

   -----------------------
   -- Allocate_Rational --
   -----------------------

   function Allocate_Rational
     (Self : in out Repinfo_Collection_Data) return Rational_Access is
   begin
      return Result : constant Rational_Access := new GMP_RN.Rational do
         Self.Rationals.Append (Result);
      end return;
   end Allocate_Rational;

   --------------------------
   -- Allocate_Record_Type --
   --------------------------

   function Allocate_Record_Type
     (Pool : Bump_Ptr_Pool) return Type_Representation_Access
   is
      Result : constant Record_Type_Access :=
        Record_Type_Allocator.Alloc (Pool);
      Kind   : Internal_Type_Kind with Import, Address => Result.Kind'Address;
   begin
      Kind := Record_Type;
      return Type_Representation_Access (Result);
   end Allocate_Record_Type;

   -------------------------
   -- Allocate_Array_Type --
   -------------------------

   function Allocate_Array_Type
     (Pool : Bump_Ptr_Pool) return Type_Representation_Access
   is
      Result : constant Array_Type_Access := Array_Type_Allocator.Alloc (Pool);
      Kind   : Internal_Type_Kind with Import, Address => Result.Kind'Address;
   begin
      Kind := Array_Type;
      return Type_Representation_Access (Result);
   end Allocate_Array_Type;

   -------------------------
   -- Allocate_Fixed_Type --
   -------------------------

   function Allocate_Fixed_Type
     (Pool : Bump_Ptr_Pool) return Type_Representation_Access
   is
      Result : constant Fixed_Type_Access := Fixed_Type_Allocator.Alloc (Pool);
      Kind   : Internal_Type_Kind with Import, Address => Result.Kind'Address;
   begin
      Kind := Internal_Fixed_Type;
      return Type_Representation_Access (Result);
   end Allocate_Fixed_Type;

   -------------------------
   -- Allocate_Other_Type --
   -------------------------

   function Allocate_Other_Type
     (Pool : Bump_Ptr_Pool) return Type_Representation_Access
   is
      Result : constant Other_Type_Access := Other_Type_Allocator.Alloc (Pool);
      Kind   : Internal_Type_Kind with Import, Address => Result.Kind'Address;
   begin
      Kind := Other_Type;
      return Type_Representation_Access (Result);
   end Allocate_Other_Type;

   ------------------------
   -- Allocate_Expr_Node --
   ------------------------

   function Allocate_Expr_Node (Pool : Bump_Ptr_Pool) return Expr_Node_Access
   is
      Wrapper : constant Expr_Node_Wrapper_Access :=
        Expr_Node_Allocator.Alloc (Pool);
   begin
      return Wrapper.Data'Access;
   end Allocate_Expr_Node;

   -------------
   -- Is_Null --
   -------------

   function Is_Null (Self : Numerical_Expression) return Boolean is
   begin
      return Self.Data = null;
   end Is_Null;

   -------------
   -- Is_Null --
   -------------

   function Is_Null (Self : Type_Representation) return Boolean is
   begin
      return Self.Data = null;
   end Is_Null;

   -------------
   -- Is_Null --
   -------------

   function Is_Null (Self : Component_Representation) return Boolean is
   begin
      return Self.Data = null;
   end Is_Null;

   -------------
   -- Is_Null --
   -------------

   function Is_Null (Self : Variant_Representation) return Boolean is
   begin
      return Self.Data = null;
   end Is_Null;

   ----------
   -- Kind --
   ----------

   function Kind (Self : Type_Representation) return Type_Kind is
   begin
      return Self.Kind;
   end Kind;

   ---------------
   -- Alignment --
   ---------------

   function Alignment (Self : Type_Representation) return Positive is
   begin
      return Self.Data.Alignment;
   end Alignment;

   --------------------------
   -- Scalar_Storage_Order --
   --------------------------

   function Scalar_Storage_Order
     (Self : Type_Representation) return System.Bit_Order is
   begin
      return Self.Data.Scalar_Storage_Order;
   end Scalar_Storage_Order;

   -----------------
   -- Object_Size --
   -----------------

   function Object_Size
     (Self : Type_Representation) return Numerical_Expression is
   begin
      return Wrap (Self.Data.Object_Size, Self.Collection);
   end Object_Size;

   ----------------
   -- Value_Size --
   ----------------

   function Value_Size
     (Self : Type_Representation) return Numerical_Expression
   is
   begin
      return Wrap (Self.Data.Value_Size, Self.Collection);
   end Value_Size;

   ----------------
   -- Components --
   ----------------

   function Components
     (Self : Type_Representation) return Component_Representation_Array
   is
      Assocs : constant Component_Association_Vectors.Vector :=
        Component_Associations (Self.Collection, Self.Declaration, Self.Data);
   begin
      return Result : Component_Representation_Array
                        (1 .. Natural (Assocs.Length))
      do
         for I in Result'Range loop
            declare
               A : Component_Association renames Assocs.Constant_Reference (I);
            begin
               Result (I) := Wrap (A.Repr, A.Decl, Self.Collection);
            end;
         end loop;
      end return;
   end Components;

   -------------------
   -- Discriminants --
   -------------------

   function Discriminants
     (Self : Type_Representation) return Component_Representation_Array
   is
      Comps : constant Component_Representation_Array := Components (Self);
      DN    : Natural;
   begin
      return Result : Component_Representation_Array
                        (1 .. Self.Data.Discriminant_Count)
      do
         for C of Comps loop
            DN := Discriminant_Number (C);
            if DN > 0 then
               Result (DN) := C;
            end if;
         end loop;
      end return;
   end Discriminants;

   ----------------------
   -- Has_Variant_Part --
   ----------------------

   function Has_Variant_Part (Self : Type_Representation) return Boolean is
   begin
      return Self.Variants /= null;
   end Has_Variant_Part;

   --------------
   -- Variants --
   --------------

   function Variants
     (Self : Type_Representation) return Variant_Representation_Array is
   begin
      return Extract_Variants
        (Collection => Self.Collection,
         Decl       => Self.Declaration,
         Variants   => Self.Variants.all,
         Part_Node  => Self.Variant_Part_Node);
   end Variants;

   ---------------
   -- Bit_Order --
   ---------------

   function Bit_Order (Self : Type_Representation) return System.Bit_Order is
   begin
      return Self.Data.Bit_Order;
   end Bit_Order;

   -------------
   -- Present --
   -------------

   function Present
     (Self : Variant_Representation) return Numerical_Expression is
   begin
      return Wrap (Self.Data.Present, Self.Collection);
   end Present;

   ----------------
   -- Components --
   ----------------

   function Components
     (Self : Variant_Representation) return Component_Representation_Array
   is
      Comps      : Component_Representation_Access_Array renames
        Self.Data.Components.all;
      Comp_Decls : Defining_Name_Vectors.Vector;
   begin
      --  Compute the list of defining names for all components in this
      --  variant. Raise an error if the count is not right.

      for Comp of Self.Declaration.F_Components.F_Components loop
         if Comp.Kind = Ada_Component_Decl then
            for DN of Comp.As_Component_Decl.P_Defining_Names loop
               Comp_Decls.Append (DN);
            end loop;
         end if;
      end loop;
      if Comps'Length /= Natural (Comp_Decls.Length) then
         raise Type_Mismatch_Error with
           Self.Declaration.Image & " has" & Comp_Decls.Length'Image
           & " components, but" & Comps'Length'Image & " expected";
      end if;

      return Result : Component_Representation_Array (Comps'Range) do
         for I in Result'Range loop
            Result (I) := Wrap
              (Self        => Comps (I),
               Declaration => Comp_Decls.Element (I),
               Collection  => Self.Collection);
         end loop;
      end return;
   end Components;

   --------------------
   -- Has_Subvariant --
   --------------------

   function Has_Subvariant_Part (Self : Variant_Representation) return Boolean
   is
   begin
      return Self.Data.Subvariants /= null;
   end Has_Subvariant_Part;

   -----------------
   -- Subvariants --
   -----------------

   function Subvariants
     (Self : Variant_Representation) return Variant_Representation_Array is
   begin
      return Extract_Variants
        (Collection => Self.Collection,
         Decl       => Self.Declaration,
         Variants   => Self.Data.Subvariants.all,
         Part_Node  => Self.Declaration.F_Components.F_Variant_Part);
   end Subvariants;

   -----------------
   -- Declaration --
   -----------------

   function Declaration
     (Self : Component_Representation) return Defining_Name is
   begin
      return Self.Declaration;
   end Declaration;

   --------------------
   -- Component_Name --
   --------------------

   function Component_Name (Self : Component_Representation) return Text_Type
   is
   begin
      return Self.Data.Name.all;
   end Component_Name;

   -------------------------
   -- Discriminant_Number --
   -------------------------

   function Discriminant_Number
     (Self : Component_Representation) return Natural is
   begin
      return Self.Data.Discriminant_Number;
   end Discriminant_Number;

   --------------
   -- Position --
   --------------

   function Position
     (Self : Component_Representation) return Numerical_Expression is
   begin
      return Wrap (Self.Data.Position, Self.Collection);
   end Position;

   ---------------
   -- First_Bit --
   ---------------

   function First_Bit (Self : Component_Representation) return Natural is
   begin
      return Self.Data.First_Bit;
   end First_Bit;

   ----------
   -- Size --
   ----------

   function Size (Self : Component_Representation) return Numerical_Expression
   is
   begin
      return Wrap (Self.Data.Size, Self.Collection);
   end Size;

   --------------------
   -- Component_Size --
   --------------------

   function Component_Size
     (Self : Type_Representation) return Numerical_Expression is
   begin
      return Wrap (Self.Data.Component_Size, Self.Collection);
   end Component_Size;

   -----------
   -- Small --
   -----------

   function Small (Self : Type_Representation) return GMP_RN.Rational is
   begin
      return Result : GMP_RN.Rational do
         Result.Set (Self.Data.Small.all);
      end return;
   end Small;

   -----------------
   -- Range_First --
   -----------------

   function Range_First (Self : Type_Representation) return GMP_RN.Rational is
   begin
      return Result : GMP_RN.Rational do
         Result.Set (Self.Data.Range_First.all);
      end return;
   end Range_First;

   ----------------
   -- Range_Last --
   ----------------

   function Range_Last (Self : Type_Representation) return GMP_RN.Rational is
   begin
      return Result : GMP_RN.Rational do
         Result.Set (Self.Data.Range_Last.all);
      end return;
   end Range_Last;

   ------------------------
   -- Discriminant_Count --
   ------------------------

   function Discriminant_Count (Self : Numerical_Expression) return Natural is
   begin
      return Self.Data.Discriminant_Count;
   end Discriminant_Count;

   ------------------------
   -- Discriminant_Value --
   ------------------------

   function Discriminant_Value
     (Result : Eval_Result) return GMP_Int.Big_Integer is
   begin
      case Result.Kind is
         when Enum_Lit =>
            return Result.Enum_Result.P_Enum_Rep;

         when Int =>
            return Value : GMP_Int.Big_Integer do
               Value.Set (Result.Int_Result);
            end return;

         when others =>
            raise Invalid_Discriminant;
      end case;
   end Discriminant_Value;

   ---------------
   -- Dump_Expr --
   ---------------

   procedure Dump_Expr (Node : Expr_Node_Access) is

      --  Operator associativity: higher priority number means higher
      --  associativity: we needs parens around an operand when its priority is
      --  lower than its embedding expression's.
      --
      --  * Cond_Expr: lowest priority (1)
      --  * Logic binary operators (and then, or else, xor): 2
      --  * Relational operators (<, <=, ...): 3
      --  * Addition, substraction: 4
      --  * Multiplications, divisions, remainders: 5
      --  * Bitwise operators (and, or): 6
      --  * Unary operators (not, abs, -), discriminants and literals: 7
      --
      --  Min and max have special treatment since they already contain parens:
      --  we never need extra parens to disambiguate.

      Priorities : constant array (Opcode) of Natural :=
        (Cond_Expr      => 1,

         Plus_Expr      => 4,
         Minus_Expr     => 4,

         Mult_Expr      => 5,
         Trunc_Div_Expr => 5,
         Ceil_Div_Expr  => 5,
         Floor_Div_Expr => 5,
         Trunc_Mod_Expr => 5,
         Ceil_Mod_Expr  => 5,
         Floor_Mod_Expr => 5,
         Exact_Div_Expr => 5,

         Min_Expr       => 0,
         Max_Expr       => 0,

         Truth_And_Expr => 1,
         Truth_Or_Expr  => 1,
         Truth_Xor_Expr => 1,

         Lt_Expr        => 3,
         Le_Expr        => 3,
         Gt_Expr        => 3,
         Ge_Expr        => 3,
         Eq_Expr        => 3,
         Ne_Expr        => 3,

         Bit_And_Expr   => 6,
         Negate_Expr    => 7,
         Abs_Expr       => 7,
         Truth_Not_Expr => 7,
         Discrim_Val    => 7,
         Literal        => 7);

      procedure Dump (Node : Expr_Node_Access; Outer_Priority : Natural);
      --  Dump the ``Node`` subexpression. ``Outer_Priority`` is the priority
      --  of the parent expression: it is used to determine if parens are
      --  needed around this subexpression.

      ----------
      -- Dump --
      ----------

      procedure Dump (Node : Expr_Node_Access; Outer_Priority : Natural) is
         Inner_Priority : constant Natural := Priorities (Node.Code);
         Parens_Needed : constant Boolean := Inner_Priority < Outer_Priority;

         procedure D
           (Node           : Expr_Node_Access;
            Outer_Priority : Natural := Inner_Priority);
         --  Shortcut for ``Dump (Node, Inner_Priority)``

         -------
         -- D --
         -------

         procedure D
           (Node           : Expr_Node_Access;
            Outer_Priority : Natural := Inner_Priority) is
         begin
            Dump (Node, Outer_Priority);
         end D;
      begin
         if Parens_Needed then
            Put ("(");
         end if;
         case Node.Code is
            when Cond_Expr =>
               --  To help readability, force the use of parens if operands are
               --  Cond_Expr themselves.

               Put ("if ");
               D (Node.Op_1, 2);
               Put (" then ");
               D (Node.Op_2, 2);
               Put (" else ");
               D (Node.Op_3);
            when Plus_Expr =>
               D (Node.Op_1);
               Put (" + ");
               D (Node.Op_2);
            when Minus_Expr =>
               D (Node.Op_1);
               Put (" - ");
               D (Node.Op_2);
            when Mult_Expr =>
               D (Node.Op_1);
               Put (" * ");
               D (Node.Op_2);
            when Trunc_Div_Expr =>
               D (Node.Op_1);
               Put (" /t ");
               D (Node.Op_2);
            when Ceil_Div_Expr =>
               D (Node.Op_1);
               Put (" /c ");
               D (Node.Op_2);
            when Floor_Div_Expr =>
               D (Node.Op_1);
               Put (" /f ");
               D (Node.Op_2);
            when Trunc_Mod_Expr =>
               D (Node.Op_1);
               Put (" modt ");
               D (Node.Op_2);
            when Ceil_Mod_Expr =>
               D (Node.Op_1);
               Put (" modc ");
               D (Node.Op_2);
            when Floor_Mod_Expr =>
               D (Node.Op_1);
               Put (" modf ");
               D (Node.Op_2);
            when Exact_Div_Expr =>
               D (Node.Op_1);
               Put (" /e ");
               D (Node.Op_2);
            when Min_Expr =>
               Put ("min(");
               D (Node.Op_1, 0);
               Put (", ");
               D (Node.Op_2, 0);
               Put (")");
            when Max_Expr =>
               Put ("max(");
               D (Node.Op_1);
               Put (", ");
               D (Node.Op_2);
               Put (")");
            when Truth_And_Expr =>
               D (Node.Op_1);
               Put (" and then ");
               D (Node.Op_2);
            when Truth_Or_Expr =>
               D (Node.Op_1);
               Put (" or else ");
               D (Node.Op_2);
            when Truth_Xor_Expr =>
               D (Node.Op_1);
               Put (" xor ");
               D (Node.Op_2);
            when Lt_Expr =>
               D (Node.Op_1);
               Put (" < ");
               D (Node.Op_2);
            when Le_Expr =>
               D (Node.Op_1);
               Put (" <= ");
               D (Node.Op_2);
            when Gt_Expr =>
               D (Node.Op_1);
               Put (" > ");
               D (Node.Op_2);
            when Ge_Expr =>
               D (Node.Op_1);
               Put (" >= ");
               D (Node.Op_2);
            when Eq_Expr =>
               D (Node.Op_1);
               Put (" = ");
               D (Node.Op_2);
            when Ne_Expr =>
               D (Node.Op_1);
               Put (" /= ");
               D (Node.Op_2);
            when Bit_And_Expr =>
               D (Node.Op_1);
               Put (" and ");
               D (Node.Op_2);
            when Negate_Expr =>
               Put ("-");
               D (Node.Op_1);
            when Abs_Expr =>
               Put ("abs ");
               D (Node.Op_1);
            when Truth_Not_Expr =>
               Put ("not ");
               D (Node.Op_1);
            when Discrim_Val =>
               declare
                  Disc : constant String := Node.Discriminant_Number'Image;
               begin
                  Put ("#" & Disc (Disc'First + 1 .. Disc'Last));
               end;
            when Literal =>
               Put (Node.Value.Image);
         end case;
         if Parens_Needed then
            Put (")");
         end if;
      end Dump;

   begin
      Dump (Node, 0);
      New_Line;
   end Dump_Expr;

   --------------
   -- Evaluate --
   --------------

   function Evaluate
     (Self          : Numerical_Expression;
      Discriminants : Discriminant_Values) return GMP_Int.Big_Integer
   is
      use type GMP_Int.Big_Integer;

      function "+" (Self : GMP_Int.Big_Integer) return GMP_Int.Big_Integer;
      --  Create a copy of ``Self``

      function Eval (Node : Expr_Node_Access) return GMP_Int.Big_Integer;
      --  Evaluate the ``Node`` subexpression

      function Eval_As_Bool (Node : Expr_Node_Access) return Boolean;
      --  Likewise, but convert the result to a boolean (zero is False,
      --  everything else is True).

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

      function "+" (Self : GMP_Int.Big_Integer) return GMP_Int.Big_Integer is
      begin
         return Result : GMP_Int.Big_Integer do
            Result.Set (Self);
         end return;
      end "+";

      ----------
      -- Eval --
      ----------

      function Eval (Node : Expr_Node_Access) return GMP_Int.Big_Integer is
      begin
         case Node.Code is
            when Cond_Expr =>
               declare
                  Cond : constant GMP_Int.Big_Integer := Eval (Node.Op_1);
               begin
                  return (if Cond = Zero
                          then Eval (Node.Op_3)
                          else Eval (Node.Op_2));
               end;

            when Plus_Expr =>
               return Eval (Node.Op_1) + Eval (Node.Op_2);
            when Minus_Expr =>
               return Eval (Node.Op_1) - Eval (Node.Op_2);
            when Mult_Expr =>
               return Eval (Node.Op_1) * Eval (Node.Op_2);

            when Trunc_Div_Expr =>
               return GMP_Int.Truncate_Divide
                 (Eval (Node.Op_1), Eval (Node.Op_2));
            when Ceil_Div_Expr =>
               return GMP_Int.Ceil_Divide
                 (Eval (Node.Op_1), Eval (Node.Op_2));
            when Floor_Div_Expr =>
               return GMP_Int.Floor_Divide
                 (Eval (Node.Op_1), Eval (Node.Op_2));

            when Trunc_Mod_Expr =>
               return GMP_Int.Truncate_Remainder
                 (Eval (Node.Op_1), Eval (Node.Op_2));
            when Floor_Mod_Expr =>
               return GMP_Int.Floor_Remainder
                 (Eval (Node.Op_1), Eval (Node.Op_2));
            when Ceil_Mod_Expr =>
               return GMP_Int.Ceil_Remainder
                 (Eval (Node.Op_1), Eval (Node.Op_2));

            when Exact_Div_Expr =>
               return Eval (Node.Op_1) / Eval (Node.Op_2);

            when Min_Expr =>
               declare
                  L : constant GMP_Int.Big_Integer := Eval (Node.Op_1);
                  R : constant GMP_Int.Big_Integer := Eval (Node.Op_2);
               begin
                  return (if L < R then +L else +R);
               end;
            when Max_Expr =>
               declare
                  L : constant GMP_Int.Big_Integer := Eval (Node.Op_1);
                  R : constant GMP_Int.Big_Integer := Eval (Node.Op_2);
               begin
                  return (if L < R then +R else +L);
               end;

            when Truth_And_Expr =>
               return (if Eval_As_Bool (Node.Op_1)
                          and then Eval_As_Bool (Node.Op_2)
                       then +One
                       else +Zero);
            when Truth_Or_Expr =>
               return (if Eval_As_Bool (Node.Op_1)
                          or else Eval_As_Bool (Node.Op_2)
                       then +One
                       else +Zero);
            when Truth_Xor_Expr =>
               return (if Eval_As_Bool (Node.Op_1) /= Eval_As_Bool (Node.Op_2)
                       then +One
                       else +Zero);

            when Lt_Expr =>
               return (if Eval (Node.Op_1) < Eval (Node.Op_2)
                       then +One
                       else +Zero);
            when Le_Expr =>
               return (if Eval (Node.Op_1) <= Eval (Node.Op_2)
                       then +One
                       else +Zero);
            when Gt_Expr =>
               return (if Eval (Node.Op_1) > Eval (Node.Op_2)
                       then +One
                       else +Zero);
            when Ge_Expr =>
               return (if Eval (Node.Op_1) >= Eval (Node.Op_2)
                       then +One
                       else +Zero);
            when Eq_Expr =>
               return (if Eval (Node.Op_1) = Eval (Node.Op_2)
                       then +One
                       else +Zero);
            when Ne_Expr =>
               return (if Eval (Node.Op_1) /= Eval (Node.Op_2)
                       then +One
                       else +Zero);

            when Bit_And_Expr =>
               return Eval (Node.Op_1) and Eval (Node.Op_2);

            when Negate_Expr =>
               return -Eval (Node.Op_1);

            when Abs_Expr =>
               return abs Eval (Node.Op_1);
            when Truth_Not_Expr =>
               return (if Eval_As_Bool (Node.Op_1) then +Zero else +One);
            when Discrim_Val =>
               return Result : GMP_Int.Big_Integer do
                  Result.Set (Discriminants (Node.Discriminant_Number));
               end return;
            when Literal =>
               return +Node.Value.all;
         end case;
      end Eval;

      ------------------
      -- Eval_As_Bool --
      ------------------

      function Eval_As_Bool (Node : Expr_Node_Access) return Boolean is
      begin
         return Eval (Node) /= Zero;
      end Eval_As_Bool;

   begin
      return Eval (Self.Data.Root);
   end Evaluate;

   ---------------------
   -- Resolved_Record --
   ---------------------

   function Resolved_Record
     (Self          : Type_Representation;
      Discriminants : Discriminant_Values) return Resolved_Record_Type
   is
      package Resolved_Component_Vectors is new Ada.Containers.Vectors
        (Positive, Resolved_Component);
      use Resolved_Component_Vectors;

      Comps : Vector;

      procedure Append (C : Component_Representation);
      --  Resolve ``C`` and add the result to ``Comps``

      procedure Process_Variant_Part (Variants : Variant_Representation_Array);
      --  Call ``Append`` on all components of the variant in ``Variants`` that
      --  is active according to ``Discriminants``.

      function Evaluate (Expr : Numerical_Expression) return Size_Type;
      --  Shortcut to evaluate an expression using ``Discriminants`` and to
      --  return the result as a ``Size_Type``.

      ------------
      -- Append --
      ------------

      procedure Append (C : Component_Representation) is
         Decl            : constant Defining_Name := Declaration (C);
         Artificial_Name : constant Text_Type :=
           (if Decl.Is_Null
            then Component_Name (C)
            else "");
      begin
         Comps.Append
           (Resolved_Component'
              (Declaration     => Decl,
               Artificial_Name => To_Unbounded_Text (Artificial_Name),
               Position        => Evaluate (Position (C)),
               First_Bit       => First_Bit (C),
               Size            => Evaluate (Size (C))));
      end Append;

      --------------------------
      -- Process_Variant_Part --
      --------------------------

      procedure Process_Variant_Part (Variants : Variant_Representation_Array)
      is
         Is_Present : GMP_Int.Big_Integer;
      begin
         --  Select the first variant whose "Present" expression evaluates to
         --  non-zero.

         for V of Variants loop
            Is_Present.Set (Evaluate (Present (V), Discriminants));
            if not GMP_Int."=" (Is_Present, Zero) then

               --  Add resolved components from this variant, and from
               --  potential subvariants.

               for C of Components (V) loop
                  Append (C);
               end loop;
               if Has_Subvariant_Part (V) then
                  Process_Variant_Part (Subvariants (V));
               end if;

               return;
            end if;
         end loop;
      end Process_Variant_Part;

      --------------
      -- Evaluate --
      --------------

      function Evaluate (Expr : Numerical_Expression) return Size_Type is
         use type GMP_Int.Big_Integer;

         Result : constant GMP_Int.Big_Integer :=
           Evaluate (Expr, Discriminants);
      begin
         if Result < Zero or else Result > Size_Last then
            raise Resolution_Error;
         end if;
         return Size_Type'Value (Result.Image);
      end Evaluate;

   begin
      --  Add resolved components from the "root" record and from variant parts

      for C of Components (Self) loop
         Append (C);
      end loop;
      if Has_Variant_Part (Self) then
         Process_Variant_Part (Variants (Self));
      end if;

      --  Resolve other attributes

      return Result : Resolved_Record_Type (Natural (Comps.Length)) do
         Result.Alignment := Alignment (Self);
         Result.Object_Size := Evaluate (Object_Size (Self));
         Result.Value_Size := Evaluate (Value_Size (Self));
         Result.Bit_Order := Bit_Order (Self);
         Result.Scalar_Storage_Order := Scalar_Storage_Order (Self);
         for Cur in Comps.Iterate loop
            Result.Components (To_Index (Cur)) := Element (Cur);
         end loop;
      end return;
   end Resolved_Record;

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

   function Lookup
     (Self : Repinfo_Collection;
      Decl : Base_Type_Decl'Class) return Type_Representation
   is
      use Type_Representation_Maps;
   begin
      if Self.Is_Null or else Decl.Is_Null then
         return No_Type_Representation;
      end if;

      declare
         Collection : Repinfo_Collection_Data renames Self.Unchecked_Get.all;

         --  Build a symbol for the fully qualified name of this type

         FQN : constant Text_Type := Decl.P_Fully_Qualified_Name;
         Key : constant Symbol_Type := Symbolize (Collection, FQN);

         --  Look for a corresponding type representation entry

         Cur : constant Cursor := Collection.Type_Representations.Find (Key);
      begin
         Trace.Trace ("Looking for representation of " & Image (FQN));
         return (if Has_Element (Cur)
                 then Wrap (Element (Cur), Decl, Self)
                 else No_Type_Representation);
      end;
   end Lookup;

   ----------
   -- Load --
   ----------

   function Load (Filenames : Filename_Array) return Repinfo_Collection is
      package Origin_Maps is new Ada.Containers.Hashed_Maps
        (Key_Type        => Symbol_Type,
         Element_Type    => Unbounded_String,
         Hash            => Hash,
         Equivalent_Keys => "=");
      Origins : Origin_Maps.Map;
      --  Mapping from the fully qualified name of imported entity to the
      --  JSON file name from which it was imported. Used for duplicates error
      --  reporting.

      --  Build the collection in place: create a refcounted pointer to an
      --  empty collection (``Result_Ref``), then get a raw access to the
      --  collection (``Result``), and finally fill the collection in.

      Result_Ref : Repinfo_Collection;
      Result     : Collection_Refs.Element_Access;
   begin
      Result_Ref.Set (Repinfo_Collection_Data'(others => <>));
      Result := Result_Ref.Unchecked_Get;

      --  Initialize internal tables

      Result.Pool := Create;
      Result.Symbols := Create_Symbol_Table;

      --  Import all entities from the parsing of all input files

      for XFilename of Filenames loop
         declare
            Filename : constant String := To_String (XFilename);
            Root     : JSON_Value;
            Entities : JSON_Array;
         begin
            if Trace.Is_Active then
               Trace.Trace ("Loading from " & Filename);
               Trace.Increase_Indent;
            end if;

            Root := Load_JSON (Filename);
            if Root.Kind /= JSON_Array_Type then
               raise Loading_Error with Filename & ": invalid root element";
            end if;
            Entities := Root.Get;

            for Entity of Entities loop
               if Entity.Kind /= JSON_Object_Type
                  or else not Entity.Has_Field ("name")
                  or else Entity.Get ("name").Kind /= JSON_String_Type
               then
                  raise Loading_Error with Filename & ": invalid entity found";
               end if;

               declare
                  Name      : constant String := Entity.Get ("name");
                  Key       : constant Symbol_Type :=
                    Symbolize (Result.all, Name);
                  Type_Repr : Type_Representation_Access;

                  --  Check that this is the first entity description for that
                  --  name.

                  Previous_From : Origin_Maps.Cursor;
                  Inserted      : Boolean;
               begin
                  Origins.Insert (Key, XFilename, Previous_From, Inserted);
                  if not Inserted then
                     raise Loading_Error with
                       Filename & ": duplicate entry for " & Name & " (from "
                       & To_String (Origins.Reference (Previous_From)) & ")";
                  end if;

                  --  Do the import iff we handle this kind of entity

                  if Trace.Is_Active then
                     Trace.Trace ("Loading entry: " & Name);
                     Trace.Increase_Indent;
                  end if;
                  begin
                     Type_Repr := Load_Type (Result.all, Entity, Name);
                  exception
                     when others =>
                        if Trace.Is_Active then
                           Trace.Decrease_Indent;
                        end if;
                        raise;
                  end;
                  if Trace.Is_Active then
                     Trace.Decrease_Indent;
                  end if;

                  if Type_Repr /= null then
                     Result.Type_Representations.Insert (Key, Type_Repr);
                  end if;
               end;
            end loop;

            --  Make sure the trace is decreased when terminating or aborting
            --  the iteration.

            if Trace.Is_Active then
               Trace.Decrease_Indent;
            end if;
         exception
            when others =>
               if Trace.Is_Active then
                  Trace.Decrease_Indent;
               end if;
               raise;
         end;
      end loop;

      return Result_Ref;
   end Load;

   ---------------------------
   -- Load_From_Directories --
   ---------------------------

   function Load_From_Directories
     (Name_Pattern : GNAT.Regexp.Regexp := Default_JSON_Filename_Regexp;
      Directories  : Filename_Array) return Repinfo_Collection
   is
      use GNATCOLL.VFS;
      Files : File_Array_Access;
   begin
      --  Convert Directories to File_Array and find all the JSON files to load

      declare
         Dirs : File_Array (Directories'Range);
      begin
         for I in Dirs'Range loop
            Dirs (I) := Create (+To_String (Directories (I)));
         end loop;
         Files := Find_Files_Regexp (Name_Pattern, Dirs);

         --  Sort files, for the determinism of the output

         Sort (Files.all);
      end;

      --  Now convert the list of files to the expected type

      declare
         Filenames : Filename_Array (Files.all'Range);
      begin
         for I in Filenames'Range loop
            Filenames (I) := To_Unbounded_String (+Files.all (I).Full_Name);
         end loop;
         Unchecked_Free (Files);

         --  Finally, load the JSON file

         return Load (Filenames);
      end;
   end Load_From_Directories;

   -------------------------
   -- Load_From_Directory --
   -------------------------

   function Load_From_Directory
     (Name_Pattern : GNAT.Regexp.Regexp := Default_JSON_Filename_Regexp;
      Directory    : String) return Repinfo_Collection is
   begin
      return Load_From_Directories
        (Name_Pattern, (1 => To_Unbounded_String (Directory)));
   end Load_From_Directory;

   -----------------------
   -- Load_From_Project --
   -----------------------

   function Load_From_Project
     (Tree    : GPR2.Project.Tree.Object;
      View    : GPR2.Project.View.Object := GPR2.Project.View.Undefined;
      Subdirs : String := "repinfo";
      Force   : Boolean := False) return Repinfo_Collection
   is
      use GNATCOLL.OS.FS;
      use GNATCOLL.OS.Process;
      use type GPR2.Filename_Optional;

      Filenames : GPR2.Path_Name.Set.Object;

      --  Build the command line for gprbuild

      Args : Argument_List;
   begin
      Args.Append ("gprbuild");
      Args.Append ("-c");
      Args.Append ("-P" & String (Tree.Root_Project.Path_Name.Value));

      --  Add "-X" arguments for external variables

      if Tree.Has_Context then
         for Cur in Tree.Context.Iterate loop
            declare
               use GPR2.Context.Key_Value;

               Name  : constant GPR2.Name_Type := Key (Cur);
               Value : constant GPR2.Value_Type := Element (Cur);
            begin
               Args.Append ("-X" & String (Name) & "=" & String (Value));
            end;
         end loop;
      end if;

      --  If there is a configuration project, pass "--config". Otherwise pass
      --  "--target" and "--RTS" arguments according to project settings.

      declare
         Config_Prj_File : constant GPR2.Path_Name.Object :=
           (if Tree.Has_Configuration
            then Tree.Configuration.Corresponding_View.Path_Name
            else GPR2.Path_Name.Undefined);
      begin
         if Config_Prj_File.Is_Defined and then Config_Prj_File.Exists then
            Args.Append ("--config=" & String (Config_Prj_File.Value));
         else
            Args.Append ("--target=" & String (Tree.Target));

            --  Determine the list of languages used in the project tree and
            --  emit one "--RTS:<lang>" argument for each that has a runtime.

            declare
               Langs : GPR2.Containers.Language_Set;
            begin
               for V of Tree.Root_Project.Closure loop
                  for L of V.Language_Ids loop
                     Langs.Include (L);
                  end loop;
               end loop;
               for L of Langs loop
                  declare
                     Runtime : constant String := String (Tree.Runtime (L));
                  begin
                     if Runtime'Length > 0 then
                        Args.Append
                          ("--RTS:" & String (GPR2.Name (L)) & "=" & Runtime);
                     end if;
                  end;
               end loop;
            end;
         end if;
      end;

      if Subdirs'Length > 0 then
         Args.Append ("--subdirs=" & Subdirs);
      end if;

      if Force then
         Args.Append ("-f");
      end if;

      --  Build all Ada sources with the -gnatR4js flag, to generate JSON
      --  repinfo in object directories.

      Args.Append ("-cargs:Ada");
      Args.Append ("-gnatR4js");

      --  If requested, print gprbuild arguments on the standard output

      if Trace.Is_Active then
         declare
            Msg : Unbounded_String :=
              To_Unbounded_String ("gprbuild arguments:");
         begin
            for A of Args loop
               Append (Msg, " " & A);
            end loop;
            Trace.Trace (To_String (Msg));
         end;
      end if;

      declare
         Exit_Code : constant Integer := Run
           (Args   => Args,
            Cwd    => "",
            Stdin  => Null_FD,
            Stdout => (if Trace.Is_Active then Standout else Null_FD),
            Stderr => (if Trace.Is_Active then Standerr else Null_FD));
      begin
         if Exit_Code /= 0 then
            raise Gprbuild_Error with
              "gprbuild exited with status code " & Exit_Code'Image;
         end if;
      end;

      --  Look for JSON files for all Ada sources

      declare
         Actual_View   : constant GPR2.Project.View.Object :=
           (if View.Is_Defined then View else Tree.Root_Project);
         Loaded_Subdir : constant GPR2.Filename_Optional := Tree.Subdirs;
         Obj_Dir       : GPR2.Path_Name.Object;
         Repinfo_File  : GPR2.Path_Name.Object;
      begin
         for V of Closure (Actual_View) loop
            Trace.Increase_Indent ("Processing subproject " & String (V.Name));

            --  If Tree was loaded with subdirs, remove it from Obj_Dir, then
            --  add our own, if requested. This should get us the object
            --  directory that gprbuild used.

            Obj_Dir := V.Object_Directory;
            if Loaded_Subdir'Length > 0 then
               pragma Assert (Obj_Dir.Simple_Name = Loaded_Subdir);
               Obj_Dir := Obj_Dir.Containing_Directory;
            end if;
            if Subdirs'Length > 0 then
               Obj_Dir := Obj_Dir.Compose
                 (GPR2.Filename_Type (Subdirs), Directory => True);
            end if;
            Trace.Trace ("Object directory: " & String (Obj_Dir.Value));

            for S of V.Sources loop
               if S.Is_Ada then
                  Trace.Trace
                    ("Processing Ada source: " & String (S.Path_Name.Value));
                  Repinfo_File :=
                    Obj_Dir.Compose (S.Path_Name.Simple_Name & ".json");
                  if Repinfo_File.Exists then
                     Trace.Trace ("Found: " & String (Repinfo_File.Value));
                     Filenames.Append (Repinfo_File);
                  else
                     Trace.Trace ("Not found: " & String (Repinfo_File.Value));
                  end if;
               end if;
            end loop;

            Trace.Decrease_Indent;
         end loop;
      end;

      --  Now that we have the list of JSON files to load, just build the
      --  result.

      declare
         F_List : Filename_Array (1 .. Natural (Filenames.Length));
         Next   : Positive := F_List'First;
      begin
         for F of Filenames loop
            F_List (Next) := To_Unbounded_String (String (F.Value));
            Next := Next + 1;
         end loop;
         return Load (F_List);
      end;
   end Load_From_Project;

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

   procedure Release (Self : in out Repinfo_Collection_Data) is
      Var_I   : Integer_Access;
      Var_R   : Rational_Access;
      Var_CRA : Component_Representation_Access_Array_Access;
      Var_VRA : Variant_Representation_Access_Array_Access;
   begin
      Free (Self.Pool);

      for I of Self.Integers loop
         Var_I := I;
         Free (Var_I);
      end loop;
      Self.Integers.Destroy;
      for R of Self.Rationals loop
         Var_R := R;
         Free (Var_R);
      end loop;
      Self.Rationals.Destroy;

      for CRA of Self.Component_Repinfo_Arrays loop
         Var_CRA := CRA;
         Free (Var_CRA);
      end loop;
      Self.Component_Repinfo_Arrays.Destroy;
      for VRA of Self.Variant_Repinfo_Arrays loop
         Var_VRA := VRA;
         Free (Var_VRA);
      end loop;
      Self.Variant_Repinfo_Arrays.Destroy;

      Destroy (Self.Symbols);
   end Release;

end Libadalang.Data_Decomposition;