[Ada] Implement machine parsable format for -gnatR output

This adds a new variant to the -gnatR switch, namely -gnatRj, which causes
the compiler to output representation information to a file in the JSON
data interchange format.  It can be combined with -gnatR0/1/2/3/m (but is
incompatible with -gnaRe and -gnatRs).

The information output in this mode is a superset of that output in the
traditional -gnatR mode, but is otherwise equivalent for the common part.

2018-05-29  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* doc/gnat_ugn/building_executable_programs_with_gnat.rst (Alphabetical
	List of All Switches): Document -gnatRj.
	(Debugging Control): Likewise.
	* gnat_ugn.texi: Regenerate.
	* opt.ads (List_Representation_Info_To_JSON): New boolean variable.
	* osint-c.adb (Create_Repinfo_File): Use the .json instead of .rep
	extension if List_Representation_Info_To_JSON is true.
	* repinfo.ads: Document the JSON output format.
	* repinfo.adb (List_Location): New procedure.
	(List_Array_Info): Add support for JSON output.
	(List_Entities): Likewise.
	(Unop): Likewise.
	(Binop): Likewise.
	(Print_Expr): Likewise.
	(List_Linker_Section): Likewise.
	(List_Mechanisms): Likewise.
	(List_Name): Likewise.
	(List_Object_Info): Likewise.
	(List_Record_Info): Likewise.
	(List_Component_Layout): Likewise.  Add Indent parameter.
	(List_Structural_Record_Layout): New procedure.
	(List_Attr): Add support for JSON output.
	(List_Type_Info): Likewise.
	(Write_Unknown_Val): Likewise.
	* switch-c.adb (Scan_Front_End_Switches) <R>: Deal with 'j'.
	* usage.adb (Usage): List -gnatRj.

From-SVN: r260868

gcc/ada/ChangeLog

 2018-05-29  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* doc/gnat_ugn/building_executable_programs_with_gnat.rst (Alphabetical
+	List of All Switches): Document -gnatRj.
+	(Debugging Control): Likewise.
+	* gnat_ugn.texi: Regenerate.
+	* opt.ads (List_Representation_Info_To_JSON): New boolean variable.
+	* osint-c.adb (Create_Repinfo_File): Use the .json instead of .rep
+	extension if List_Representation_Info_To_JSON is true.
+	* repinfo.ads: Document the JSON output format.
+	* repinfo.adb (List_Location): New procedure.
+	(List_Array_Info): Add support for JSON output.
+	(List_Entities): Likewise.
+	(Unop): Likewise.
+	(Binop): Likewise.
+	(Print_Expr): Likewise.
+	(List_Linker_Section): Likewise.
+	(List_Mechanisms): Likewise.
+	(List_Name): Likewise.
+	(List_Object_Info): Likewise.
+	(List_Record_Info): Likewise.
+	(List_Component_Layout): Likewise.  Add Indent parameter.
+	(List_Structural_Record_Layout): New procedure.
+	(List_Attr): Add support for JSON output.
+	(List_Type_Info): Likewise.
+	(Write_Unknown_Val): Likewise.
+	* switch-c.adb (Scan_Front_End_Switches) <R>: Deal with 'j'.
+	* usage.adb (Usage): List -gnatRj.
+
+2018-05-29  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* repinfo.adb (List_Component_Layout): New procedure extracted from...
 	(List_Record_Layout): ...here.  Invoke it.
 

gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst

@@ -2024,7 +2024,7 @@ Alphabetical List of All Switches
 
 .. index:: -gnatR  (gcc)
 
-:switch:`-gnatR[0/1/2/3][e][m][s]`
+:switch:`-gnatR[0|1|2|3][e][j][m][s]`
   Output representation information for declared types, objects and
   subprograms. Note that this switch is not allowed if a previous
   :switch:`-gnatD` switch has been given, since these two switches
@@ -5786,7 +5786,7 @@ Debugging Control
 
 .. index:: -gnatR  (gcc)
 
