Merge branch 'leo/99-priv-first_last' into 'master'

TGen: Generated helpers for private types as private subprograms

Closes #99

See merge request eng/ide/libadalang-tools!136

src/tgen/templates/json_templates/composite_base_spec.tmplt

@@ -5,6 +5,7 @@
 @@--  @_TY_NAME_@ Name of the current type.
 @@--
 @@INCLUDE@@ util.tmplt
+@@IF@@ @_PUB_PART_@ xor @_FULL_PRIV_@
    --  Base operations for @_TY_NAME_@
 
    procedure @_TY_PREFIX_@_Write
@@ -14,3 +15,4 @@
    procedure @_TY_PREFIX_@_Read
      (@_GLOBAL_PREFIX_@_JSON : TGen.JSON.JSON_Value;
       @_GLOBAL_PREFIX_@_V    : out @_TY_NAME_@);
+@@END_IF@@

src/tgen/templates/json_templates/header_spec.tmplt

@@ -9,6 +9,7 @@
 @@--  @_COMP_TYP_@ Index types for arrays, and types of the discriminants for
 @@--       records.
 @@--
+@@IF@@ @_PUB_PART_@ xor @_FULL_PRIV_@
    --  Definition of a header type and Input and Output functions for @_TY_NAME_@
 
    function @_TY_PREFIX_@_Input_Header
@@ -18,3 +19,4 @@
    procedure @_TY_PREFIX_@_Output_Header
      (@_GLOBAL_PREFIX_@_JSON : in out TGen.JSON.JSON_Value;
       @_GLOBAL_PREFIX_@_V    : @_TY_NAME_@);
+@@END_IF@@

src/tgen/templates/json_templates/header_wrappers_spec.tmplt

@@ -4,6 +4,7 @@
 @@--  @_TY_PREFIX_@ Prefix used to prefix all entities for the current type.
 @@--  @_TY_NAME_@ Name of the current type.
 @@--
