1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--   O C A R I N A . M E _ A A D L _ E M A . E M A _ T R E E . D E B U G    --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--         Copyright (C) 2016-2019 ESA & ISAE, 2019-2020 OpenAADL           --
10
--                                                                          --
11
-- Ocarina  is free software; you can redistribute it and/or modify under   --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion. Ocarina is distributed in the hope that it will be useful, but     --
15
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
16
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
17
--                                                                          --
18
-- As a special exception under Section 7 of GPL version 3, you are granted --
19
-- additional permissions described in the GCC Runtime Library Exception,   --
20
-- version 3.1, as published by the Free Software Foundation.               --
21
--                                                                          --
22
-- You should have received a copy of the GNU General Public License and    --
23
-- a copy of the GCC Runtime Library Exception along with this program;     --
24
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
27
--                    Ocarina is maintained by OpenAADL team                --
28
--                              (info@openaadl.org)                         --
29
--                                                                          --
30
------------------------------------------------------------------------------
31

32
--  Debug function for EMA tree
33

34
with Locations;                use Locations;
35
with Ocarina.Namet;            use Ocarina.Namet;
36
with Utils;                    use Utils;
37

38
package body Ocarina.ME_AADL_EMA.EMA_Tree.Debug is
39

40
   -----------
41
   -- Image --
42
   -----------
43

44 0
   function Image (N : Node_Kind) return String is
45 0
      I : constant String := Node_Kind'Image (N);
46
   begin
47 0
      return I (3 .. I'Last);
48 0
   end Image;
49

50 0
   function Image (N : Mode_Id) return String is
51
   begin
52 0
      case N is
53 0
         when Mode_In =>
54 0
            return Quoted ("in");
55 0
         when Mode_Inout =>
56 0
            return Quoted ("inout");
57 0
         when Mode_Out =>
58 0
            return Quoted ("out");
59
      end case;
60
   end Image;
61

62 0
   procedure W_Indentation is
63
   begin
64 0
      for I in 1 .. N_Indents loop
65 0
         Write_Str ("   ");
66 0
      end loop;
67 0
   end W_Indentation;
68

69 0
   procedure W_Boolean (N : Boolean) is
70
   begin
71 0
      Write_Str (N'Img);
72 0
   end W_Boolean;
73

74 0
   procedure W_Byte (N : Byte) is
75
   begin
76 0
      Write_Int (Int (N));
77 0
   end W_Byte;
78

79 0
   procedure W_List_Id (L : List_Id) is
80 0
      E : Node_Id;
81
   begin
82 0
      if L = No_List then
83 0
         return;
84
      end if;
85

86 0
      E := First_Node (L);
87 0
      while E /= No_Node loop
88 0
         W_Node_Id (E);
89 0
         E := Next_Node (E);
90 0
      end loop;
91
   end W_List_Id;
92

93 0
   procedure W_Node_Attribute
94
     (A : String;
95
      T : String;
96
      V : String;
97
      N : Int := 0)
98
   is
99 0
      C : Node_Id;
100
   begin
101 0
      if A = "Next_Node"
102 0
        or else A = "Homonym"
103 0
        or else A = "Name"
104
      then
105 0
         return;
106
      end if;
107

108 0
      N_Indents := N_Indents + 1;
109 0
      W_Indentation;
110 0
      Write_Str  (A);
111 0
      Write_Char (' ');
112 0
      Write_Str  (T);
113 0
      Write_Char (' ');
114 0
      C := Node_Id (N);
115 0
      if T = "Name_Id" then
116 0
         Write_Line (Quoted (V));
117 0
      elsif T = "Node_Id"
118 0
        and then Present (C)
119
      then
120 0
         case Kind (C) is
121
            when others =>
122 0
               Write_Line (V);
123
         end case;
124
      else
125 0
         Write_Line (V);
126
      end if;
127

128 0
      if T = "Node_Id" then
129 0
         W_Node_Id (Node_Id (N));
130 0
      elsif T = "List_Id" then
131 0
         W_List_Id (List_Id (N));
132
      end if;
133

134 0
      N_Indents := N_Indents - 1;
135
   end W_Node_Attribute;
136

137 0
   procedure W_Node_Id (N : Node_Id) is
138
   begin
139 0
      if N = No_Node then
140 0
         return;
141
      end if;
142 0
      W_Node (N);
143
   end W_Node_Id;
144

145 0
   procedure W_Node_Header (N : Node_Id) is
146
   begin
147 0
      W_Indentation;
148 0
      Write_Int   (Int (N));
149 0
      Write_Char  (' ');
150 0
      Write_Str   (Image (Kind (N)));
151 0
      Write_Char  (' ');
152 0
      Write_Line  (Image (Loc (N)));
153 0
   end W_Node_Header;
154

155 0
   function Image (N : Name_Id) return String is
156
   begin
157 0
      if N = No_Name then
158 0
         return No_Str;
159
      else
160 0
         return Get_Name_String (N);
161
      end if;
162 0
   end Image;
163

164 0
   function Image (N : Node_Id) return String is
165
   begin
166 0
      return Image (Int (N));
167 0
   end Image;
168

169 0
   function Image (N : List_Id) return String is
170
   begin
171 0
      return Image (Int (N));
172 0
   end Image;
173

174 0
   function Image (N : Operator_Id) return String is
175
   begin
176 0
      return Image (Byte (N));
177 0
   end Image;
178

179 0
   function Image (N : Value_Id) return String is
180
   begin
181 0
      return Image (Int (N));
182 0
   end Image;
183

184 0
   function Image (N : Boolean) return String is
185
   begin
186 0
      return Boolean'Image (N);
187 0
   end Image;
188

189 0
   function Image (N : Byte) return String is
190
   begin
191 0
      return Image (Int (N));
192 0
   end Image;
193

194 0
   function Image (N : Int) return String is
195 0
      S : constant String := Int'Image (N);
196
   begin
197 0
      return S (S'First + 1 .. S'Last);
198 0
   end Image;
199

200
end Ocarina.ME_AADL_EMA.EMA_Tree.Debug;

Read our documentation on viewing source code .

Loading