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