Replace Irep JSON-wrapper with a recursive datatype

This uses containers-of-pointers because Ada recursive containers
appear to be quite difficult.

Author: smowton

gnat2goto/driver/tree_walk.adb

@@ -3,8 +3,6 @@ with Stand;  use Stand;
 with Treepr; use Treepr;
 with Namet;  use Namet;
 
-with GNATCOLL.JSON; use GNATCOLL.JSON;
-
 with Iinfo; use Iinfo;
 with Irep_Helpers; use Irep_Helpers;
 with Uint_To_Binary; use Uint_To_Binary;
@@ -227,9 +225,7 @@ package body Tree_Walk is
                   else Make_Irep_Code_Block);
 
       -- Append the HSS_Rep block to the Decls_Rep one:
-      for I in Integer range 1 .. Length (HSS_Rep.Sub) loop
-	 Append (Decls_Rep.Sub, Get (HSS_Rep.Sub, I));
-      end loop;
+      Irep_Vectors.Append (Decls_Rep.Sub, HSS_Rep.Sub);
       return Decls_Rep;
    end Do_Subprogram_Or_Block;
 

irep_utils/src/iinfo.adb

@@ -32,15 +32,34 @@ package body Iinfo is
    end Trivial;
 
    function Irep_To_Json (Ir : Irep) return JSON_Value is
-      ToRet : JSON_Value := Create_Object;
-
+      Ret_Sub : JSON_Array := Empty_Array;
+      Ret_Named_Sub : JSON_Value := Create_Object;
+      Ret_Comment : JSON_Value := Create_Object;
    begin
+      for Sub of Ir.Sub loop
+         Append (Ret_Sub, Irep_To_Json (Sub.All));
+      end loop;
+      for C in Ir.Named_Sub.Iterate loop
+         Set_Field (Ret_Named_Sub, To_String (Irep_Maps.Key (C)), Irep_To_Json (Irep_Maps.Element (C).All));
+      end loop;
+      for C in Ir.Comment.Iterate loop
+         Set_Field (Ret_Comment, To_String (Irep_Maps.Key (C)), Irep_To_Json (Irep_Maps.Element (C).All));
+      end loop;
+
       return R : Json_Value := Create_Object do
         R.Set_Field ("id", Ir.Id);
-        R.Set_Field ("sub", Ir.Sub);
-        R.Set_Field ("namedSub", Ir.Named_Sub);
-        R.Set_Field ("comment", Ir.Comment);
+        R.Set_Field ("sub", Ret_Sub);
+        R.Set_Field ("namedSub", Ret_Named_Sub);
+        R.Set_Field ("comment", Ret_Comment);
       end return;
    end Irep_To_Json;
 
+   function Alloc_Clone (Ir : Irep) return Irep_Ptr is
+   begin
+      return new Irep'(Id =>        Ir.Id,
+                       Sub =>       Ir.Sub,
+                       Named_Sub => Ir.Named_Sub,
+                       Comment =>   Ir.Comment);
+   end Alloc_Clone;
+
 end Iinfo;

irep_utils/src/iinfo.ads

@@ -1,13 +1,29 @@
-with GNATCOLL.JSON;         use GNATCOLL.JSON;
-with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+with GNATCOLL.JSON;              use GNATCOLL.JSON;
+with Ada.Strings.Unbounded;      use Ada.Strings.Unbounded;
+with Ada.Strings.Unbounded.Hash;
+with Ada.Containers.Vectors;
+with Ada.Containers.Hashed_Maps;
 
 package Iinfo is
 
+   type Irep;
+   type Irep_Ptr is access Irep;
+
+   package Irep_Maps is new Ada.Containers.Hashed_Maps
+     (Key_Type        => Unbounded_String,
+      Element_Type    => Irep_Ptr,
+      Hash            => Ada.Strings.Unbounded.Hash,
+      Equivalent_Keys => "=");
+
+   package Irep_Vectors is new Ada.Containers.Vectors
+     (Element_Type => Irep_Ptr,
+      Index_Type   => Positive);
+
    type Irep is record
       Id        : Unbounded_String;
-      Sub       : JSON_Array := Empty_Array;
-      Named_Sub : JSON_Value := Create_Object;
-      Comment   : JSON_Value := Create_Object;
+      Sub       : Irep_Vectors.Vector;
+      Named_Sub : Irep_Maps.Map;
+      Comment   : Irep_Maps.Map;
    end record;
 
    package Trivial is