-:switch:`-gnatR[0|1|2|3][e][m][s]`
+:switch:`-gnatR[0|1|2|3][e][j][m][s]`
   This switch controls output from the compiler of a listing showing
   representation information for declared types, objects and subprograms.
   For :switch:`-gnatR0`, no information is output (equivalent to omitting
@@ -5817,6 +5817,13 @@ Debugging Control
   the output is to a file with the name :file:`file.rep` where file is
   the name of the corresponding source file.
 
+  If the switch is followed by a ``j`` (e.g., :switch:`-gnatR3j`), then
+  the output is to a file with the name :file:`file.json` where file is
+  the name of the corresponding source file, and it uses the JSON data
+  interchange format specified by the ECMA-404 standard. The semantic
+  description of this JSON output is available in the specification of
+  the Repinfo unit present in the compiler sources.
+
   Note that it is possible for record components to have zero size. In
   this case, the component clause uses an obvious extension of permitted
   Ada syntax, for example ``at 0 range 0 .. -1``.

gcc/ada/gnat_ugn.texi

@@ -9898,7 +9898,7 @@ Treat pragma Restrictions as Restriction_Warnings.
 
 @table @asis
 
-@item @code{-gnatR[0/1/2/3][e][m][s]}
+@item @code{-gnatR[0|1|2|3][e][j][m][s]}
 
 Output representation information for declared types, objects and
 subprograms. Note that this switch is not allowed if a previous
@@ -15013,7 +15013,7 @@ restriction warnings rather than restrictions.
 
 @table @asis
 
-@item @code{-gnatR[0|1|2|3][e][m][s]}
+@item @code{-gnatR[0|1|2|3][e][j][m][s]}
 
 This switch controls output from the compiler of a listing showing
 representation information for declared types, objects and subprograms.
@@ -15045,6 +15045,13 @@ If the switch is followed by an @code{s} (e.g., @code{-gnatR3s}), then
 the output is to a file with the name @code{file.rep} where file is
 the name of the corresponding source file.
 
+If the switch is followed by a @code{j} (e.g., @code{-gnatR3j}), then
+the output is to a file with the name @code{file.json} where file is
+the name of the corresponding source file, and it uses the JSON data
+interchange format specified by the ECMA-404 standard. The semantic
+description of this JSON output is available in the specification of
+the Repinfo unit present in the compiler sources.
+
 Note that it is possible for record components to have zero size. In
 this case, the component clause uses an obvious extension of permitted
 Ada syntax, for example @code{at 0 range 0 .. -1}.

gcc/ada/opt.ads

@@ -1003,6 +1003,12 @@ package Opt is
    --  of stdout. For example, if file x.adb is compiled using -gnatR2s then
    --  representation info is written to x.adb.ref.
 
+   List_Representation_Info_To_JSON : Boolean := False;
+   --  GNAT
+   --  Set true by -gnatRj switch. Causes information from -gnatR/1/2/3/m to be
+   --  written to file.json (where file is the name of the source file) in the
+   --  JSON data interchange format.
+
    List_Representation_Info_Mechanisms : Boolean := False;
    --  GNAT
    --  Set true by -gnatRm switch. Causes information on mechanisms to be

gcc/ada/osint-c.adb

@@ -273,8 +273,11 @@ package body Osint.C is
    begin
       Name_Buffer (1 .. Src'Length) := Src;
       Name_Len := Src'Length;
+      if List_Representation_Info_To_JSON then
+         Discard := Create_Auxiliary_File (Name_Find, "json");
+      else
          Discard := Create_Auxiliary_File (Name_Find, "rep");
-      return;
+      end if;
    end Create_Repinfo_File;
 
    ---------------------------

gcc/ada/repinfo.adb

@@ -153,6 +153,9 @@ package body Repinfo is
    --  List linker section for Ent (caller has checked that Ent is an entity
    --  for which the Linker_Section_Pragma field is defined).
 
+   procedure List_Location (Ent : Entity_Id);
+   --  List location information for Ent
+
    procedure List_Mechanisms (Ent : Entity_Id);
    --  List mechanism information for parameters of Ent, which is subprogram,
    --  subprogram type, or an entry or entry family.
@@ -306,17 +309,33 @@ package body Repinfo is
    procedure List_Array_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
    begin
       Blank_Line;
+
+      if List_Representation_Info_To_JSON then
+         Write_Line ("{");
+      end if;
+
       List_Type_Info (Ent);
 
+      if List_Representation_Info_To_JSON then
+         Write_Line (",");
+         Write_Str ("  ""Component_Size"": ");
+         Write_Val (Component_Size (Ent));
+      else
          Write_Str ("for ");
          List_Name (Ent);
          Write_Str ("'Component_Size use ");
          Write_Val (Component_Size (Ent));
          Write_Line (";");
+      end if;
 
       List_Scalar_Storage_Order (Ent, Bytes_Big_Endian);
 
       List_Linker_Section (Ent);
+
+      if List_Representation_Info_To_JSON then
+         Write_Eol;
+         Write_Line ("}");
+      end if;
    end List_Array_Info;
 
    -------------------
@@ -428,8 +447,15 @@ package body Repinfo is
                elsif Is_Type (E) then
                   if List_Representation_Info >= 2 then
                      Blank_Line;
+                     if List_Representation_Info_To_JSON then
+                        Write_Line ("{");
+                     end if;
                      List_Type_Info (E);
                      List_Linker_Section (E);
+                     if List_Representation_Info_To_JSON then
+                        Write_Eol;
+                        Write_Line ("}");
+                     end if;
                   end if;
 
                elsif Ekind_In (E, E_Variable, E_Constant) then
@@ -537,8 +563,20 @@ package body Repinfo is
 
                procedure Unop (S : String) is
                begin
+                  if List_Representation_Info_To_JSON then
+                     Write_Str ("{ ""code"": """);
+                     if S (S'Last) = ' ' then
+                        Write_Str (S (S'First .. S'Last - 1));
+                     else
+                        Write_Str (S);
+                     end if;
+                     Write_Str (""", ""operands"": [ ");
+                     Print_Expr (Node.Op1);
+                     Write_Str (" ] }");
+                  else
                      Write_Str (S);
                      Print_Expr (Node.Op1);
+                  end if;
                end Unop;
 
                -----------
@@ -547,11 +585,21 @@ package body Repinfo is
 
                procedure Binop (S : String) is
                begin
+                  if List_Representation_Info_To_JSON then
+                     Write_Str ("{ ""code"": """);
+                     Write_Str (S (S'First + 1 .. S'Last - 1));
+                     Write_Str (""", ""operands"": [ ");
+                     Print_Expr (Node.Op1);
+                     Write_Str (", ");
+                     Print_Expr (Node.Op2);
+                     Write_Str (" ] }");
+                  else
                      Write_Char ('(');
                      Print_Expr (Node.Op1);
                      Write_Str (S);
                      Print_Expr (Node.Op2);
                      Write_Char (')');
+                  end if;
                end Binop;
 
             --  Start of processing for Print_Expr
@@ -559,6 +607,16 @@ package body Repinfo is
             begin
                case Node.Expr is
                   when Cond_Expr =>
+                     if List_Representation_Info_To_JSON then
+                        Write_Str ("{ ""code"": ""?<>""");
+                        Write_Str (", ""operands"": [ ");
+                        Print_Expr (Node.Op1);
+                        Write_Str (", ");
+                        Print_Expr (Node.Op2);
+                        Write_Str (", ");
+                        Print_Expr (Node.Op3);
+                        Write_Str (" ] }");
+                     else
                         Write_Str ("(if ");
                         Print_Expr (Node.Op1);
                         Write_Str (" then ");
@@ -566,6 +624,7 @@ package body Repinfo is
                         Write_Str (" else ");
                         Print_Expr (Node.Op3);
                         Write_Str (" end)");
+                     end if;
 
                   when Plus_Expr =>
                      Binop (" + ");
@@ -702,29 +761,58 @@ package body Repinfo is
          Args := Pragma_Argument_Associations (Linker_Section_Pragma (Ent));
          Sect := Expr_Value_S (Get_Pragma_Arg (Last (Args)));
 
+         if List_Representation_Info_To_JSON then
+            Write_Line (",");
+            Write_Str ("  ""Linker_Section"": """);
+         else
             Write_Str ("pragma Linker_Section (");
             List_Name (Ent);
             Write_Str (", """);
+         end if;
 
          pragma Assert (Nkind (Sect) = N_String_Literal);
          String_To_Name_Buffer (Strval (Sect));
          Write_Str (Name_Buffer (1 .. Name_Len));
-         Write_Str (""");");
-         Write_Eol;
+         Write_Str ("""");
+         if not List_Representation_Info_To_JSON then
+            Write_Line (");");
+         end if;
       end if;
    end List_Linker_Section;
 
+   -------------------
+   -- List_Location --
+   -------------------
+
+   procedure List_Location (Ent : Entity_Id) is
+   begin
+      pragma Assert (List_Representation_Info_To_JSON);
+      Write_Str ("  ""location"": """);
+      Write_Location (Sloc (Ent));
+      Write_Line (""",");
+   end List_Location;
+
    ---------------------
    -- List_Mechanisms --
    ---------------------
 
    procedure List_Mechanisms (Ent : Entity_Id) is
+      First : Boolean := True;
       Plen  : Natural;
       Form  : Entity_Id;
 
    begin
       Blank_Line;
 
+      if List_Representation_Info_To_JSON then
+         Write_Line ("{");
+         Write_Str ("  ""name"": """);
+         List_Name (Ent);
+         Write_Line (""",");
+         List_Location (Ent);
+
+         Write_Str ("  ""Convention"": """);
+      else
          case Ekind (Ent) is
             when E_Function =>
                Write_Str ("function ");
@@ -753,48 +841,56 @@ package body Repinfo is
          Write_Eol;
 
          Write_Str ("convention : ");
+      end if;
 
       case Convention (Ent) is
          when Convention_Ada =>
-            Write_Line ("Ada");
+            Write_Str ("Ada");
 
          when Convention_Ada_Pass_By_Copy =>
-            Write_Line ("Ada_Pass_By_Copy");
+            Write_Str ("Ada_Pass_By_Copy");
 
          when Convention_Ada_Pass_By_Reference =>
-            Write_Line ("Ada_Pass_By_Reference");
+            Write_Str ("Ada_Pass_By_Reference");
 
          when Convention_Intrinsic =>
-            Write_Line ("Intrinsic");
+            Write_Str ("Intrinsic");
 
          when Convention_Entry =>
-            Write_Line ("Entry");
+            Write_Str ("Entry");
 
          when Convention_Protected =>
-            Write_Line ("Protected");
+            Write_Str ("Protected");
 
          when Convention_Assembler =>
-            Write_Line ("Assembler");
+            Write_Str ("Assembler");
 
          when Convention_C =>
-            Write_Line ("C");
+            Write_Str ("C");
 
          when Convention_COBOL =>
-            Write_Line ("COBOL");
+            Write_Str ("COBOL");
 
          when Convention_CPP =>
-            Write_Line ("C++");
+            Write_Str ("C++");
 
          when Convention_Fortran =>
-            Write_Line ("Fortran");
+            Write_Str ("Fortran");
 
          when Convention_Stdcall =>
-            Write_Line ("Stdcall");
+            Write_Str ("Stdcall");
 
          when Convention_Stubbed =>
-            Write_Line ("Stubbed");
+            Write_Str ("Stubbed");
       end case;
 
+      if List_Representation_Info_To_JSON then
+         Write_Line (""",");
+         Write_Str ("  ""formal"": [");
+      else
+         Write_Eol;
+      end if;
+
       --  Find max length of formal name
 
       Plen := 0;
@@ -815,6 +911,25 @@ package body Repinfo is
       while Present (Form) loop
          Get_Unqualified_Decoded_Name_String (Chars (Form));
          Set_Casing (Unit_Casing);
+
+         if List_Representation_Info_To_JSON then
+            if First then
+               Write_Eol;
+               First := False;
+            else
+               Write_Line (",");
+            end if;
+
+            Write_Line ("    {");
+            Write_Str ("      ""name"": """);
+            Write_Str (Name_Buffer (1 .. Name_Len));
+            Write_Line (""",");
+
+            Write_Str ("      ""mechanism"": """);
+            Write_Mechanism (Mechanism (Form));
+            Write_Line ("""");
+            Write_Str ("    }");
+         else
             while Name_Len <= Plen loop
                Name_Len := Name_Len + 1;
                Name_Buffer (Name_Len) := ' ';
@@ -826,18 +941,37 @@ package body Repinfo is
 
             Write_Mechanism (Mechanism (Form));
             Write_Eol;
+         end if;
+
          Next_Formal (Form);
       end loop;
 
+      if List_Representation_Info_To_JSON then
+         Write_Eol;
+         Write_Str ("  ]");
+      end if;
+
       if Etype (Ent) /= Standard_Void_Type then
+         if List_Representation_Info_To_JSON then
+            Write_Line (",");
+            Write_Str ("  ""mechanism"": """);
+            Write_Mechanism (Mechanism (Ent));
+            Write_Str ("""");
+         else
             Write_Str ("returns by ");
             Write_Mechanism (Mechanism (Ent));
             Write_Eol;
          end if;
+      end if;
 
       if not Is_Entry (Ent) then
          List_Linker_Section (Ent);
       end if;
+
+      if List_Representation_Info_To_JSON then
+         Write_Eol;
+         Write_Line ("}");
+      end if;
    end List_Mechanisms;
 
    ---------------
@@ -846,7 +980,14 @@ package body Repinfo is
 
    procedure List_Name (Ent : Entity_Id) is
    begin
-      if not Is_Compilation_Unit (Scope (Ent)) then
+      --  List the qualified name recursively, except
+      --  at compilation unit level in default mode.
+
+      if Is_Compilation_Unit (Ent) then
+         null;
+      elsif not Is_Compilation_Unit (Scope (Ent))
+        or else List_Representation_Info_To_JSON
+      then
          List_Name (Scope (Ent));
          Write_Char ('.');
       end if;
@@ -864,6 +1005,26 @@ package body Repinfo is
    begin
       Blank_Line;
 
+      if List_Representation_Info_To_JSON then
+         Write_Line ("{");
+
+         Write_Str ("  ""name"": """);
+         List_Name (Ent);
+         Write_Line (""",");
+         List_Location (Ent);
+
+         Write_Str ("  ""Size"": ");
+         Write_Val (Esize (Ent));
+         Write_Line (",");
+
+         Write_Str ("  ""Alignment"": ");
+         Write_Val (Alignment (Ent));
+
+         List_Linker_Section (Ent);
+
+         Write_Eol;
+         Write_Line ("}");
+      else
          Write_Str ("for ");
          List_Name (Ent);
          Write_Str ("'Size use ");
@@ -877,6 +1038,7 @@ package body Repinfo is
          Write_Line (";");
 
          List_Linker_Section (Ent);
+      end if;
    end List_Object_Info;
 
    ----------------------
@@ -895,7 +1057,8 @@ package body Repinfo is
         (Ent                : Entity_Id;
          Starting_Position  : Uint := Uint_0;
          Starting_First_Bit : Uint := Uint_0;
-         Prefix             : String := "");
+         Prefix             : String := "";
+         Indent             : Natural := 0);
       --  Procedure to display the layout of a single component
 
       procedure List_Record_Layout
@@ -905,6 +1068,12 @@ package body Repinfo is
          Prefix             : String := "");
       --  Internal recursive procedure to display the layout
 
+      procedure List_Structural_Record_Layout
+        (Ent     : Entity_Id;
+         Variant : Node_Id := Empty;
+         Indent  : Natural := 0);
+      --  Internal recursive procedure to display the structural layout
+
       Max_Name_Length : Natural := 0;
       Max_Spos_Length : Natural := 0;
 
@@ -1017,7 +1186,8 @@ package body Repinfo is
         (Ent                : Entity_Id;
          Starting_Position  : Uint := Uint_0;
          Starting_First_Bit : Uint := Uint_0;
-         Prefix             : String := "")
+         Prefix             : String := "";
+         Indent             : Natural := 0)
       is
          Esiz  : constant Uint := Esize (Ent);
          Npos  : constant Uint := Normalized_Position (Ent);
@@ -1027,11 +1197,23 @@ package body Repinfo is
          Lbit  : Uint;
 
       begin
+         if List_Representation_Info_To_JSON then
+            Spaces (Indent);
+            Write_Line ("    {");
+            Spaces (Indent);
+            Write_Str ("      ""name"": """);
+            Write_Str (Prefix);
+            Write_Str (Name_Buffer (1 .. Name_Len));
+            Write_Line (""",");
+            Spaces (Indent);
+            Write_Str ("      ""Position"": ");
+         else
             Write_Str ("   ");
             Write_Str (Prefix);
             Write_Str (Name_Buffer (1 .. Name_Len));
             Spaces (Max_Name_Length - Prefix'Length - Name_Len);
             Write_Str (" at ");
+         end if;
 
          if Known_Static_Normalized_Position (Ent) then
             Spos := Starting_Position  + Npos;
@@ -1061,7 +1243,14 @@ package body Repinfo is
             Write_Unknown_Val;
          end if;
 
+         if List_Representation_Info_To_JSON then
+            Write_Line (",");
+            Spaces (Indent);
+            Write_Str ("      ""First_Bit"": ");
+         else
             Write_Str (" range  ");
+         end if;
+
          Sbit := Starting_First_Bit + Fbit;
 
          if Sbit >= SSU then
@@ -1069,7 +1258,14 @@ package body Repinfo is
          end if;
 
          UI_Write (Sbit);
+
+         if List_Representation_Info_To_JSON then
+            Write_Line (", ");
+            Spaces (Indent);
+            Write_Str ("      ""Size"": ");
+         else
             Write_Str (" .. ");
+         end if;
 
          --  Allowing Uint_0 here is an annoying special case. Really
          --  this should be a fine Esize value but currently it means
@@ -1082,11 +1278,15 @@ package body Repinfo is
          then
             Lbit := Sbit + Esiz - 1;
 
+            if List_Representation_Info_To_JSON then
+               UI_Write (Esiz);
+            else
                if Lbit < 10 then
                   Write_Char (' ');
                end if;
 
                UI_Write (Lbit);
+            end if;
 
          --  The test for Esize (Ent) not Uint_0 here is an annoying
          --  special case. Officially a value of zero for Esize means
@@ -1102,7 +1302,7 @@ package body Repinfo is
          --  List_Representation >= 3 and Known_Esize (Ent)
 
          else
-            Write_Val (Esiz, Paren => True);
+            Write_Val (Esiz, Paren => not List_Representation_Info_To_JSON);
 
             --  If in front end layout mode, then dynamic size is stored
             --  in storage units, so renormalize for output
@@ -1114,6 +1314,7 @@ package body Repinfo is
 
             --  Add appropriate first bit offset
 
+            if not List_Representation_Info_To_JSON then
                if Sbit = 0 then
                   Write_Str (" - 1");
 
@@ -1125,8 +1326,15 @@ package body Repinfo is
                   Write_Int (UI_To_Int (Sbit) - 1);
                end if;
             end if;
+         end if;
 
+         if List_Representation_Info_To_JSON then
+            Write_Eol;
+            Spaces (Indent);
+            Write_Str ("    }");
+         else
             Write_Line (";");
+         end if;
       end List_Component_Layout;
 
       ------------------------
@@ -1203,15 +1411,180 @@ package body Repinfo is
          end loop;
       end List_Record_Layout;
 
+      -----------------------------------
+      -- List_Structural_Record_Layout --
+      -----------------------------------
+
+      procedure List_Structural_Record_Layout
+        (Ent     : Entity_Id;
+         Variant : Node_Id := Empty;
+         Indent  : Natural := 0)
+      is
+         Comp       : Node_Id;
+         Comp_List  : Node_Id;
+         Var        : Node_Id;
+         First      : Boolean := True;
+
+      begin
+         --  If we are dealing with a variant, just process the components
+
+         if Present (Variant) then
+            Comp_List := Component_List (Variant);
+
+         --  Otherwise, we are dealing with the full record and need to get
+         --  to its definition in order to retrieve its structural layout.
+
+         else
+            declare
+               Definition : Node_Id :=
+                 Type_Definition (Declaration_Node (Ent));
+               Is_Extension : constant Boolean :=
+                 Is_Tagged_Type (Ent)
+                   and then
+                 Nkind (Definition) = N_Derived_Type_Definition;
+               Disc : Entity_Id;
+            begin
+               --  If this is an extension, first list the layout of the parent
+               --  and then proceed to the extension part, if any.
+
+               if Is_Extension then
+                  List_Structural_Record_Layout
+                    (Base_Type (Parent_Subtype (Ent)), Variant, Indent);
+
+                  if Present (Record_Extension_Part (Definition)) then
+                     Definition := Record_Extension_Part (Definition);
+                  end if;
+               end if;
+
+               --  If the record has discriminants and is not an unchecked
+               --  union, then display them now.
+
+               if Has_Discriminants (Ent)
+                 and then not Is_Unchecked_Union (Ent)
+               then
+                  Disc := First_Stored_Discriminant (Ent);
+                  while Present (Disc) loop
+
+                     --  If this is a record extension and the discriminant is
+                     --  the renaming of another discriminant, skip it.
+
+                     if Is_Extension
+                       and then Present (Corresponding_Discriminant (Disc))
+                     then
+                        goto Continue_Disc;
+                     end if;
+
+                     Get_Decoded_Name_String (Chars (Disc));
+                     Set_Casing (Unit_Casing);
+
+                     if First then
+                        Write_Eol;
+                        First := False;
+                     else
+                        Write_Line (",");
+                     end if;
+
+                     List_Component_Layout (Disc, Indent => Indent);
+
+                  <<Continue_Disc>>
+                     Next_Stored_Discriminant (Disc);
+                  end loop;
+               end if;
+
+               Comp_List := Component_List (Definition);
+            end;
+         end if;
+
+         --  Bail out for the null record
+
+         if No (Comp_List) then
+            return;
+         end if;
+
+         --  Now deal with the regular components, if any
+
+         if Present (Component_Items (Comp_List)) then
+            Comp := First_Non_Pragma (Component_Items (Comp_List));
+            while Present (Comp) loop
+
+               --  Skip _Parent component in extension (to avoid overlap)
+
+               if Chars (Defining_Identifier (Comp)) = Name_uParent then
+                  goto Continue_Comp;
+               end if;
+
+               Get_Decoded_Name_String (Chars (Defining_Identifier (Comp)));
+               Set_Casing (Unit_Casing);
+
+               if First then
+                  Write_Eol;
+                  First := False;
+               else
+                  Write_Line (",");
+               end if;
+
+               List_Component_Layout
+                 (Defining_Identifier (Comp), Indent => Indent);
+
+            <<Continue_Comp>>
+               Next_Non_Pragma (Comp);
+            end loop;
+         end if;
+
+         --  We are done if there is no variant part
+
+         if No (Variant_Part (Comp_List)) then
+            return;
+         end if;
+
+         Write_Eol;
+         Spaces (Indent);
+         Write_Line ("  ],");
+         Spaces (Indent);
+         Write_Str ("  ""variant"" : [");
+
+         --  Otherwise we recurse on each variant
+
+         Var := First_Non_Pragma (Variants (Variant_Part (Comp_List)));
+         First := True;
+         while Present (Var) loop
+            if First then
+               Write_Eol;
+               First := False;
+            else
+               Write_Line (",");
+            end if;
+
+            Spaces (Indent);
+            Write_Line ("    {");
+            Spaces (Indent);
+            Write_Str ("      ""present"": ");
+            Write_Val (Present_Expr (Var));
+            Write_Line (",");
+            Spaces (Indent);
+            Write_Str ("      ""record"": [");
+
+            List_Structural_Record_Layout (Ent, Var, Indent + 4);
+
+            Write_Eol;
+            Spaces (Indent);
+            Write_Line ("      ]");
+            Spaces (Indent);
+            Write_Str ("    }");
+            Next_Non_Pragma (Var);
+         end loop;
+      end List_Structural_Record_Layout;
+
    --  Start of processing for List_Record_Info
 
    begin
       Blank_Line;
-      List_Type_Info (Ent);
 
-      Write_Str ("for ");
-      List_Name (Ent);
-      Write_Line (" use record");
+      if List_Representation_Info_To_JSON then
+         Write_Line ("{");
+      end if;
+
+      List_Type_Info (Ent);
 
       --  First find out max line length and max starting position
       --  length, for the purpose of lining things up nicely.
@@ -1220,13 +1593,32 @@ package body Repinfo is
 
       --  Then do actual output based on those values
 
+      if List_Representation_Info_To_JSON then
+         Write_Line (",");
+         Write_Str ("  ""record"": [");
+
+         List_Structural_Record_Layout (Ent);
+
+         Write_Eol;
+         Write_Str ("  ]");
+      else
+         Write_Str ("for ");
+         List_Name (Ent);
+         Write_Line (" use record");
+
          List_Record_Layout (Ent);
 
          Write_Line ("end record;");
+      end if;
 
       List_Scalar_Storage_Order (Ent, Bytes_Big_Endian);
 
       List_Linker_Section (Ent);
+
+      if List_Representation_Info_To_JSON then
+         Write_Eol;
+         Write_Line ("}");
+      end if;
    end List_Record_Info;
 
    -------------------
@@ -1246,7 +1638,9 @@ package body Repinfo is
 
                --  Normal case, list to standard output
 
-               if not List_Representation_Info_To_File then
+               if not List_Representation_Info_To_File
+                 and then not List_Representation_Info_To_JSON
+               then
                   Write_Eol;
                   Write_Str ("Representation information for unit ");
                   Write_Unit_Name (Unit_Name (U));
@@ -1294,9 +1688,14 @@ package body Repinfo is
 
       procedure List_Attr (Attr_Name : String; Is_Reversed : Boolean) is
       begin
+         if List_Representation_Info_To_JSON then
+            Write_Line (",");
+            Write_Str ("  """ & Attr_Name & """: ""System.");
+         else
             Write_Str ("for ");
             List_Name (Ent);
             Write_Str ("'" & Attr_Name & " use System.");
+         end if;
 
          if Bytes_Big_Endian xor Is_Reversed then
             Write_Str ("High");
@@ -1304,7 +1703,12 @@ package body Repinfo is
             Write_Str ("Low");
          end if;
 
-         Write_Line ("_Order_First;");
+         Write_Str ("_Order_First");
+         if List_Representation_Info_To_JSON then
+            Write_Str ("""");
+         else
+            Write_Line (";");
+         end if;
       end List_Attr;
 
       List_SSO : constant Boolean :=
@@ -1342,6 +1746,13 @@ package body Repinfo is
 
    procedure List_Type_Info (Ent : Entity_Id) is
    begin
+      if List_Representation_Info_To_JSON then
+         Write_Str ("  ""name"": """);
+         List_Name (Ent);
+         Write_Line (""",");
+         List_Location (Ent);
+      end if;
+
       --  Do not list size info for unconstrained arrays, not meaningful
 
       if Is_Array_Type (Ent) and then not Is_Constrained (Ent) then
@@ -1352,15 +1763,31 @@ package body Repinfo is
          --  case, which we may as well list in simple form.
 
          if Esize (Ent) = RM_Size (Ent) then
+            if List_Representation_Info_To_JSON then
+               Write_Str ("  ""Size"": ");
+               Write_Val (Esize (Ent));
+               Write_Line (",");
+            else
                Write_Str ("for ");
                List_Name (Ent);
                Write_Str ("'Size use ");
                Write_Val (Esize (Ent));
                Write_Line (";");
+            end if;
 
          --  Otherwise list size values separately
 
          else
+            if List_Representation_Info_To_JSON then
+               Write_Str ("  ""Object_Size"": ");
+               Write_Val (Esize (Ent));
+               Write_Line (",");
+
+               Write_Str ("  ""Value_Size"": ");
+               Write_Val (RM_Size (Ent));
+               Write_Line (",");
+
+            else
                Write_Str ("for ");
                List_Name (Ent);
                Write_Str ("'Object_Size use ");
@@ -1374,12 +1801,18 @@ package body Repinfo is
                Write_Line (";");
             end if;
          end if;
+      end if;
 
+      if List_Representation_Info_To_JSON then
+         Write_Str ("  ""Alignment"": ");
+         Write_Val (Alignment (Ent));
+      else
          Write_Str ("for ");
          List_Name (Ent);
          Write_Str ("'Alignment use ");
          Write_Val (Alignment (Ent));
          Write_Line (";");
+      end if;
 
       --  Special stuff for fixed-point
 
@@ -1387,11 +1820,17 @@ package body Repinfo is
 
          --  Write small (always a static constant)
 
+         if List_Representation_Info_To_JSON then
+            Write_Line (",");
+            Write_Str ("  ""Small"": ");
+            UR_Write (Small_Value (Ent));
+         else
             Write_Str ("for ");
             List_Name (Ent);
             Write_Str ("'Small use ");
             UR_Write (Small_Value (Ent));
             Write_Line (";");
+         end if;
 
          --  Write range if static
 
@@ -1403,6 +1842,14 @@ package body Repinfo is
                  and then
                Nkind (High_Bound (R)) = N_Real_Literal
             then
+               if List_Representation_Info_To_JSON then
+                  Write_Line (",");
+                  Write_Str ("  ""Range"": [ ");
+                  UR_Write (Realval (Low_Bound (R)));
+                  Write_Str (", ");
+                  UR_Write (Realval (High_Bound (R)));
+                  Write_Str (" ]");
+               else
                   Write_Str ("for ");
                   List_Name (Ent);
                   Write_Str ("'Range use ");
@@ -1411,6 +1858,7 @@ package body Repinfo is
                   UR_Write (Realval (High_Bound (R)));
                   Write_Line (";");
                end if;
+            end if;
          end;
       end if;
    end List_Type_Info;
@@ -1695,7 +2143,11 @@ package body Repinfo is
 
    procedure Write_Unknown_Val is
    begin
+      if List_Representation_Info_To_JSON then
+         Write_Str ("""??""");
+      else
          Write_Str ("??");
+      end if;
    end Write_Unknown_Val;
 
    ---------------

gcc/ada/repinfo.ads

@@ -141,48 +141,143 @@ package Repinfo is
    --  tree.def. Only a subset of these tree codes can actually appear.
    --  The names are the names from tree.def in Ada casing.
 
-   --  name                             code   description           operands
-
-   Cond_Expr        : constant TCode :=  1; -- conditional              3
-   Plus_Expr        : constant TCode :=  2; -- addition                 2
-   Minus_Expr       : constant TCode :=  3; -- subtraction              2
-   Mult_Expr        : constant TCode :=  4; -- multiplication           2
-   Trunc_Div_Expr   : constant TCode :=  5; -- truncating division      2
-   Ceil_Div_Expr    : constant TCode :=  6; -- division rounding up     2
-   Floor_Div_Expr   : constant TCode :=  7; -- division rounding down   2
-   Trunc_Mod_Expr   : constant TCode :=  8; -- mod for trunc_div        2
-   Ceil_Mod_Expr    : constant TCode :=  9; -- mod for ceil_div         2
-   Floor_Mod_Expr   : constant TCode := 10; -- mod for floor_div        2
-   Exact_Div_Expr   : constant TCode := 11; -- exact division           2
-   Negate_Expr      : constant TCode := 12; -- negation                 1
-   Min_Expr         : constant TCode := 13; -- minimum                  2
-   Max_Expr         : constant TCode := 14; -- maximum                  2
-   Abs_Expr         : constant TCode := 15; -- absolute value           1
-   Truth_And_Expr   : constant TCode := 16; -- boolean and              2
-   Truth_Or_Expr    : constant TCode := 17; -- boolean or               2
-   Truth_Xor_Expr   : constant TCode := 18; -- boolean xor              2
-   Truth_Not_Expr   : constant TCode := 19; -- boolean not              1
-   Lt_Expr          : constant TCode := 20; -- comparison <             2
-   Le_Expr          : constant TCode := 21; -- comparison <=            2
-   Gt_Expr          : constant TCode := 22; -- comparison >             2
-   Ge_Expr          : constant TCode := 23; -- comparison >=            2
-   Eq_Expr          : constant TCode := 24; -- comparison =             2
-   Ne_Expr          : constant TCode := 25; -- comparison /=            2
-   Bit_And_Expr     : constant TCode := 26; -- bitwise and              2
+   --  name                             code   description     operands  symbol
+
+   Cond_Expr        : constant TCode :=  1; -- conditional          3      ?<>
+   Plus_Expr        : constant TCode :=  2; -- addition             2        +
+   Minus_Expr       : constant TCode :=  3; -- subtraction          2        -
+   Mult_Expr        : constant TCode :=  4; -- multiplication       2        *
+   Trunc_Div_Expr   : constant TCode :=  5; -- truncating div       2       /t
+   Ceil_Div_Expr    : constant TCode :=  6; -- div rounding up      2       /c
+   Floor_Div_Expr   : constant TCode :=  7; -- div rounding down    2       /f
+   Trunc_Mod_Expr   : constant TCode :=  8; -- mod for trunc_div    2     modt
+   Ceil_Mod_Expr    : constant TCode :=  9; -- mod for ceil_div     2     modc
+   Floor_Mod_Expr   : constant TCode := 10; -- mod for floor_div    2     modf
+   Exact_Div_Expr   : constant TCode := 11; -- exact div            2       /e
+   Negate_Expr      : constant TCode := 12; -- negation             1        -
+   Min_Expr         : constant TCode := 13; -- minimum              2      min
+   Max_Expr         : constant TCode := 14; -- maximum              2      max
+   Abs_Expr         : constant TCode := 15; -- absolute value       1      abs
+   Truth_And_Expr   : constant TCode := 16; -- boolean and          2      and
+   Truth_Or_Expr    : constant TCode := 17; -- boolean or           2       or
+   Truth_Xor_Expr   : constant TCode := 18; -- boolean xor          2      xor
+   Truth_Not_Expr   : constant TCode := 19; -- boolean not          1      not
+   Lt_Expr          : constant TCode := 20; -- comparison <         2        <
+   Le_Expr          : constant TCode := 21; -- comparison <=        2       <=
+   Gt_Expr          : constant TCode := 22; -- comparison >         2        >
+   Ge_Expr          : constant TCode := 23; -- comparison >=        2       >=
+   Eq_Expr          : constant TCode := 24; -- comparison =         2       ==
+   Ne_Expr          : constant TCode := 25; -- comparison /=        2       !=
+   Bit_And_Expr     : constant TCode := 26; -- bitwise and          2        &
 
    --  The following entry is used to represent a discriminant value in
    --  the tree. It has a special tree code that does not correspond
    --  directly to a GCC node. The single operand is the index number
    --  of the discriminant in the record (1 = first discriminant).
 
-   Discrim_Val      : constant TCode :=  0;  -- discriminant value      1
+   Discrim_Val      : constant TCode :=  0;  -- discriminant value  1        #
 
    --  The following entry is used to represent a value not known at
    --  compile time in the tree, other than a discriminant value. It
    --  has a special tree code that does not correspond directly to
    --  a GCC node. The single operand is an arbitrary index number.
 
-   Dynamic_Val      : constant TCode := 27;  -- dynamic value           1
+   Dynamic_Val      : constant TCode := 27;  -- dynamic value       1      var
+
+   ----------------------------
+   -- The JSON output format --
+   ----------------------------
+
+   --  The representation information can be output to a file in the JSON
+   --  data interchange format specified by the ECMA-404 standard. In the
+   --  following description, the terminology is that of the JSON syntax
+   --  from the ECMA document and of the JSON grammar from www.json.org.
+
+   --  The output is a concatenation of entities
+
+   --  An entity is an object whose members are pairs taken from:
+
+   --    "name"                 :  string
+   --    "location"             :  string
+   --    "record"               :  array of components
+   --    "variant"              :  array of variants
+   --    "formal"               :  array of formal parameters
+   --    "mechanism"            :  string
+   --    "Size"                 :  numerical expression
+   --    "Object_Size"          :  numerical expression
+   --    "Value_Size"           :  numerical expression
+   --    "Component_Size"       :  numerical expression
+   --    "Range"                :  array of numbers
+   --    "Small"                :  number
+   --    "Alignment"            :  number
+   --    "Convention"           :  string
+   --    "Linker_Section"       :  string
+   --    "Bit_Order"            :  string
+   --    "Scalar_Storage_Order" :  string
+
+   --    "name" and "location" are present for every entity and come from the
+   --    declaration of the associated Ada entity. The value of "name" is the
+   --    fully qualified Ada name. The value of "location" is the expanded
+   --    chain of instantiation locations that contains the entity.
+   --    "record" is present for every record type and its value is the list of
+   --    components. "variant" is present only if the record type has a variant
+   --    part and its value is the list of variants.
+   --    "formal" is present for every subprogram and entry, and its value is
+   --    the list of formal parameters. "mechanism" is present for functions
+   --    only and its value is the return mechanim.
+   --    The other pairs may be present when the eponymous aspect/attribute is
+   --    defined for the Ada entity, and their value is set by the language.
+
+   --  A component is an object whose members are pairs taken from:
+
+   --    "name"                 :  string
+   --    "Position"             :  numerical expression
+   --    "First_Bit"            :  number
+   --    "Size"                 :  numerical expression
+
+   --    The four pairs are present for every component. "name" comes from the
+   --    declaration of the component in the record type and its value is the
+   --    unqualified Ada name. The other three pairs come from the layout of
+   --    the type and their value is that of the eponymous attribute set by
+   --    the language.
+
+   --  A variant is an object whose members are pairs taken from:
+
+   --    "present"              :  numerical expression
+   --    "record"               :  array of components
+   --    "variant"              :  array of variants
+
+   --    "present" and "record" are present for every variant. The value of
+   --    "present" is a boolean expression that evaluates to true when the
+   --    components of the variant are contained in the record type and to
+   --    false when they are not. The value of "record" is the list of
+   --    components in the variant. "variant" is present only if the variant
+   --    itself has a variant part and its value is the list of (sub)variants.
+
+   --  A formal parameter is an object whose members are pairs taken from:
+
+   --    "name"                 :  string
+   --    "mechanism"            :  string
+
+   --    The two pairs are present for every formal parameter. "name" comes
+   --    from the declaration of the parameter in the subprogram or entry
+   --    and its value is the unqualified Ada name. The value of "mechanism"
+   --    is the passing mechanism for the parameter set by the language.
+
+   --  A numerical expression is either a number or an object whose members
+   --  are pairs taken from:
+
+   --    "code"                 :  string
+   --    "operands"             :  array of numerical expressions
+
+   --    The two pairs are present for every such object. The value of "code"
+   --    is a symbol taken from the table defining the TCode type above. The
+   --    number of elements of the value of "operands" is specified by the
+   --    operands column in the line associated with the symbol in the table.
+
+   --    As documented above, the full back annotation is only done in -gnatR3
+   --    or ASIS mode. In the other cases, if the numerical expression is not
+   --    a number, then it is replaced with the "??" string.
 
    ------------------------
    -- The gigi Interface --

gcc/ada/switch-c.adb

@@ -1211,6 +1211,9 @@ package body Switch.C is
                   when 's' =>
                      List_Representation_Info_To_File := True;
 
+                  when 'j' =>
+                     List_Representation_Info_To_JSON := True;
+
                   when 'm' =>
                      List_Representation_Info_Mechanisms := True;
 
@@ -1224,6 +1227,14 @@ package body Switch.C is
                   Ptr := Ptr + 1;
                end loop;
 
+               if List_Representation_Info_To_JSON then
+                  if List_Representation_Info_To_File then
+                     Osint.Fail ("-gnatRs is incompatible with -gnatRj");
+                  elsif List_Representation_Info_Extended then
+                     Osint.Fail ("-gnatRe is incompatible with -gnatRj");
+                  end if;
+               end if;
+
             --  -gnats (syntax check only)
 
             when 's' =>

gcc/ada/usage.adb

@@ -405,6 +405,8 @@ begin
      ("List rep info (?=0/1/2/3/e/m for none/types/all/symbolic/ext/mech)");
    Write_Switch_Char ("R?s");
    Write_Line ("List rep info to file.rep instead of standard output");
+   Write_Switch_Char ("R?j");
+   Write_Line ("List rep info to file.json instead of standard output");
 
    --  Line for -gnats switch