How can I find the `'First` and `'Last` expressions for a string field in a record using ASIS

Question

I'm using ASIS to analyse a big Ada project. One of the things I need to do is to find the 'First and 'Last expressions for a string field in a record variable.

My problem occurs when I have a Discrete_Range, which is not A_Discrete_Simple_Expression_Range (for which one can use the functions Lower_Bound and Upper_Bound directly), but instead A_Discrete_Range_Attribute_Reference.

The source example which I'm analysing basically looks like this:

with Ada.Text_IO;
procedure Minimal_Example is
   type R is
      record
         F : String (1 .. 5);
      end record;
   V : R;
   subtype S is String (V.F'Range); --  It would have been nice if they didn't do like this.
   function F return S is ("12345");
begin
   Ada.Text_IO.Put_Line (F);
end Minimal_Example;

Here is a minimised version of the program I use to perform the analysis:

--  Standard library packages:
with Ada.Wide_Text_IO;

--  ASIS packages:
with Asis;
with Asis.Ada_Environments;
with Asis.Compilation_Units;
with Asis.Declarations;
with Asis.Definitions;
with Asis.Elements;
with Asis.Expressions;
with Asis.Implementation;
with Asis.Iterator;
with Asis.Statements;
with Asis.Text;

procedure Minimal_Analyzer is

  procedure Pre_Operation (Element : in     Asis.Element;
                           Control : in out Asis.Traverse_Control;
                           State   : in out Boolean) is
    pragma Unreferenced (Control, State);

    use all type Asis.Element_Kinds;
    use all type Asis.Statement_Kinds;
  begin
    if Asis.Elements.Element_Kind (Element) = A_Statement and then
       Asis.Elements.Statement_Kind (Element) = A_Procedure_Call_Statement
    then
      for Parameter_Association of Asis.Statements.Call_Statement_Parameters (Statement  => Element,
                                                                              Normalized => True) loop
        declare
          Actual_Parameter   : Asis.Element;
          Type_Of_Expression : Asis.Element;
          Type_Definition    : Asis.Definition;
          Constraint         : Asis.Constraint;
        begin
          Actual_Parameter   := Asis.Expressions.Actual_Parameter (Parameter_Association);
          Type_Of_Expression := Asis.Expressions.Corresponding_Expression_Type (Actual_Parameter);
          Type_Definition    := Asis.Declarations.Type_Declaration_View (Declaration => Type_Of_Expression);
          Constraint         := Asis.Definitions.Subtype_Constraint (Type_Definition);

          for Index_Range of Asis.Definitions.Discrete_Ranges (Constraint) loop
            declare
              Range_Attribute : Asis.Definition;
              Range_Prefix    : Asis.Element;
            begin
              Range_Attribute := Asis.Definitions.Range_Attribute (Index_Range);
              Range_Prefix    := Asis.Expressions.Prefix (Range_Attribute);

              Ada.Wide_Text_IO.Put_Line (Asis.Elements.Debug_Image (Range_Prefix));
              Ada.Wide_Text_IO.Put_Line (Asis.Text.Element_Image (Range_Prefix));
            end;
          end loop;
        end;
      end loop;
    end if;
  end Pre_Operation;

  procedure Post_Operation (Element : in     Asis.Element;
                            Control : in out Asis.Traverse_Control;
                            State   : in out Boolean) is null;

  procedure Traverse_Declaration is
     new Asis.Iterator.Traverse_Element (State_Information => Boolean,
                                         Pre_Operation     => Pre_Operation,
                                         Post_Operation    => Post_Operation);
  Context : Asis.Context;

begin
  Asis.Implementation.Initialize ("");
  Asis.Ada_Environments.Associate (The_Context => Context,
                                   Name        => "CLPG",
                                   Parameters  => "-CA -FM");
  Asis.Ada_Environments.Open (The_Context => Context);

  Analyze :
  declare
    Complation_Unit_Body             : Asis.Compilation_Unit;
    Complation_Unit_Body_Declaration : Asis.Declaration;
    Process_Control                  : Asis.Traverse_Control := Asis.Continue;
    State                            : Boolean := False;
  begin
    Complation_Unit_Body := Asis.Compilation_Units.Compilation_Unit_Body (Name        => "Minimal_Example",
                                                                          The_Context => Context);
    Complation_Unit_Body_Declaration := Asis.Elements.Unit_Declaration (Compilation_Unit => Complation_Unit_Body);

    Traverse_Declaration (Element => Complation_Unit_Body_Declaration,
                          Control => Process_Control,
                          State   => State);
  end Analyze;

  Asis.Ada_Environments.Close (The_Context => Context);
  Asis.Ada_Environments.Dissociate (The_Context => Context);
  Asis.Implementation.Finalize (Parameters => "");
end Minimal_Analyzer;

Project file:

with "asis";

project Build is

   for Main use ("minimal_analyzer.adb",
                 "minimal_example.adb");

   for Source_Dirs use (".");
   for Object_Dir  use "obj";
   for Exec_Dir    use "bin";

   package Builder is
      for Default_Switches ("Ada") use ("-m",   --  Do not recompile if only comments have changed
                                        "-s",   --  Recompile if switches change
                                        "-j0"); --  Build concurrently
   end Builder;

   package Compiler is
      for Default_Switches ("Ada") use ("-gnatoU",
                                        "-gnat2012",
                                        "-funwind-tables",
                                        "-fstack-check",
                                        "-gnata");

   end Compiler;

end Build;

Build command:

gprbuild -j0 -p -P build.gpr

You need to have ASIS installed to build the tool. If you run minimal_analyzer from the directory where minimal_example.adb is located, you get the output:

Element Debug_Image:
A_SELECTED_COMPONENT
located in Minimal_Example (body, Unit_Id = 2, Context_Id = 1)
text position : minimal_example.adb:8:40
   Nodes:
      Node            : 2332 - N_SELECTED_COMPONENT
      R_Node          : 2332 - N_SELECTED_COMPONENT
      Node_Field_1    : 0 - N_EMPTY
      Node_Field_2    : 0 - N_EMPTY
   Rel_Sloc           : 157
   obtained from the tree /tmp/minimal_example.adt (Tree_Id = 1)
                                  V.F

... but how can I get to the definition of V.F, so I can extract the Discrete_Simple_Expression_Range 1 .. 5?

Using `Asis.Expressions.Corresponding_Expression_Type (Range_Prefix)` doesn't help, as this gives the type `Standard.String`, and not the anonymous subtype of string declared on line 5. — Jacob Sparre - at CLDK, May 29 '18 at 12:18
Would `gnat2xml` help? the schema is pretty revolting (and undocumented, AFAICT), but there are definitely references to source text positions of referenced objects, so they must be able to find them. — Simon Wright, May 29 '18 at 14:29
I don't think so. It would just make the data structure I had to work on different. If it somehow automatically tags all procedure call statements with the subtypes of the actuals, then it would of course be a different matter (but I doubt that). — Jacob Sparre Andersen, May 29 '18 at 18:24
Sorry; I meant that it might be possible to use the same techniques that gnat2xml uses to navigate the tree. — Simon Wright, May 30 '18 at 15:24

Jacob Sparre - at CLDK · Answer 1 · 2018-05-29T18:53:56.063

I found a solution:

The trick is to know when to use ASIS.Expressions.Corresponding_Name_Declaration...

--  Standard library packages:
with Ada.Wide_Text_IO;

--  ASIS packages:
with ASIS;
with ASIS.Ada_Environments;
with ASIS.Compilation_Units;
with ASIS.Declarations;
with ASIS.Definitions;
with ASIS.Elements;
with ASIS.Expressions;
with ASIS.Implementation;
with ASIS.Iterator;
with ASIS.Statements;
with ASIS.Text;

procedure Minimal_Analyzer is

  procedure Pre_Operation (Element : in     ASIS.Element;
                           Control : in out ASIS.Traverse_Control;
                           State   : in out Boolean) is
    pragma Unreferenced (Control, State);

    use all type ASIS.Element_Kinds;
    use all type ASIS.Statement_Kinds;
  begin
    if ASIS.Elements.Element_Kind (Element) = A_Statement and then
       ASIS.Elements.Statement_Kind (Element) = A_Procedure_Call_Statement
    then
      for Parameter_Association of ASIS.Statements.Call_Statement_Parameters (Statement  => Element,
                                                                              Normalized => True) loop
        declare
          Actual_Parameter   : ASIS.Element;
          Type_Of_Expression : ASIS.Element;
          Type_Definition    : ASIS.Definition;
          Constraint         : ASIS.Constraint;
        begin
          Actual_Parameter   := ASIS.Expressions.Actual_Parameter (Parameter_Association);
          Type_Of_Expression := ASIS.Expressions.Corresponding_Expression_Type (Actual_Parameter);
          Type_Definition    := ASIS.Declarations.Type_Declaration_View (Declaration => Type_Of_Expression);
          Constraint         := ASIS.Definitions.Subtype_Constraint (Type_Definition);

          for Index_Range of ASIS.Definitions.Discrete_Ranges (Constraint) loop
            declare
              Range_Attribute       : ASIS.Definition;
              Range_Prefix          : ASIS.Element;
              Field_Name            : ASIS.Defining_Name;
              Field_Declaration     : ASIS.Element;
              Field_Definition      : ASIS.Definition;
              Field_Type_Definition : ASIS.Definition;
              Constraint            : ASIS.Constraint;
            begin
              Range_Attribute       := ASIS.Definitions.Range_Attribute (Index_Range);
              Range_Prefix          := ASIS.Expressions.Prefix (Range_Attribute);
              Field_Name            := ASIS.Expressions.Selector (Range_Prefix);
              Field_Declaration     := ASIS.Expressions.Corresponding_Name_Declaration (Field_Name);
              Field_Definition      := ASIS.Declarations.Object_Declaration_View (Field_Declaration);
              Field_Type_Definition := ASIS.Definitions.Component_Definition_View (Component_Definition => Field_Definition);
              Constraint            := ASIS.Definitions.Subtype_Constraint (Field_Type_Definition);

              for Index_Range of ASIS.Definitions.Discrete_Ranges (Constraint) loop
                declare
                  First, Last : ASIS.Expression;
                begin
                  First := ASIS.Definitions.Lower_Bound (Index_Range);
                  Last  := ASIS.Definitions.Upper_Bound (Index_Range);

                  Ada.Wide_Text_IO.Put_Line (ASIS.Elements.Debug_Image (First));
                  Ada.Wide_Text_IO.Put_Line (ASIS.Text.Element_Image (First));

                  Ada.Wide_Text_IO.Put_Line (ASIS.Elements.Debug_Image (Last));
                  Ada.Wide_Text_IO.Put_Line (ASIS.Text.Element_Image (Last));
                end;
              end loop;
            end;
          end loop;
        end;
      end loop;
    end if;
  end Pre_Operation;

  procedure Post_Operation (Element : in     ASIS.Element;
                            Control : in out ASIS.Traverse_Control;
                            State   : in out Boolean) is null;

  procedure Traverse_Declaration is
     new ASIS.Iterator.Traverse_Element (State_Information => Boolean,
                                         Pre_Operation     => Pre_Operation,
                                         Post_Operation    => Post_Operation);
  Context : ASIS.Context;

begin
  ASIS.Implementation.Initialize ("");
  ASIS.Ada_Environments.Associate (The_Context => Context,
                                   Name        => "CLPG",
                                   Parameters  => "-CA -FM");
  ASIS.Ada_Environments.Open (The_Context => Context);

  Analyze :
  declare
    Complation_Unit_Body             : ASIS.Compilation_Unit;
    Complation_Unit_Body_Declaration : ASIS.Declaration;
    Process_Control                  : ASIS.Traverse_Control := ASIS.Continue;
    State                            : Boolean := False;
  begin
    Complation_Unit_Body := ASIS.Compilation_Units.Compilation_Unit_Body (Name        => "Minimal_Example",
                                                                          The_Context => Context);
    Complation_Unit_Body_Declaration := ASIS.Elements.Unit_Declaration (Compilation_Unit => Complation_Unit_Body);

    Traverse_Declaration (Element => Complation_Unit_Body_Declaration,
                          Control => Process_Control,
                          State   => State);
  end Analyze;

  ASIS.Ada_Environments.Close (The_Context => Context);
  ASIS.Ada_Environments.Dissociate (The_Context => Context);
  ASIS.Implementation.Finalize (Parameters => "");
end Minimal_Analyzer;

Note that this only works for exactly the example listed in the question. There are practically no checks that the various semantic interfaces the program encounters match the expectations. — Jacob Sparre - at CLDK, May 29 '18 at 13:58
You should accept your own answer so people know it works at first glance. — C.Champagne, May 30 '18 at 09:07
I have to wait 22 hours before the system will let me accept it. But yes. — Jacob Sparre - at CLDK, May 30 '18 at 12:45

How can I find the `'First` and `'Last` expressions for a string field in a record using ASIS

1 Answers1

Linked