+@@IF@@ @_PUB_PART_@ xor @_FULL_PRIV_@
 
    procedure @_TY_PREFIX_@_Write_All
      (@_GLOBAL_PREFIX_@_JSON : in out TGen.JSON.JSON_Value;
@@ -12,3 +13,4 @@
    procedure @_TY_PREFIX_@_Read_All
      (@_GLOBAL_PREFIX_@_JSON : TGen.JSON.JSON_Value;
       @_GLOBAL_PREFIX_@_V    : out @_TY_NAME_@);
+@@END_IF@@

src/tgen/templates/json_templates/in_out_spec.tmplt

@@ -4,6 +4,7 @@
 @@--  @_TY_NAME_@ Name of the current type.
 @@--  @_NEEDS_HEADER_@ True if the current type needs a header.
 @@--
+@@IF@@ @_PUB_PART_@ xor @_FULL_PRIV_@
    --  Input and Output functions for @_TY_NAME_@
 
    function @_TY_PREFIX_@_Output
@@ -12,3 +13,4 @@
    function @_TY_PREFIX_@_Input
      (@_GLOBAL_PREFIX_@_JSON : TGen.JSON.JSON_Value)
      return @_TY_NAME_@;
+@@END_IF@@

src/tgen/templates/json_templates/scalar_base_spec.tmplt

@@ -6,6 +6,7 @@
 @@--  @_FOR_BASE_@ True if we are doing the generation for the base type.
 @@--
 @@INCLUDE@@ util.tmplt
+@@IF@@ @_PUB_PART_@ xor @_FULL_PRIV_@
    --  Base operations for @_TY_NAME_@
 
    procedure @_TY_PREFIX_@_Write@_BASE_SUFFIX()_@
@@ -19,3 +20,4 @@
       @_GLOBAL_PREFIX_@_V     : out @_TY_NAME_@;
       @_GLOBAL_PREFIX_@_First : @_TY_NAME_@ := @_TY_NAME_@'First;
       @_GLOBAL_PREFIX_@_Last  : @_TY_NAME_@ := @_TY_NAME_@'Last);
+@@END_IF@@

src/tgen/templates/marshalling_templates/composite_base_spec.tmplt

@@ -9,8 +9,12 @@
 @@--  @_DISCR_NAME_@ Same as above for the discriminants of records.
 @@--  @_COMP_TYP_@ Index types for arrays, and types of the discriminants for
 @@--       records.
+@@--  @_SIZE_MAX_PUB_@ True if the Size_Max function can be declared in the
+@@--       public part. This will be False if one of the discriminant types, or
+@@--       index types is not visible outside of the private part.
 @@--
 @@INCLUDE@@ util.tmplt
+@@IF@@ @_PUB_PART_@ xor @_FULL_PRIV_@
    --  Base operations for @_TY_NAME_@
 
    procedure @_TY_PREFIX_@_Write
@@ -29,6 +33,8 @@
      (@_GLOBAL_PREFIX_@_V : @_TY_NAME_@)
      return Natural;
 
+@@END_IF@@
+@@IF@@ @_PUB_PART_@ xor (@_FULL_PRIV_@ or not @_SIZE_MAX_PUB_@)
    function @_TY_PREFIX_@_Size_Max
 @@IF@@ @_DISCR_NAME_@ /= ""
 @@TABLE'ALIGN_ON(":", ":=")@@
@@ -42,3 +48,4 @@
 @@END_TABLE@@
 @@END_IF@@
      return Natural;
+@@END_IF@@

src/tgen/templates/marshalling_templates/default_header_spec.tmplt

@@ -2,8 +2,10 @@
 @@--  @_TY_PREFIX_@ Prefix used to prefix all entities for the current type.
 @@--  @_TY_NAME_@ Name of the current type.
 @@--
+@@IF@@ @_PUB_PART_@ xor @_FULL_PRIV_@
    --  Definitions constants for the size of the header of @_TY_NAME_@
 
    @_TY_PREFIX_@_Bit_Size_Header : constant Natural := 0;
 
    @_TY_PREFIX_@_Byte_Size_Header : constant Natural := 0;
+@@END_IF@@

src/tgen/templates/marshalling_templates/header_spec.tmplt

@@ -9,6 +9,10 @@
 @@--  @_COMP_TYP_@ Index types for arrays, and types of the discriminants for
 @@--       records.
 @@--
+
+@@IF@@ @_PUB_PART_@
+   type @_TY_PREFIX_@_Header_Type is private;
+@@ELSE@@
    --  Definition of a header type and Input and Output functions for @_TY_NAME_@
 
    type @_TY_PREFIX_@_Header_Type is record
@@ -23,7 +27,9 @@
 @@END_TABLE@@
 @@END_IF@@
    end record;
+@@END_IF@@
 
+@@IF@@ @_PUB_PART_@ xor @_FULL_PRIV_@
    function @_TY_PREFIX_@_Input_Header
      (@_GLOBAL_PREFIX_@_Stream : not null access Root_Stream_Type'Class)
      return @_TY_PREFIX_@_Header_Type;
@@ -35,3 +41,4 @@
    function @_TY_PREFIX_@_Bit_Size_Header return Natural;
 
    function @_TY_PREFIX_@_Byte_Size_Header return Natural;
+@@END_IF@@

src/tgen/templates/marshalling_templates/header_wrappers_spec.tmplt

@@ -4,6 +4,7 @@
 @@--  @_TY_PREFIX_@ Prefix used to prefix all entities for the current type.
 @@--  @_TY_NAME_@ Name of the current type.
 @@--
+@@IF@@ @_PUB_PART_@ xor @_FULL_PRIV_@
    procedure @_TY_PREFIX_@_Write_All
      (@_GLOBAL_PREFIX_@_Stream : not null access Root_Stream_Type'Class;
       @_GLOBAL_PREFIX_@_Buffer : in out Unsigned_8;
@@ -17,3 +18,4 @@
       @_GLOBAL_PREFIX_@_V      : out @_TY_NAME_@);
 
    function @_TY_PREFIX_@_Size_Max_All return Natural;
+@@END_IF@@

src/tgen/templates/marshalling_templates/in_out_spec.tmplt

@@ -4,6 +4,7 @@
 @@--  @_TY_NAME_@ Name of the current type.
 @@--  @_NEEDS_HEADER_@ True if the current type needs a header.
 @@--
+@@IF@@ @_PUB_PART_@ xor @_FULL_PRIV_@
    --  Input and Output functions for @_TY_NAME_@
 
    procedure @_TY_PREFIX_@_Output
@@ -23,3 +24,4 @@
      (@_GLOBAL_PREFIX_@_Header : not null access Root_Stream_Type'Class;
       @_GLOBAL_PREFIX_@_Stream : not null access Root_Stream_Type'Class)
      return @_TY_NAME_@;
+@@END_IF@@

src/tgen/templates/marshalling_templates/scalar_base_spec.tmplt

@@ -6,6 +6,7 @@
 @@--  @_FOR_BASE_@ True if we are doing the generation for the base type.
 @@--
 @@INCLUDE@@ util.tmplt
+@@IF@@ @_PUB_PART_@ xor @_FULL_PRIV_@
    --  Base operations for @_TY_NAME_@
 
    procedure @_TY_PREFIX_@_Write@_BASE_SUFFIX()_@
@@ -28,3 +29,4 @@
      (@_GLOBAL_PREFIX_@_First  : @_TY_NAME_@ := @_TY_NAME_@'First;
       @_GLOBAL_PREFIX_@_Last   : @_TY_NAME_@ := @_TY_NAME_@'Last)
       return Natural;
+@@END_IF@@

src/tgen/templates/type_representation_templates/anonymous_typ_spec.tmplt → src/tgen/templates/type_representation_templates/anonymous_typ_decl.tmplt

@@ -1,4 +1,6 @@
-@@--  Template for the specification of an anonymous type representation.
+@@--  Template for the declarations for an anonymous type representation.
+@@--  These declarations go in the body of the value package, in order to
+@@--  be part of the private part and avoid any visibility issues.
 @@--  @_TY_PREFIX_@ Prefix used to prefix all entities for the current type.
 @@--  @_TY_NAME_@ Name of the current type.
 @@--  @_CONSTRAINT_KIND_@ Type of the constraint
@@ -11,5 +13,3 @@
    @_TY_PREFIX_@_Typ : TGen.Types.Constraints.Anonymous_Typ :=
       (Name => TGen.Strings.To_Qualified_Name ("@_TY_NAME_@"),
        others => <>);
-
-   @_TY_PREFIX_@_Typ_Ref : TGen.Types.SP.Ref;

src/tgen/templates/type_representation_templates/array_typ_spec.tmplt → src/tgen/templates/type_representation_templates/array_typ_decl.tmplt

@@ -1,4 +1,6 @@
-@@--  Template for the specification of an array type.
+@@--  Template for the declarations for an array type representation.
+@@--  These declarations go in the body of the value package, in order to
+@@--  be part of the private part and avoid any visibility issues.
 @@--  @_TY_PREFIX_@ Common prefix for all entities of the type.
 @@--  @_ARRAY_TYP_@ Type of the array (either Constrained_Array_Typ or
 @@--     Unconstrained_Array_Typ.
@@ -20,4 +22,3 @@
       (Num_Dims => @_NUM_DIMS_@,
        Name      => TGen.Strings.To_Qualified_Name ("@_TY_NAME_@"),
        others => <>);
-   @_TY_PREFIX_@_Typ_Ref : TGen.Types.SP.Ref;

src/tgen/templates/type_representation_templates/constraint_spec.tmplt → src/tgen/templates/type_representation_templates/constraint_decl.tmplt

@@ -1,4 +1,6 @@
-@@--  Template for the specification of any kind of constraint
+@@--  Template for the declarations for any kind of constraint representation.
+@@--  These declarations go in the body of the value package, in order to
+@@--  be part of the private part and avoid any visibility issues.
 @@--
 @@--  Macro to instantiate a discrete constraint.
 @@--  @_$1_@: Kind of the constraint (STATIC, NON_STATIC, DISCRIMINANT)

src/tgen/templates/type_representation_templates/instance_typ_spec.tmplt → src/tgen/templates/type_representation_templates/instance_typ_decl.tmplt

@@ -1,4 +1,7 @@
-@@--  Template for the specification of an instane type representation.
+@@--  Template for the declarations for an instance type representation.
+@@--  These declarations go in the body of the value package, in order to
+@@--  be part of the private part and avoid any visibility issues.
+@@--
 @@--  @_TY_PREFIX_@ Prefix used to prefix all entities for the current type.
 @@--  @_TY_NAME_@ Name of the current type.
 
@@ -13,5 +16,3 @@
    @_TY_PREFIX_@_Typ : @_TY_PREFIX_@_Instance_Typ :=
       (Name   => TGen.Strings.To_Qualified_Name ("@_TY_NAME_@"),
        others => <>);
-
-   @_TY_PREFIX_@_Typ_Ref : TGen.Types.SP.Ref;

src/tgen/templates/type_representation_templates/record_typ_spec.tmplt → src/tgen/templates/type_representation_templates/record_typ_decl.tmplt

@@ -1,4 +1,7 @@
-@@--  Template for the specification of a record type representation.
+@@--  Template for the declarations for a record type representation.
+@@--  These declarations go in the body of the value package, in order to
+@@--  be part of the private part and avoid any visibility issues.
+@@--
 @@--  @_TY_PREFIX_@ Prefix used to prefix all entities for the current type.
 @@--  @_TY_NAME_@ Name of the current type.
 @@--  @_RECORD_TYP_@ Kind of the record type. Can be either Function_Typ,
@@ -25,5 +28,3 @@
  @@END_IF@@
        Static_Gen => True,
        others     => <>);
-
-   @_TY_PREFIX_@_Typ_Ref : TGen.Types.SP.Ref;

src/tgen/templates/type_representation_templates/scalar_typ_spec.tmplt → src/tgen/templates/type_representation_templates/scalar_typ_decl.tmplt

@@ -1,4 +1,7 @@
-@@--  Template for the specification of a scalar type representation.
+@@--  Template for the declarations for a scalar type representation.
+@@--  These declarations go in the body of the value package, in order to
+@@--  be part of the private part and avoid any visibility issues.
+@@--
 @@--  @_TY_PREFIX_@ Prefix used to prefix all entities for the current type.
 @@--  @_TY_NAME_@ Name of the current type.
 @@--  @_SCALAR_TYP_@ Kind of the discrete typ
@@ -104,4 +107,3 @@
        others => <>);
 
 @@END_IF@@
-   @_TY_PREFIX_@_Typ_Ref : TGen.Types.SP.Ref;

src/tgen/templates/type_representation_templates/variant_choice_spec.tmplt → src/tgen/templates/type_representation_templates/variant_choice_decl.tmplt

@@ -1,4 +1,6 @@
-@@--  Template for a variant choice specification
+@@--  Template for the declarations for a variant choice specification.
+@@--  These declarations go in the body of the value package, in order to
+@@--  be part of the private part and avoid any visibility issues.
 @@--  @_TY_PREFIX_@ Prefix for all of the type declarations
 @@--  @_VARIANT_NUMBER_@ Index of the variant in the record
 @@--  @_VARIANT_CHOICE_NUMBER_@ Index of the variant choice number

src/tgen/templates/type_representation_templates/variant_spec.tmplt → src/tgen/templates/type_representation_templates/variant_decl.tmplt

@@ -1,3 +1,7 @@
+@@--  Template for the declarations for a variant part representation.
+@@--  These declarations go in the body of the value package, in order to
+@@--  be part of the private part and avoid any visibility issues.
+@@--
 @@--  @_TY_PREFIX_@ Prefix for all of the type declarations
 @@--  @_VARIANT_NUMBER_@ Index of the variant in the record
 @@--  @_DISCR_NAME_@ Controlling discriminant for the variant expression

src/tgen/tgen-gen_strategies_utils.adb

@@ -342,6 +342,7 @@ package body TGen.Gen_Strategies_Utils is
                                (Constrained        => False,
                                 Name               => R.Name,
                                 Last_Comp_Unit_Idx => R.Last_Comp_Unit_Idx,
+                                Fully_Private      => R.Fully_Private,
                                 Static_Gen         => R.Static_Gen,
                                 Component_Types    => V.Components,
                                 Mutable            => False,

src/tgen/tgen-libgen.adb

@@ -174,6 +174,8 @@ package body TGen.Libgen is
 
       TRD : constant String := To_String (Ctx.Root_Templates_Dir);
 
+      Sorted_Types : Typ_List;
+
    begin
       Create (F_Spec, Out_File, File_Name & ".ads");
       Put (F_Spec, "with TGen.Marshalling_Lib; ");
@@ -279,30 +281,49 @@ package body TGen.Libgen is
 
       --  Generate the marshalling support lib. Make sure to sort the types
       --  in dependency order otherwise we will get access before elaboration
-      --  issues.
+      --  issues when computing the Size_Max constants for each type:
+      --  we need the Size_Max of all the dependencies of the components to be
+      --  available before being able to compute the Size_Max for a composite
+      --  type.
 
-      for T of Sort (Types) loop
+      Sorted_Types := Sort (Types);
 
-         if Is_Supported_Type (T.Get)
+      --  Output the marshalling subprograms for the types with a public part
+      --  first, then create the private part for the package and output the
+      --  marshalling subprograms for the fully private types. Hopefully this
+      --  won't break too much the topological order on the types, otherwise
+      --  we'll need to make marshaller generation much finer grain in order to
+      --  both be able to have the marshaller subprograms declarations respect
+      --  the visibility of the type, and have the implementation details
+      --  generated in the correct order.
 
-           --  We ignore instance types when generating marshallers as they
-           --  are not types per-se, but a convenient way of binding a type
-           --  to its strategy context.
+      for Part in Spec_Part loop
+         for T of Sorted_Types loop
 
-            and then T.Get not in Instance_Typ'Class
-         then
-            if T.Get.Kind in Function_Kind then
-               TGen.Marshalling.JSON_Marshallers
-                 .Generate_TC_Serializers_For_Subp
-                   (F_Spec, F_Body, T.Get, TRD);
-            else
-               TGen.Marshalling.Binary_Marshallers
-                 .Generate_Marshalling_Functions_For_Typ
-                   (F_Spec, F_Body, T.Get, TRD);
-               TGen.Marshalling.JSON_Marshallers
-                 .Generate_Marshalling_Functions_For_Typ
-                   (F_Spec, F_Body, T.Get, TRD);
+            if Is_Supported_Type (T.Get)
+
+            --  We ignore instance types when generating marshallers as they
+            --  are not types per-se, but a convenient way of binding a type
+            --  to its strategy context.
+
+               and then T.Get not in Instance_Typ'Class
+            then
+               if T.Get.Kind in Function_Kind then
+                  TGen.Marshalling.JSON_Marshallers
+                  .Generate_TC_Serializers_For_Subp
+                     (F_Spec, F_Body, T.Get, Part, TRD);
+               else
+                  TGen.Marshalling.Binary_Marshallers
+                  .Generate_Marshalling_Functions_For_Typ
+                     (F_Spec, F_Body, T.Get, Part, TRD);
+                  TGen.Marshalling.JSON_Marshallers
+                  .Generate_Marshalling_Functions_For_Typ
+                     (F_Spec, F_Body, T.Get, Part, TRD);
+               end if;
             end if;
+         end loop;
+         if Part = Pub then
+            Put_Line (F_Spec, "private");
          end if;
       end loop;