1------------------------------------------------------------------------------
2--                                                                          --
3--                            Matreshka Project                             --
4--                                                                          --
5--                               Web Framework                              --
6--                                                                          --
7--                              Tools Component                             --
8--                                                                          --
9------------------------------------------------------------------------------
10--                                                                          --
11-- Copyright © 2015, Vadim Godunko <vgodunko@gmail.com>                     --
12-- All rights reserved.                                                     --
13--                                                                          --
14-- Redistribution and use in source and binary forms, with or without       --
15-- modification, are permitted provided that the following conditions       --
16-- are met:                                                                 --
17--                                                                          --
18--  * Redistributions of source code must retain the above copyright        --
19--    notice, this list of conditions and the following disclaimer.         --
20--                                                                          --
21--  * Redistributions in binary form must reproduce the above copyright     --
22--    notice, this list of conditions and the following disclaimer in the   --
23--    documentation and/or other materials provided with the distribution.  --
24--                                                                          --
25--  * Neither the name of the Vadim Godunko, IE nor the names of its        --
26--    contributors may be used to endorse or promote products derived from  --
27--    this software without specific prior written permission.              --
28--                                                                          --
29-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS      --
30-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT        --
31-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR    --
32-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT     --
33-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,   --
34-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED --
35-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR   --
36-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF   --
37-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING     --
38-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS       --
39-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.             --
40--                                                                          --
41------------------------------------------------------------------------------
42--  $Revision: 5280 $ $Date: 2015-05-12 19:18:31 +0300 (Tue, 12 May 2015) $
43------------------------------------------------------------------------------
44with Asis.Declarations;
45with Asis.Elements;
46
47with Properties.Tools;
48
49package body Properties.Declarations.Procedure_Body_Declarations is
50
51   ----------
52   -- Code --
53   ----------
54
55   function Code
56     (Engine  : access Engines.Contexts.Context;
57      Element : Asis.Declaration;
58      Name    : Engines.Text_Property) return League.Strings.Universal_String
59   is
60
61      Spec : constant Asis.Declaration :=
62        Asis.Declarations.Corresponding_Declaration (Element);
63
64      Is_Library_Level : constant Boolean := Asis.Elements.Is_Nil
65        (Asis.Elements.Enclosing_Element (Element));
66
67      Inside_Package : constant Boolean := Engine.Boolean.Get_Property
68        (Element, Engines.Inside_Package);
69
70      Is_Dispatching : constant Boolean := Engine.Boolean.Get_Property
71        (Element, Engines.Is_Dispatching);
72
73      Subprogram_Name : constant League.Strings.Universal_String :=
74        Engine.Text.Get_Property
75          (Element => Asis.Declarations.Names (Element) (1),
76           Name    => Name);
77
78      Text : League.Strings.Universal_String;
79   begin
80      if Is_Library_Level then
81         Text.Append
82           (Properties.Tools.Library_Level_Header
83              (Asis.Elements.Enclosing_Compilation_Unit (Element)));
84         Text.Append ("return _ec.");
85         Text.Append (Subprogram_Name);
86         Text.Append ("=");
87      elsif Is_Dispatching then
88         declare
89            Tipe     : constant Asis.Declaration :=
90              Tools.Corresponding_Type (Spec);
91            Type_Name : constant Asis.Defining_Name :=
92              Asis.Declarations.Names (Tipe) (1);
93            Image : constant League.Strings.Universal_String :=
94              Engine.Text.Get_Property (Type_Name, Name);
95         begin
96            if Inside_Package then
97               Text.Append ("_ec.");
98            end if;
99
100            Text.Append (Image);
101            Text.Append (".prototype.");
102            Text.Append (Subprogram_Name);
103            Text.Append (" = ");
104         end;
105      elsif Inside_Package then
106         Text.Append ("_ec.");
107         Text.Append (Subprogram_Name);
108         Text.Append ("=");
109      end if;
110
111      Text.Append ("function ");
112      Text.Append (Subprogram_Name);
113      Text.Append (" (");
114
115      declare
116         List : constant Asis.Declaration_List :=
117           Asis.Declarations.Parameter_Profile (Element);
118      begin
119         for J in List'Range loop
120            declare
121               Arg_Code : constant League.Strings.Universal_String :=
122                 Engine.Text.Get_Property
123                   (Asis.Declarations.Names (List (J)) (1), Name);
124            begin
125               if not Is_Dispatching or J /= List'First then
126                  Text.Append (Arg_Code);
127
128                  if J /= List'Last then
129                     Text.Append (",");
130                  end if;
131               end if;
132            end;
133         end loop;
134      end;
135
136      Text.Append ("){");
137
138      declare
139         List : constant Asis.Element_List :=
140           Asis.Declarations.Body_Declarative_Items (Element);
141      begin
142         for J in List'Range loop
143            declare
144               Var_Code : constant League.Strings.Universal_String :=
145                 Engine.Text.Get_Property (List (J), Name);
146            begin
147               Text.Append (Var_Code);
148            end;
149         end loop;
150      end;
151
152      declare
153         List : constant Asis.Element_List :=
154           Asis.Declarations.Body_Statements (Element);
155      begin
156         for J in List'Range loop
157            declare
158               Stmt_Code : constant League.Strings.Universal_String :=
159                 Engine.Text.Get_Property (List (J), Name);
160            begin
161               Text.Append (Stmt_Code);
162            end;
163         end loop;
164      end;
165
166      Text.Append ("};");
167
168      if Is_Library_Level then
169         Text.Append ("});");
170      end if;
171
172      return Text;
173   end Code;
174
175   ------------
176   -- Export --
177   ------------
178
179   function Export
180     (Engine  : access Engines.Contexts.Context;
181      Element : Asis.Declaration;
182      Name    : Engines.Boolean_Property) return Boolean
183   is
184      Spec   : constant Asis.Declaration :=
185        Asis.Declarations.Corresponding_Declaration (Element);
186
187      Result : constant Wide_String :=
188        Properties.Tools.Get_Aspect (Element, "Export");
189   begin
190      if Result = "True" then
191         return True;
192      elsif Asis.Elements.Is_Nil (Spec) then
193         return False;
194      else
195         return Engine.Boolean.Get_Property (Spec, Name);
196      end if;
197   end Export;
198
199   --------------------
200   -- Is_Dispatching --
201   --------------------
202
203   function Is_Dispatching
204     (Engine  : access Engines.Contexts.Context;
205      Element : Asis.Declaration;
206      Name    : Engines.Boolean_Property) return Boolean
207   is
208      Spec : constant Asis.Declaration :=
209        Asis.Declarations.Corresponding_Declaration (Element);
210   begin
211      if Asis.Elements.Is_Nil (Spec) then
212         return False;
213      else
214         return Engine.Boolean.Get_Property (Spec, Name);
215      end if;
216   end Is_Dispatching;
217
218end Properties.Declarations.Procedure_Body_Declarations;
219