home *** CD-ROM | disk | FTP | other *** search
/ back2roots/padua / padua.7z / padua / lang / grammars.lzh / GRAMMARS / ADA / DUMP_ROUTINES_BODY.A < prev    next >
Encoding:
Text File  |  1988-10-01  |  47.8 KB  |  1,279 lines
  1. with Ace_Universal_Types;
  2. use Ace_Universal_Types;
  3.  
  4. with Literals;
  5. use Literals;
  6.  
  7. with Symtbl_Entry_Get_Routines;
  8. use Symtbl_Entry_Get_Routines;
  9.  
  10. with Symbol_Table_Routines;
  11. use Symbol_Table_Routines;
  12.  
  13. with Node_Get_Routines;
  14. use Node_Get_Routines;
  15.  
  16. with Misc_Support_Routines;
  17. use Misc_Support_Routines;
  18.  
  19. with Error_Handler;
  20. use Error_Handler;
  21.  
  22. with Sun_Windows;
  23. use Sun_Windows;
  24.  
  25. package body Dump_Routines is
  26.  
  27.  
  28.    We_Are_Dumping        : Boolean     := False;
  29.  
  30.    Dump_Statement_Number : Boolean     := False;
  31.  
  32.    Dump_Text_Window      : Boolean     := False;
  33.  
  34.    Quote_Infix           : Boolean     := True;
  35.  
  36.    Line                  : String (1 .. 256);
  37.    Line_Length           : Ace_Natural := 1;
  38.  
  39.    Indented              : Integer     := 0;
  40.  
  41.  
  42.    procedure Dump_To_Text_Windows (Switch : Boolean) is
  43.    begin
  44.       Dump_Text_Window := Switch;
  45.    end Dump_To_Text_Windows;
  46.  
  47.    procedure Dump_Statement_Numbers (Switch : Boolean) is
  48.    begin
  49.       Dump_Statement_Number := Switch;
  50.    end Dump_Statement_Numbers;
  51.  
  52.    function Is_Statement_Dump_On return Boolean is
  53.    begin
  54.       return We_Are_Dumping;
  55.    end Is_Statement_Dump_On;
  56.  
  57.    procedure Dump (Switch : Boolean) is
  58.    begin
  59.       We_Are_Dumping := Switch;
  60.    end Dump;
  61.  
  62.    procedure Indent is
  63.    begin
  64.       Indented := Indented + 3;
  65.    end Indent;
  66.  
  67.    procedure Exdent is
  68.    begin
  69.       Indented := Indented - 3;
  70.    end Exdent;
  71.  
  72.    procedure Print_Indent (File : File_Type) is
  73.    begin
  74.       for I in 1 .. Indented loop
  75.          if Dump_Text_Window then
  76.             Line_Length             := Line_Length + 1;
  77.             Line (1 .. Line_Length) := Line (1 .. Line_Length - 1) & " ";
  78.          else
  79.             Put (File, " ");
  80.          end if;
  81.       end loop;
  82.    end Print_Indent;
  83.  
  84.    procedure Output (File : File_Type;
  85.                      Str  : String) is
  86.    begin
  87.       if Dump_Text_Window then
  88.          Line_Length             := Line_Length + Str'LENGTH;
  89.          Line (1 .. Line_Length) := Line (1 .. Line_Length - Str'LENGTH) & Str;
  90.       else
  91.          Put (File, Str);
  92.       end if;
  93.    end Output;
  94.  
  95.    procedure Outputln (File : File_Type) is
  96.    begin
  97.       if Dump_Text_Window then
  98.          Display_Line (Line (2 .. Line_Length));
  99.          Line_Length := 1;
  100.       else
  101.          New_Line (File);
  102.       end if;
  103.    end Outputln;
  104.  
  105.    procedure Outputln (File : File_Type;
  106.                        Str  : String) is
  107.    begin
  108.       if Dump_Text_Window then
  109.          Line_Length             := Line_Length + Str'LENGTH;
  110.          Line (1 .. Line_Length) := Line (1 .. Line_Length - Str'LENGTH) & Str;
  111.          Display_Line (Line (2 .. Line_Length));
  112.          Line_Length             := 1;
  113.       else
  114.          Put_Line (File, Str);
  115.       end if;
  116.    end Outputln;
  117.  
  118.    function Is_Infix (Str : String) return Boolean is
  119.    begin
  120.       if Str'LENGTH > 3 then
  121.          return False;
  122.       elsif Str'LENGTH = 3 then
  123.          if Str = "mod" then
  124.             return True;
  125.          elsif Str = "rem" then
  126.             return True;
  127.          elsif Str = "and" then
  128.             return True;
  129.          elsif Str = "xor" then
  130.             return True;
  131.          elsif Str = "not" then
  132.             return True;
  133.          else
  134.             return False;
  135.          end if;
  136.       elsif Str'LENGTH = 2 then
  137.          if Str = "or" then
  138.             return True;
  139.          elsif Str = ">=" then
  140.             return True;
  141.          elsif Str = "<=" then
  142.             return True;
  143.          elsif Str = "/=" then
  144.             return True;
  145.          else
  146.             return False;
  147.          end if;
  148.       elsif Str'LENGTH = 1 then
  149.          case Str (Str'FIRST) is
  150.             when '+' |
  151.                  '-' |
  152.                  '*' |
  153.                  '/' |
  154.                  '&' |
  155.                  '|' |
  156.                  '=' |
  157.                  '<' |
  158.                  '>' =>
  159.                return True;
  160.             when others   =>
  161.                return False;
  162.          end case;
  163.       end if;
  164.    end Is_Infix;
  165.  
  166.    procedure Dump_Type_Name (File : File_Type;
  167.                              Ref  : Ref_Symbol_Table_Entry) is
  168.    begin
  169.       case Ref.Entry_Kind is
  170.          when Object_Entry     =>
  171.             Output (File, Convert_To_String (Ref.Object_Type.Symbol_Name));
  172.          when Type_Entry  =>
  173.             Output (File, Convert_To_String (Ref.Symbol_Name));
  174.          when Formal_Param_Entry    =>
  175.             Output (File, Convert_To_String (Ref.Param_Type.Symbol_Name));
  176.          when others =>
  177.             null;
  178.       end case;
  179.    end Dump_Type_Name;
  180.  
  181.    procedure Dump_Symbol_Name (File : File_Type;
  182.                                Ref  : Ref_Symbol_Table_Entry) is
  183.    begin
  184.       if Is_Infix (Convert_To_String (Ref.Symbol_Name)) and Quote_Infix then
  185.          Output (File, """");
  186.       end if;
  187.       Output (File, Convert_To_String (Ref.Symbol_Name));
  188.       if Is_Infix (Convert_To_String (Ref.Symbol_Name)) and Quote_Infix then
  189.          Output (File, """");
  190.       end if;
  191.    end Dump_Symbol_Name;
  192.  
  193.    procedure Dump_Constraint_Info (File : File_Type;
  194.                                    Ref  : Ref_Symbol_Table_Entry) is
  195.    begin
  196.       Output (File, " range ");
  197.       Output (File, Ace_Integer'IMAGE (Get_Lower_Bound (Ref)));
  198.       Output (File, " .. ");
  199.       Output (File, Ace_Integer'IMAGE (Get_Upper_Bound (Ref)));
  200.    end Dump_Constraint_Info;
  201.  
  202.    procedure Dump_Enumeration_List (File : File_Type;
  203.                                     Ref  : Ref_Symbol_Table_Entry) is
  204.       Iterator : Ref_Symbol_Table_Entry;
  205.  
  206.    begin
  207.       Iterator := Get_First_Literal (Ref);
  208.       while (not Is_Empty (Iterator)) loop
  209.          Dump_Symbol_Name (File, Iterator);
  210.          Iterator := Get_Successor (Iterator);
  211.          if not Is_Empty (Iterator) then
  212.             Output (File, ", ");
  213.          end if;
  214.       end loop;
  215.    end Dump_Enumeration_List;
  216.  
  217.    procedure Dump_Parameter_List (File : File_Type;
  218.                                   Ref  : Ref_Symbol_Table_Entry) is
  219.  
  220.       Iterator  : Ref_Symbol_Table_Entry;
  221.       Iterator2 : Ref_Symbol_Table_Entry;
  222.  
  223.       procedure Dump_Mode (File  : File_Type;
  224.                            Param : Ref_Symbol_Table_Entry) is
  225.       begin
  226.          if Is_Mode_Default_In (Param) then
  227.             null; -- nothing is output-ed here.
  228.          elsif Is_Mode_Explicit_In (Param) then
  229.             Output (File, "in ");
  230.          elsif Is_Mode_Out (Param) then
  231.             Output (File, "out ");
  232.          elsif Is_Mode_In_Out (Param) then
  233.             Output (File, "in out ");
  234.          end if;
  235.       end Dump_Mode;
  236.  
  237.    begin
  238.       Iterator := Get_Head_Of_Parameters_List (Ref);
  239.       if Is_Empty (Iterator) then
  240.          return ;
  241.       else
  242.          Output (File, " (");
  243.          while (not Is_Empty (Iterator)) loop
  244.             Dump_Symbol_Name (File, Iterator);
  245.             -- Loop thru all parameters that are separated by a ","
  246.             loop
  247.                Iterator2 := Get_Next_Parameter (Iterator);
  248.                exit  when Is_Empty (Iterator2) or else
  249.                           not Is_Preceded_By_Comma (Iterator2);
  250.                Output (File, ", ");
  251.                Dump_Symbol_Name (File, Iterator2);
  252.                Iterator := Iterator2;
  253.             end loop;
  254.             Output (File, " : ");
  255.             Dump_Mode (File, Iterator);
  256.             Dump_Type_Name (File, Iterator);
  257.             if not Is_Empty (Iterator2) then
  258.                Output (File, "; ");
  259.             end if;
  260.             Iterator := Iterator2;
  261.          end loop;
  262.          Output (File, ")");
  263.       end if;
  264.    end Dump_Parameter_List;
  265.  
  266.    procedure Dump_Symtbl (Ref            : Ref_Symbol_Table_Entry;
  267.                           File           : File_Type;
  268.                           Dumping_Bodies : Boolean := False) is
  269.    begin
  270.       if Is_Empty (Ref) then
  271.  
  272.          Print_Indent (File);
  273.          Outputln (File, "null;");
  274.  
  275.       else
  276.  
  277.          case Get_Entry_Kind (Ref) is
  278.  
  279.             when Object_Entry  =>
  280.                Dump_Symbol_Name (File, Ref);
  281.                Output (File, " : ");
  282.                Dump_Type_Name (File, Ref);
  283.                Outputln (File, ";");
  284.  
  285.             when Type_Entry    | Derived_Type_Entry     =>
  286.                Output (File, "type ");
  287.                Dump_Symbol_Name (File, Ref);
  288.                Output (File, " is ");
  289.                if Get_Entry_Kind (Ref) = Type_Entry then
  290.                   if Is_Type_An_Enumeration_Type (Ref) then
  291.                      Output (File, "(");
  292.                      Dump_Enumeration_List (File, Ref);
  293.                      Outputln (File, ");");
  294.                   elsif Is_Type_An_Integer_Type (Ref) then
  295.                      Output (File, " range ");
  296.                      --dump_statement_statement_database
  297.                      --   (Get_Lower_Bound(Get_Symbol_Table_Entry(Ref));
  298.                      --dump_statement_statement_database
  299.                      --   (Get_Upper_Bound(Get_Symbol_Table_Entry(Ref));
  300.                      Output (File, Ace_Integer'IMAGE (Get_Lower_Bound (Ref)));
  301.                      Output (File, " .. ");
  302.                      Output (File, Ace_Integer'IMAGE (Get_Upper_Bound (Ref)));
  303.                      Outputln (File, ";");
  304.                   else
  305.                      Outputln (File, "<Unimplemented Type>;");
  306.                   end if;
  307.                elsif Get_Entry_Kind (Ref) = Derived_Type_Entry then
  308.                   Output (File, "new ");
  309.                   Dump_Symbol_Name (File, Get_Entry_Base_Type (Ref));
  310.                   if Has_Constraint (Ref) then
  311.                      Dump_Constraint_Info (File, Ref);
  312.                   end if;
  313.                   Outputln (File, ";");
  314.                end if;
  315.  
  316.             when Subtype_Entry =>
  317.                Output (File, "subtype ");
  318.                Dump_Symbol_Name (File, Ref);
  319.                Output (File, " is ");
  320.                Dump_Symbol_Name (File, Get_Entry_Base_Type (Ref));
  321.                if Has_Constraint (Ref) then
  322.                   Dump_Constraint_Info (File, Ref);
  323.                end if;
  324.                Outputln (File, ";");
  325.  
  326.             when Procedure_Entry    =>
  327.                Output (File, "procedure ");
  328.                Dump_Symbol_Name (File, Ref);
  329.                Dump_Parameter_List (File, Ref);
  330.                if Dumping_Bodies then
  331.                   if Is_Subprogram_Built_In (Ref) then
  332.                      Outputln (File, ";");
  333.                      Output (File, "pragma BUILTIN (");
  334.                      Dump_Symbol_Name (File, Ref);
  335.                      Output (File, ", ");
  336.                      Output
  337.                          (File,
  338.                           Ace_Integer'IMAGE (Get_Built_In_Instance_Number (Ref)
  339.                                              ));
  340.                      Outputln (File, ");");
  341.  
  342.                   elsif not Is_Empty (Get_Head_Of_Statements_List (Ref)) then
  343.                      Outputln (File, " is");
  344.                      Indent;
  345.                      Dump_Statement_Database
  346.                          (Get_Head_Of_Declarations_List (Ref), File,
  347.                           Dumping_Bodies);
  348.                      Exdent;
  349.                      Outputln (File, "begin");
  350.                      Indent;
  351.                      Dump_Statement_Database
  352.                          (Get_Head_Of_Statements_List (Ref), File,
  353.                           Dumping_Bodies);
  354.                      Exdent;
  355.                      Output (File, "end ");
  356.                      Dump_Symbol_Name (File, Ref);
  357.                      Outputln (File, ";");
  358.  
  359.                   else
  360.                      Outputln (File, ";");
  361.                   end if;
  362.  
  363.                else -- spec only
  364.                   if Is_Subprogram_Built_In (Ref) then
  365.                      Outputln (File, ";");
  366.                      Output (File, "pragma BUILTIN (");
  367.                      Dump_Symbol_Name (File, Ref);
  368.                      Output (File, ", ");
  369.                      Output
  370.                          (File,
  371.                           Ace_Integer'IMAGE (Get_Built_In_Instance_Number (Ref)
  372.                                              ));
  373.                      Outputln (File, ");");
  374.                   else
  375.                      Outputln (File, ";");
  376.                   end if;
  377.  
  378.                end if;
  379.  
  380.  
  381.             when Function_Entry     =>
  382.                Output (File, "function ");
  383.                Dump_Symbol_Name (File, Ref);
  384.                Dump_Parameter_List (File, Ref);
  385.                Output (File, " return ");
  386.                Dump_Symbol_Name (File, Get_Return_Type (Ref));
  387.                if Is_Subprogram_Built_In (Ref) then
  388.                   Outputln (File, ";");
  389.                   Output (File, "pragma BUILTIN (");
  390.                   Dump_Symbol_Name (File, Ref);
  391.                   Output (File, ", ");
  392.                   Output
  393.                       (File,
  394.                        Ace_Integer'IMAGE (Get_Built_In_Instance_Number (Ref)));
  395.                   Outputln (File, ");");
  396.                elsif Dumping_Bodies and
  397.                      not Is_Empty (Get_Head_Of_Statements_List (Ref)) then
  398.                   Outputln (File, " is");
  399.                   Indent;
  400.                   Dump_Statement_Database
  401.                       (Get_Head_Of_Declarations_List (Ref), File,
  402.                        Dumping_Bodies);
  403.                   Exdent;
  404.                   Outputln (File, "begin");
  405.                   Indent;
  406.                   Dump_Statement_Database (Get_Head_Of_Statements_List (Ref),
  407.                                            File, Dumping_Bodies);
  408.                   Exdent;
  409.                   Output (File, "end ");
  410.                   Dump_Symbol_Name (File, Ref);
  411.                   Outputln (File, ";");
  412.  
  413.                else -- spec only
  414.                   Outputln (File, ";");
  415.                end if;
  416.  
  417.             when Package_Entry =>
  418.                Output (File, "package ");
  419.                Dump_Symbol_Name (File, Ref);
  420.                Outputln (File, " is");
  421.                Indent;
  422.                Dump_Statement_Database (Get_Package_Spec_Decls (Ref), File,
  423.                                         False);
  424.                Exdent;
  425.                Output (File, "end ");
  426.                Dump_Symbol_Name (File, Ref);
  427.                Outputln (File, ";");
  428.  
  429.                if Dumping_Bodies and Has_A_Body (Ref) then
  430.                   Print_Indent (File);
  431.                   Output (File, "package body ");
  432.                   Dump_Symbol_Name (File, Ref);
  433.                   Outputln (File, " is");
  434.                   Indent;
  435.                   Dump_Statement_Database (Get_Package_Body_Decls (Ref), File,
  436.                                            True);
  437.                   Exdent;
  438.                   if not Is_Empty (Get_Head_Of_Statements_List (Ref)) then
  439.                      Print_Indent (File);
  440.                      Outputln (File, "begin");
  441.                      Indent;
  442.                      Dump_Statement_Database
  443.                          (Get_Head_Of_Statements_List (Ref), File, True);
  444.                      Exdent;
  445.                   end if;
  446.                   Output (File, "end ");
  447.                   Dump_Symbol_Name (File, Ref);
  448.                   Outputln (File, ";");
  449.                end if;
  450.  
  451.             when Enumeration_Literal_Entry    =>
  452.  
  453.                Output (File, "-- Enumeration Literal : """);
  454.                Dump_Symbol_Name (File, Ref);
  455.                Output (File, """ of type ");
  456.                Dump_Symbol_Name (File, Get_Type (Ref));
  457.                Outputln (File);
  458.  
  459.             when others   =>
  460.                --Show_Error(3009, Internal, "Dump_Symtbl");
  461.                null;
  462.  
  463.          end case;
  464.       end if;
  465.    end Dump_Symtbl;
  466.  
  467.  
  468.    procedure Dump_For_Statement_Trace (Ref  : Ref_Statement_Database;
  469.                                        File : File_Type) is
  470.       Dumping_Bodies : Boolean := False;
  471.  
  472.    begin
  473.       if Is_Empty (Ref) then
  474.          Print_Indent (File);
  475.          Outputln (File, "null;");
  476.  
  477.       else
  478.  
  479.          if Dump_Statement_Number then
  480.             Output (File, Ace_Integer'IMAGE (Get_Statement_Number (Ref)));
  481.             Output (File, "| ");
  482.          end if;
  483.  
  484.          case Ref.Statement_Node.Statement_Kind is
  485.  
  486.             when Object_Declaration =>
  487.                Dump_Statement_Database (Get_Name_List (Ref), File,
  488.                                         Dumping_Bodies);
  489.                Output (File, " : ");
  490.                Dump_Type_Name
  491.                    (File,
  492.                     Get_Symbol_Table_Entry
  493.                         (Get_Expression (Get_Name_List (Ref))));
  494.                if not Is_Empty (Get_Expression (Ref)) then
  495.                   Output (File, " := ");
  496.                   Dump_Statement_Database (Get_Expression (Ref), File,
  497.                                            Dumping_Bodies);
  498.                end if;
  499.                Outputln (File, ";");
  500.  
  501.             when Type_Declaration   =>
  502.                Output (File, "type ");
  503.                Dump_Symbol_Name (File, Get_Symbol_Table_Entry (Ref));
  504.                Output (File, " is ");
  505.                if Get_Entry_Kind (Get_Symbol_Table_Entry (Ref)) = Type_Entry
  506.                    then
  507.                   if Is_Type_An_Enumeration_Type (Get_Symbol_Table_Entry (Ref))
  508.                       then
  509.                      Output (File, "(");
  510.                      Dump_Enumeration_List (File, Get_Symbol_Table_Entry (Ref));
  511.                      Outputln (File, ");");
  512.                   elsif Is_Type_An_Integer_Type (Get_Symbol_Table_Entry (Ref))
  513.                          then
  514.                      Output (File, " range ");
  515.                      --dump_statement_statement_database
  516.                      --   (Get_Lower_Bound(Get_Symbol_Table_Entry(Ref));
  517.                      --dump_statement_statement_database
  518.                      --   (Get_Upper_Bound(Get_Symbol_Table_Entry(Ref));
  519.                      Output
  520.                          (File,
  521.                           Ace_Integer'IMAGE (
  522.                              Get_Lower_Bound (Get_Symbol_Table_Entry (Ref))));
  523.                      Output (File, " .. ");
  524.                      Outputln
  525.                          (File,
  526.                           Ace_Integer'IMAGE (
  527.                              Get_Upper_Bound (Get_Symbol_Table_Entry (Ref))));
  528.                      Outputln (File, ";");
  529.                   else
  530.                      Outputln (File, "<Unimplemented Type>;");
  531.                   end if;
  532.                elsif Get_Entry_Kind (Get_Symbol_Table_Entry (Ref)) =
  533.                      Derived_Type_Entry then
  534.                   Output (File, "new ");
  535.                   Dump_Symbol_Name
  536.                       (File, Get_Entry_Base_Type (Get_Symbol_Table_Entry (Ref))
  537.                        );
  538.                   if Has_Constraint (Get_Symbol_Table_Entry (Ref)) then
  539.                      Dump_Constraint_Info (File, Get_Symbol_Table_Entry (Ref));
  540.                   end if;
  541.                   Outputln (File, ";");
  542.                end if;
  543.  
  544.             when Subtype_Declaration     =>
  545.                Output (File, "subtype ");
  546.                Dump_Symbol_Name (File, Get_Symbol_Table_Entry (Ref));
  547.                Output (File, " is ");
  548.                Dump_Symbol_Name
  549.                    (File, Get_Entry_Base_Type (Get_Symbol_Table_Entry (Ref)));
  550.                if Has_Constraint (Get_Symbol_Table_Entry (Ref)) then
  551.                   Dump_Constraint_Info (File, Get_Symbol_Table_Entry (Ref));
  552.                end if;
  553.                Outputln (File, ";");
  554.  
  555.             when Procedure_Declaration   =>
  556.                Output (File, "procedure ");
  557.                Dump_Symbol_Name (File, Get_Symbol_Table_Entry (Ref));
  558.                Dump_Parameter_List (File, Get_Symbol_Table_Entry (Ref));
  559.                Outputln (File, ";");
  560.                if Is_Subprogram_Built_In (Get_Symbol_Table_Entry (Ref)) then
  561.                   Outputln (File, ";");
  562.                   Output (File, "pragma BUILTIN (");
  563.                   Dump_Symbol_Name (File, Get_Symbol_Table_Entry (Ref));
  564.                   Output (File, ", ");
  565.                   Output
  566.                       (File,
  567.                        Ace_Integer'IMAGE (
  568.                           Get_Built_In_Instance_Number
  569.                               (Get_Symbol_Table_Entry (Ref))));
  570.                   Outputln (File, ");");
  571.                end if;
  572.  
  573.             when Function_Declaration    =>
  574.                Output (File, "function ");
  575.                Dump_Symbol_Name (File, Get_Symbol_Table_Entry (Ref));
  576.                Dump_Parameter_List (File, Get_Symbol_Table_Entry (Ref));
  577.                Output (File, " return ");
  578.                Dump_Symbol_Name
  579.                    (File, Get_Return_Type (Get_Symbol_Table_Entry (Ref)));
  580.                Outputln (File, ";");
  581.                if Is_Subprogram_Built_In (Get_Symbol_Table_Entry (Ref)) then
  582.                   Outputln (File, ";");
  583.                   Output (File, "pragma BUILTIN (");
  584.                   Dump_Symbol_Name (File, Get_Symbol_Table_Entry (Ref));
  585.                   Output (File, ", ");
  586.                   Output
  587.                       (File,
  588.                        Ace_Integer'IMAGE (
  589.                           Get_Built_In_Instance_Number
  590.                               (Get_Symbol_Table_Entry (Ref))));
  591.                   Outputln (File, ");");
  592.                end if;
  593.  
  594.             when Package_Declaration     =>
  595.                Output (File, "package ");
  596.                Dump_Symbol_Name (File, Get_Symbol_Table_Entry (Ref));
  597.                Outputln (File, " is");
  598.  
  599.             when Package_Body_Declaration     =>
  600.                Output (File, "package body ");
  601.                Dump_Symbol_Name (File, Get_Symbol_Table_Entry (Ref));
  602.                Outputln (File, " is");
  603.  
  604.             when Assign_Statement   =>
  605.                Print_Indent (File);
  606.                Dump_Statement_Database (Get_Lhs (Ref), File, Dumping_Bodies);
  607.                Output (File, " := ");
  608.                Dump_Statement_Database (Get_Rhs (Ref), File, Dumping_Bodies);
  609.                Outputln (File, ";");
  610.  
  611.             when Loop_Statement     =>
  612.                if not Is_Empty (Get_Name (Ref)) then
  613.                   Print_Indent (File);
  614.                   Dump_Statement_Database
  615.                       (Get_Name (Ref), File, Dumping_Bodies);
  616.                   Outputln (File, " :");
  617.                end if;
  618.  
  619.                if Is_Empty (Get_Loop_Scheme (Ref)) then
  620.                   if Is_Expression_Node (Ref) then
  621.                      Output (File, "while ");
  622.                      Dump_Statement_Database (Get_Loop_Scheme (Ref), File,
  623.                                               Dumping_Bodies);
  624.                      Output (File, " ");
  625.                   else
  626.                      Dump_Statement_Database (Get_Loop_Scheme (Ref), File,
  627.                                               Dumping_Bodies);
  628.                   end if;
  629.                end if;
  630.                Outputln (File, "loop");
  631.  
  632.             when For_Statement =>
  633.                Output (File, "for ");
  634.                Dump_Statement_Database (Get_For_Variable (Ref), File,
  635.                                         Dumping_Bodies);
  636.                Output (File, " in ");
  637.                Dump_Statement_Database (Get_For_Range (Ref), File,
  638.                                         Dumping_Bodies);
  639.                Output (File, " ");
  640.  
  641.             when If_Statement  =>
  642.                Output (File, "if ");
  643.                Dump_Statement_Database (Get_Condition (Ref), File,
  644.                                         Dumping_Bodies);
  645.                Outputln (File, " then");
  646.  
  647.             when Case_Statement     =>
  648.                Output (File, "case ");
  649.                Dump_Statement_Database (Get_Expression (Ref), File,
  650.                                         Dumping_Bodies);
  651.  
  652.             when Case_Alternative_Part   =>
  653.                Output (File, "when ");
  654.                Dump_Statement_Database (Get_Alternative_Choice (Ref), File,
  655.                                         Dumping_Bodies);
  656.                Outputln (File, " => ");
  657.  
  658.             when Labeled_Statement  =>
  659.                Output (File, "<<");
  660.                Dump_Statement_Database (Get_Label_Entry (Ref), File,
  661.                                         Dumping_Bodies);
  662.                Outputln (File, ">>");
  663.  
  664.             when Goto_Statement     =>
  665.                Output (File, "goto ");
  666.                Dump_Statement_Database (Get_Goto_Label (Ref), File,
  667.                                         Dumping_Bodies);
  668.                Outputln (File, ";");
  669.  
  670.             when Exit_Statement     =>
  671.                Output (File, "exit ");
  672.                Dump_Statement_Database (Get_Name (Ref), File, Dumping_Bodies);
  673.                if not Is_Empty (Get_Condition (Ref)) then
  674.                   Output (File, " when ");
  675.                   Dump_Statement_Database (Get_Condition (Ref), File,
  676.                                            Dumping_Bodies);
  677.                end if;
  678.                Outputln (File, ";");
  679.  
  680.             when Return_Statement   =>
  681.                Output (File, "return ");
  682.                if not Is_Empty (Get_Expression (Ref)) then
  683.                   Dump_Statement_Database (Get_Expression (Ref), File,
  684.                                            Dumping_Bodies);
  685.                end if;
  686.                Outputln (File, ";");
  687.  
  688.             when Block_Statement    =>
  689.                null;
  690.  
  691.             when With_Statement     =>
  692.                Output (File, "with ");
  693.                Dump_Statement_Database (Get_Name_List (Ref), File,
  694.                                         Dumping_Bodies);
  695.                Outputln (File, ";");
  696.  
  697.             when Use_Statement =>
  698.                Output (File, "use  ");
  699.                Dump_Statement_Database (Get_Name_List (Ref), File,
  700.                                         Dumping_Bodies);
  701.                Outputln (File, ";");
  702.  
  703.             when Procedure_Call     =>
  704.                Dump_Statement_Database (Get_Subprogram_Info (Ref), File,
  705.                                         Dumping_Bodies);
  706.                if not Is_Empty (Get_Parameter_List (Ref)) then
  707.                   Output (File, "(");
  708.                   Dump_Statement_Database (Get_Parameter_List (Ref), File,
  709.                                            Dumping_Bodies);
  710.                   Output (File, ")");
  711.                end if;
  712.                Outputln (File, ";");
  713.  
  714.             when Pragma_Statement   =>
  715.                Output (File, "pragma ");
  716.                Dump_Statement_Database (Get_Name (Ref), File, Dumping_Bodies);
  717.                if not Is_Empty (Get_Argument_List (Ref)) then
  718.                   Output (File, "(");
  719.                   Dump_Statement_Database (Get_Argument_List (Ref), File,
  720.                                            Dumping_Bodies);
  721.                   Output (File, ")");
  722.                end if;
  723.                Outputln (File, ";");
  724.  
  725.             when Null_Statement     =>
  726.                Outputln (File, "null;");
  727.  
  728.             when Unknown  =>
  729.                null;
  730.          end case;
  731.       end if;
  732.    end Dump_For_Statement_Trace;
  733.  
  734.    procedure Dump_Statement (Ref            : Ref_Statement_Database;
  735.                              File           : File_Type;
  736.                              Dumping_Bodies : Boolean) is
  737.    begin
  738.       if Ref = null then
  739.  
  740.          Print_Indent (File);
  741.          Outputln (File, "null;");
  742.  
  743.       else
  744.  
  745.          if Dump_Statement_Number then
  746.  
  747.             Output (File, Ace_Integer'IMAGE (Get_Statement_Number (Ref)));
  748.             Output (File, "| ");
  749.  
  750.          end if;
  751.  
  752.          case Ref.Statement_Node.Statement_Kind is
  753.  
  754.             when Object_Declaration =>
  755.                Print_Indent (File);
  756.                Dump_Statement_Database (Get_Name_List (Ref), File,
  757.                                         Dumping_Bodies);
  758.                Output (File, " : ");
  759.                Dump_Type_Name
  760.                    (File,
  761.                     Get_Symbol_Table_Entry
  762.                         (Get_Expression (Get_Name_List (Ref))));
  763.                if not Is_Empty (Get_Expression (Ref)) then
  764.                   Output (File, " := ");
  765.                   Dump_Statement_Database (Get_Expression (Ref), File,
  766.                                            Dumping_Bodies);
  767.                end if;
  768.                Outputln (File, ";");
  769.  
  770.             when Type_Declaration   =>
  771.                Print_Indent (File);
  772.                Output (File, "type ");
  773.                Dump_Symbol_Name (File, Get_Symbol_Table_Entry (Ref));
  774.                Output (File, " is ");
  775.                if Get_Entry_Kind (Get_Symbol_Table_Entry (Ref)) = Type_Entry
  776.                    then
  777.                   if Is_Type_An_Enumeration_Type (Get_Symbol_Table_Entry (Ref))
  778.                       then
  779.                      Output (File, "(");
  780.                      Dump_Enumeration_List (File, Get_Symbol_Table_Entry (Ref));
  781.                      Outputln (File, ");");
  782.                   elsif Is_Type_An_Integer_Type (Get_Symbol_Table_Entry (Ref))
  783.                          then
  784.                      Output (File, " range ");
  785.                      --dump_statement_statement_database
  786.                      --   (Get_Lower_Bound(Get_Symbol_Table_Entry(Ref));
  787.                      --dump_statement_statement_database
  788.                      --   (Get_Upper_Bound(Get_Symbol_Table_Entry(Ref));
  789.                      Output
  790.                          (File,
  791.                           Ace_Integer'IMAGE (
  792.                              Get_Lower_Bound (Get_Symbol_Table_Entry (Ref))));
  793.                      Output (File, " .. ");
  794.                      Outputln
  795.                          (File,
  796.                           Ace_Integer'IMAGE (
  797.                              Get_Upper_Bound (Get_Symbol_Table_Entry (Ref))));
  798.                      Outputln (File, ";");
  799.                   else
  800.                      Outputln (File, "<Unimplemented Type>;");
  801.                   end if;
  802.                elsif Get_Entry_Kind (Get_Symbol_Table_Entry (Ref)) =
  803.                      Derived_Type_Entry then
  804.                   Output (File, "new ");
  805.                   Dump_Symbol_Name
  806.                       (File, Get_Entry_Base_Type (Get_Symbol_Table_Entry (Ref))
  807.                        );
  808.                   if Has_Constraint (Get_Symbol_Table_Entry (Ref)) then
  809.                      Dump_Constraint_Info (File, Get_Symbol_Table_Entry (Ref));
  810.                   end if;
  811.                   Outputln (File, ";");
  812.                end if;
  813.  
  814.             when Subtype_Declaration     =>
  815.                Print_Indent (File);
  816.                Output (File, "subtype ");
  817.                Dump_Symbol_Name (File, Get_Symbol_Table_Entry (Ref));
  818.                Output (File, " is ");
  819.                Dump_Symbol_Name
  820.                    (File, Get_Entry_Base_Type (Get_Symbol_Table_Entry (Ref)));
  821.                if Has_Constraint (Get_Symbol_Table_Entry (Ref)) then
  822.                   Dump_Constraint_Info (File, Get_Symbol_Table_Entry (Ref));
  823.                end if;
  824.                Outputln (File, ";");
  825.  
  826.             when Procedure_Declaration   =>
  827.                Print_Indent (File);
  828.                Output (File, "procedure ");
  829.                Dump_Symbol_Name (File, Get_Symbol_Table_Entry (Ref));
  830.                Dump_Parameter_List (File, Get_Symbol_Table_Entry (Ref));
  831.                if Dumping_Bodies and
  832.                   not Is_Empty
  833.                       (Get_Head_Of_Statements_List
  834.                            (Get_Symbol_Table_Entry (Ref))) then
  835.                   Outputln (File, " is");
  836.                   Indent;
  837.                   Dump_Statement_Database
  838.                       (Get_Head_Of_Declarations_List
  839.                            (Get_Symbol_Table_Entry (Ref)), File, Dumping_Bodies
  840.                        );
  841.                   Exdent;
  842.                   Print_Indent (File);
  843.                   Outputln (File, "begin");
  844.                   Indent;
  845.                   Dump_Statement_Database
  846.                       (Get_Head_Of_Statements_List
  847.                            (Get_Symbol_Table_Entry (Ref)), File, Dumping_Bodies
  848.                        );
  849.                   Exdent;
  850.                   Print_Indent (File);
  851.                   Output (File, "end ");
  852.                   Dump_Symbol_Name (File, Get_Symbol_Table_Entry (Ref));
  853.                   Outputln (File, ";");
  854.  
  855.                else -- spec only
  856.                   Outputln (File, ";");
  857.                end if;
  858.  
  859.             when Function_Declaration    =>
  860.                Print_Indent (File);
  861.                Output (File, "function ");
  862.                Dump_Symbol_Name (File, Get_Symbol_Table_Entry (Ref));
  863.                Dump_Parameter_List (File, Get_Symbol_Table_Entry (Ref));
  864.                Output (File, " return ");
  865.                Dump_Symbol_Name
  866.                    (File, Get_Return_Type (Get_Symbol_Table_Entry (Ref)));
  867.                if Dumping_Bodies and
  868.                   not Is_Empty
  869.                       (Get_Head_Of_Statements_List
  870.                            (Get_Symbol_Table_Entry (Ref))) then
  871.                   Outputln (File, " is");
  872.                   Indent;
  873.                   Dump_Statement_Database
  874.                       (Get_Head_Of_Declarations_List
  875.                            (Get_Symbol_Table_Entry (Ref)), File, Dumping_Bodies
  876.                        );
  877.                   Exdent;
  878.                   Print_Indent (File);
  879.                   Outputln (File, "begin");
  880.                   Indent;
  881.                   Dump_Statement_Database
  882.                       (Get_Head_Of_Statements_List
  883.                            (Get_Symbol_Table_Entry (Ref)), File, Dumping_Bodies
  884.                        );
  885.                   Exdent;
  886.                   Print_Indent (File);
  887.                   Output (File, "end ");
  888.                   Dump_Symbol_Name (File, Get_Symbol_Table_Entry (Ref));
  889.                   Outputln (File, ";");
  890.  
  891.                else -- spec only
  892.                   Outputln (File, ";");
  893.                end if;
  894.  
  895.             when Package_Declaration     =>
  896.                Print_Indent (File);
  897.                Output (File, "package ");
  898.                Dump_Symbol_Name (File, Get_Symbol_Table_Entry (Ref));
  899.                Outputln (File, " is");
  900.                Indent;
  901.                Dump_Statement_Database
  902.                    (Get_Package_Spec_Decls (Get_Symbol_Table_Entry (Ref)), File,
  903.                     False);
  904.                Exdent;
  905.                Print_Indent (File);
  906.                Output (File, "end ");
  907.                Dump_Symbol_Name (File, Get_Symbol_Table_Entry (Ref));
  908.                Outputln (File, ";");
  909.  
  910.             when Package_Body_Declaration     =>
  911.                if Dumping_Bodies and Has_A_Body (Get_Symbol_Table_Entry (Ref))
  912.                    then
  913.                   Print_Indent (File);
  914.                   Output (File, "package body ");
  915.                   Dump_Symbol_Name (File, Get_Symbol_Table_Entry (Ref));
  916.                   Outputln (File, " is");
  917.                   Indent;
  918.                   Dump_Statement_Database
  919.                       (Get_Package_Body_Decls (Get_Symbol_Table_Entry (Ref)),
  920.                        File, True);
  921.                   Exdent;
  922.                   if not Is_Empty
  923.                          (Get_Head_Of_Statements_List
  924.                               (Get_Symbol_Table_Entry (Ref))) then
  925.                      Print_Indent (File);
  926.                      Outputln (File, "begin");
  927.                      Indent;
  928.                      Dump_Statement_Database
  929.                          (Get_Head_Of_Statements_List
  930.                               (Get_Symbol_Table_Entry (Ref)), File, True);
  931.                      Exdent;
  932.                   end if;
  933.                   Print_Indent (File);
  934.                   Output (File, "end ");
  935.                   Dump_Symbol_Name (File, Get_Symbol_Table_Entry (Ref));
  936.                   Outputln (File, ";");
  937.                end if;
  938.  
  939.             when Assign_Statement   =>
  940.                Print_Indent (File);
  941.                Dump_Statement_Database (Get_Lhs (Ref), File, Dumping_Bodies);
  942.                Output (File, " := ");
  943.                Dump_Statement_Database (Get_Rhs (Ref), File, Dumping_Bodies);
  944.                Outputln (File, ";");
  945.  
  946.             when Loop_Statement     =>
  947.                if not Is_Empty (Get_Name (Ref)) then
  948.                   Print_Indent (File);
  949.                   Dump_Statement_Database
  950.                       (Get_Name (Ref), File, Dumping_Bodies);
  951.                   Outputln (File, " :");
  952.                end if;
  953.                Print_Indent (File);
  954.                if Is_Empty (Get_Loop_Scheme (Ref)) then
  955.                   if Is_Expression_Node (Ref) then
  956.                      Output (File, "while ");
  957.                      Dump_Statement_Database (Get_Loop_Scheme (Ref), File,
  958.                                               Dumping_Bodies);
  959.                      Output (File, " ");
  960.                   else
  961.                      Dump_Statement_Database (Get_Loop_Scheme (Ref), File,
  962.                                               Dumping_Bodies);
  963.                   end if;
  964.                end if;
  965.                Outputln (File, "loop");
  966.                Indent;
  967.                Dump_Statement_Database
  968.                    (Get_Head_Of_Statements_List (Ref), File, Dumping_Bodies);
  969.                Exdent;
  970.                Print_Indent (File);
  971.                Output (File, "end loop ");
  972.                Dump_Statement_Database (Get_Name (Ref), File, Dumping_Bodies);
  973.                Outputln (File, ";");
  974.  
  975.             when For_Statement =>
  976.                Output (File, "for ");
  977.                Dump_Statement_Database (Get_For_Variable (Ref), File,
  978.                                         Dumping_Bodies);
  979.                Output (File, " in ");
  980.                Dump_Statement_Database (Get_For_Range (Ref), File,
  981.                                         Dumping_Bodies);
  982.                Output (File, " ");
  983.  
  984.             when If_Statement  =>
  985.                Print_Indent (File);
  986.                Output (File, "if ");
  987.                Dump_Statement_Database (Get_Condition (Ref), File,
  988.                                         Dumping_Bodies);
  989.                Outputln (File, " then");
  990.                Indent;
  991.                if not Is_Empty (Get_Head_Of_True_Task_Statements_List (Ref))
  992.                    then
  993.                   Dump_Statement_Database
  994.                       (Get_Head_Of_True_Task_Statements_List (Ref), File,
  995.                        Dumping_Bodies);
  996.                else
  997.                   Print_Indent (File);
  998.                   Outputln (File, "null;");
  999.                end if;
  1000.                Exdent;
  1001.                if not Is_Empty (Get_Head_Of_False_Task_Statements_List (Ref))
  1002.                    then
  1003.                   Print_Indent (File);
  1004.                   Outputln (File, "else");
  1005.                   Indent;
  1006.                   Dump_Statement_Database
  1007.                       (Get_Head_Of_False_Task_Statements_List (Ref), File,
  1008.                        Dumping_Bodies);
  1009.                   Exdent;
  1010.                end if;
  1011.                Print_Indent (File);
  1012.                Outputln (File, "end if;");
  1013.  
  1014.             when Case_Statement     =>
  1015.                Print_Indent (File);
  1016.                Output (File, "case ");
  1017.                Dump_Statement_Database (Get_Expression (Ref), File,
  1018.                                         Dumping_Bodies);
  1019.                Outputln (File, " is");
  1020.                Indent;
  1021.                Dump_Statement_Database (Get_Alternatives_List (Ref), File,
  1022.                                         Dumping_Bodies);
  1023.                Exdent;
  1024.                Print_Indent (File);
  1025.                Outputln (File, "end case;");
  1026.  
  1027.             when Case_Alternative_Part   =>
  1028.                Print_Indent (File);
  1029.                Output (File, "when ");
  1030.                Dump_Statement_Database (Get_Alternative_Choice (Ref), File,
  1031.                                         Dumping_Bodies);
  1032.                Outputln (File, " => ");
  1033.                Indent;
  1034.                Dump_Statement_Database
  1035.                    (Get_Alternative_Statements (Ref), File, Dumping_Bodies);
  1036.                Exdent;
  1037.                if not Is_Empty (Get_Next_Alternative (Ref)) then
  1038.                   Dump_Statement_Database (Get_Next_Alternative (Ref), File,
  1039.                                            Dumping_Bodies);
  1040.                end if;
  1041.  
  1042.             when Labeled_Statement  =>
  1043.                Print_Indent (File);
  1044.                Output (File, "<<");
  1045.                Dump_Statement_Database (Get_Label_Entry (Ref), File,
  1046.                                         Dumping_Bodies);
  1047.                Outputln (File, ">>");
  1048.  
  1049.             when Goto_Statement     =>
  1050.                Print_Indent (File);
  1051.                Output (File, "goto ");
  1052.                Dump_Statement_Database (Get_Goto_Label (Ref), File,
  1053.                                         Dumping_Bodies);
  1054.                Outputln (File, ";");
  1055.  
  1056.             when Exit_Statement     =>
  1057.                Print_Indent (File);
  1058.                Output (File, "exit ");
  1059.                Dump_Statement_Database (Get_Name (Ref), File, Dumping_Bodies);
  1060.                if not Is_Empty (Get_Condition (Ref)) then
  1061.                   Output (File, " when ");
  1062.                   Dump_Statement_Database (Get_Condition (Ref), File,
  1063.                                            Dumping_Bodies);
  1064.                end if;
  1065.                Outputln (File, ";");
  1066.  
  1067.             when Return_Statement   =>
  1068.                Print_Indent (File);
  1069.                Output (File, "return ");
  1070.                if not Is_Empty (Get_Expression (Ref)) then
  1071.                   Dump_Statement_Database (Get_Expression (Ref), File,
  1072.                                            Dumping_Bodies);
  1073.                end if;
  1074.                Outputln (File, ";");
  1075.  
  1076.             when Block_Statement    =>
  1077.                if not Is_Empty (Get_Block_Declarations (Ref)) then
  1078.                   Print_Indent (File);
  1079.                   Outputln (File, "declare");
  1080.                   Indent;
  1081.                   Dump_Statement_Database (Get_Block_Declarations (Ref), File,
  1082.                                            Dumping_Bodies);
  1083.                   Exdent;
  1084.                end if;
  1085.  
  1086.                Print_Indent (File);
  1087.                Outputln (File, "begin");
  1088.                Indent;
  1089.                Dump_Statement_Database
  1090.                    (Get_Head_Of_Statements_List (Ref), File, Dumping_Bodies);
  1091.                Exdent;
  1092.                Print_Indent (File);
  1093.                Outputln (File, "end;");
  1094.  
  1095.             when With_Statement     =>
  1096.                Print_Indent (File);
  1097.                Output (File, "with ");
  1098.                Dump_Statement_Database (Get_Name_List (Ref), File,
  1099.                                         Dumping_Bodies);
  1100.                Outputln (File, ";");
  1101.  
  1102.             when Use_Statement =>
  1103.                Print_Indent (File);
  1104.                Output (File, "use  ");
  1105.                Dump_Statement_Database (Get_Name_List (Ref), File,
  1106.                                         Dumping_Bodies);
  1107.                Outputln (File, ";");
  1108.  
  1109.             when Procedure_Call     =>
  1110.                Print_Indent (File);
  1111.                Dump_Statement_Database (Get_Subprogram_Info (Ref), File,
  1112.                                         Dumping_Bodies);
  1113.                if not Is_Empty (Get_Parameter_List (Ref)) then
  1114.                   Output (File, "(");
  1115.                   Dump_Statement_Database (Get_Parameter_List (Ref), File,
  1116.                                            Dumping_Bodies);
  1117.                   Output (File, ")");
  1118.                end if;
  1119.                Outputln (File, ";");
  1120.  
  1121.             when Pragma_Statement   =>
  1122.                Print_Indent (File);
  1123.                Output (File, "pragma ");
  1124.                Dump_Statement_Database (Get_Name (Ref), File, Dumping_Bodies);
  1125.                if not Is_Empty (Get_Argument_List (Ref)) then
  1126.                   Output (File, "(");
  1127.                   Dump_Statement_Database (Get_Argument_List (Ref), File,
  1128.                                            Dumping_Bodies);
  1129.                   Output (File, ")");
  1130.                end if;
  1131.                Outputln (File, ";");
  1132.  
  1133.             when Null_Statement     =>
  1134.                Print_Indent (File);
  1135.                Outputln (File, "null;");
  1136.  
  1137.             when Unknown  =>
  1138.                null;
  1139.          end case;
  1140.  
  1141.          if not Is_Empty (Get_Next_Statement (Ref)) then
  1142.             Dump_Statement_Database (Get_Next_Statement (Ref), File,
  1143.                                      Dumping_Bodies);
  1144.          end if;
  1145.  
  1146.       end if;
  1147.    end Dump_Statement;
  1148.  
  1149.  
  1150.    procedure Dump_Expression (Ref            : Ref_Expression_Record;
  1151.                               File           : File_Type;
  1152.                               Dumping_Bodies : Boolean) is
  1153.    begin
  1154.       case Ref.Expression_Kind is
  1155.  
  1156.          when Dot_Operator     =>
  1157.             Dump_Statement_Database (Ref.Dot_Object, File, Dumping_Bodies);
  1158.             Output (File, ".");
  1159.             Dump_Statement_Database (Ref.Dot_Component, File, Dumping_Bodies);
  1160.  
  1161.          when Left_Parenthesis_Operator  =>
  1162.             if Is_Infix
  1163.                    (Convert_To_String
  1164.                         (Ref.Lp_Object.Expression_Node.Symbol_Name)) then
  1165.                Output (File, "(");
  1166.                Dump_Statement_Database
  1167.                    (Ref.Lp_Items_List.Expression_Node.Item_Expression, File,
  1168.                     Dumping_Bodies);
  1169.                Quote_Infix := False;
  1170.                Output (File, " ");
  1171.                Dump_Statement_Database (Ref.Lp_Object, File, Dumping_Bodies);
  1172.                Output (File, " ");
  1173.                Quote_Infix := True;
  1174.                Dump_Statement_Database
  1175.                    (Ref.Lp_Items_List.Expression_Node.Next_List_Item, File,
  1176.                     Dumping_Bodies);
  1177.                Output (File, ")");
  1178.             else
  1179.                Dump_Statement_Database (Ref.Lp_Object, File, Dumping_Bodies);
  1180.                if Ref.Lp_Object = null or else Ref.Lp_Items_List /= null then
  1181.                   Output (File, "(");
  1182.                   Dump_Statement_Database (Ref.Lp_Items_List, File,
  1183.                                            Dumping_Bodies);
  1184.                   Output (File, ")");
  1185.                end if;
  1186.             end if;
  1187.  
  1188.          when List_Item   =>
  1189.  
  1190.             Dump_Statement_Database (Ref.Item_Expression, File, Dumping_Bodies);
  1191.  
  1192.             if Ref.Next_List_Item /= null then
  1193.                Output (File, ", ");
  1194.                Dump_Statement_Database (Ref.Next_List_Item, File,
  1195.                                         Dumping_Bodies);
  1196.             end if;
  1197.  
  1198.          when Aggregate_Component   =>
  1199.             Dump_Statement_Database
  1200.                 (Ref.Aggregate_Choice, File, Dumping_Bodies);
  1201.             Output (File, " => ");
  1202.             Dump_Statement_Database (Ref.Aggregate_Expression, File,
  1203.                                      Dumping_Bodies);
  1204.  
  1205.          when Range_Expression =>
  1206.             if Ref.Range_Name /= null then
  1207.                Dump_Statement_Database (Ref.Range_Name, File, Dumping_Bodies);
  1208.                Output (File, " range ");
  1209.             end if;
  1210.             Dump_Statement_Database (Ref.Lower_Bound, File, Dumping_Bodies);
  1211.             Output (File, "..");
  1212.             Dump_Statement_Database (Ref.Upper_Bound, File, Dumping_Bodies);
  1213.  
  1214.          when Attribute_Tick   =>
  1215.             Dump_Statement_Database
  1216.                 (Ref.Attribute_Prefix, File, Dumping_Bodies);
  1217.             Output (File, "'");
  1218.             Dump_Statement_Database (Ref.Attribute, File, Dumping_Bodies);
  1219.  
  1220.          when String_Node =>
  1221.             Output (File, '"' & Convert_To_String (Ref.String_Symbol) & '"');
  1222.  
  1223.          when Character_Node   =>
  1224.             Put (''' & Ref.Character_Symbol & ''');
  1225.  
  1226.          when Constant_Node    =>
  1227.             Output (File, Convert_To_String (Ref.Constant_Symbol));
  1228.  
  1229.          when Terminal_Node    =>
  1230.             if Is_Infix (Convert_To_String (Ref.Symbol_Name)) and Quote_Infix
  1231.                 then
  1232.                Output (File, """");
  1233.                Output (File, Convert_To_String (Ref.Symbol_Name));
  1234.                Output (File, """");
  1235.             else
  1236.                Output (File, Convert_To_String (Ref.Symbol_Name));
  1237.             end if;
  1238.  
  1239.          when Array_Reference                 |
  1240.               Function_Call                   |
  1241.               Type_Conversion                 |
  1242.               Record_Reference                |
  1243.               Dot_Notation_Variable_Reference |
  1244.               Unknown     =>
  1245.             null;
  1246.  
  1247.       end case;
  1248.    end Dump_Expression;
  1249.  
  1250.    procedure Dump_Statement_Database (Ref            : Ref_Statement_Database;
  1251.                                       File           : File_Type;
  1252.                                       Dumping_Bodies : Boolean := False) is
  1253.    begin
  1254.       if Ref /= null then
  1255.          case Ref.Node_Kind is
  1256.             when Statement_Node_Type     =>
  1257.                Dump_Statement (Ref, File, Dumping_Bodies);
  1258.             when Expression_Node_Type    =>
  1259.                Dump_Expression (Ref.Expression_Node, File, Dumping_Bodies);
  1260.             when Unknown  =>
  1261.                null;
  1262.          end case;
  1263.       end if;
  1264.    end Dump_Statement_Database;
  1265.  
  1266.    procedure Dump_Entire_Symtbl (Dump_Bodies : in Boolean := False) is
  1267.       Current_Entry : Ref_Symbol_Table_Entry;
  1268.    begin
  1269.       Put_Line ("Entire Symbol Table Dump =>");
  1270.       Current_Entry := Get_Top_Of_Symtbl;
  1271.       while not Is_Empty (Current_Entry) loop
  1272.          Dump_Symtbl (Current_Entry, Standard_Output, Dump_Bodies);
  1273.          New_Line;
  1274.          Current_Entry := Get_Next_Entry (Current_Entry);
  1275.       end loop;
  1276.    end Dump_Entire_Symtbl;
  1277.  
  1278. end Dump_Routines;
  1279.