@@ -18,5 +34,6 @@ package Iinfo is
    end Trivial;
 
    function Irep_To_Json (Ir : Irep) return JSON_Value;
+   function Alloc_Clone (Ir : Irep) return Irep_Ptr;
 
 end Iinfo;

irep_utils/src/irep_helpers.adb

@@ -1,12 +1,16 @@
 
 with GNATCOLL.JSON; use GNATCOLL.JSON;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
 with Iinfo; use Iinfo;
+with Irep_Schemata; use Irep_Schemata;
 
 package body Irep_Helpers is
-   
+
    function To_Code_Block (Input : Irep_Code) return Irep_Code_Block is
       -- TODO: auto-synthesise getters
-      Input_Statement : constant String := Get (Get (Input.Named_Sub, "statement"), "id");
+      Statement_Irep : constant Irep :=
+        Irep_Maps.Element (Input.Named_Sub, To_Unbounded_String ("statement")).all;
+      Input_Statement : constant Unbounded_String := Statement_Irep.Id;
    begin
       if (Input_Statement = "block") then
 	 return Irep_Code_Block (Input);

irep_utils/src/irep_specs_to_ada.py

@@ -14,20 +14,19 @@
 outbody = open(sys.argv[2] + ".adb", "w")
 
 outspec.write("with Iinfo;         use Iinfo;\n")
-outspec.write("with GNATCOLL.JSON; use GNATCOLL.JSON;\n")
 outspec.write("\n")
 outspec.write("package Irep_Schemata is\n")
 
-outbody.write("with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;\n")
+outbody.write("with Ada.Strings.Unbounded;      use Ada.Strings.Unbounded;\n")
 outbody.write("\n")
 outbody.write("package body Irep_Schemata is\n")
 
 def write_set_field(obj, field, value, indent_lvl=0):
-    rv = (indent * indent_lvl) + "Set_Field ("
+    rv = (indent * indent_lvl) + "Irep_Maps.Insert ("
     offset = len(rv)
     rv += obj + ",\n"
-    rv += (" " * offset) + '"%s",\n' % field
-    rv += (" " * offset) + 'Irep_To_Json (%s));\n' % value
+    rv += (" " * offset) + 'To_Unbounded_String ("%s"),\n' % field
+    rv += (" " * offset) + 'Alloc_Clone (%s));\n' % value
     return rv
 
 def to_ada_identifier(s):
@@ -120,15 +119,15 @@ def ada_from_schema(schema_name, schema):
                 continue
 
             for subname in subnames:
-                body = "Set_Element (Irep_To_Modify.Sub, %d, Irep_To_Json (%s));" % \
+                body = "Irep_Vectors.Replace_Element (Irep_To_Modify.Sub, %d, Alloc_Clone (%s));" % \
                        (i + 1, ada_argument_conversion_from_schema(sub, "Value"))
                 write_set_method(subname, schema_name, ada_type_from_schema(sub), body)
 
                 if "number" in sub:
                     assert sub["number"] == "*"
                     body = "Irep_To_Modify.Sub := Value;"
-                    write_set_method(subname + "s", schema_name, "JSON_Array", body)
-                    add_body = "Append (Irep_To_Modify.Sub, Irep_To_Json (%s));" % \
+                    write_set_method(subname + "s", schema_name, "Irep_Vectors.Vector", body)
+                    add_body = "Irep_Vectors.Append (Irep_To_Modify.Sub, Alloc_Clone (%s));" % \
                                (ada_argument_conversion_from_schema(sub, "Value"))
                     write_mutator_method("Add", subname, schema_name, ada_type_from_schema(sub), add_body)
 
@@ -206,7 +205,7 @@ def get_constant_assignments(schema):
     if n_required_operands != 0:
         outbody.write(indent + indent + "--  Add null values for required operands\n")
     for i in range(n_required_operands):
-        outbody.write(indent + indent + "Append (Ret.Sub, Irep_To_Json (Trivial.Trivial_Irep (\"\")));\n")
+        outbody.write(indent + indent + "Irep_Vectors.Append (Ret.Sub, Alloc_Clone (Trivial.Trivial_Irep (\"\")));\n")
     constant_assignments = get_constant_assignments(schema)
     if len(constant_assignments) != 0:
         outbody.write(indent + indent + "--  Set constant members:\n")