with Text_IO; use Text_IO; with Ada.Strings.Unbounded, Ada.Characters.Handling, Ada.Directories; use Ada.Characters.Handling, Ada.Directories; -- This package covers the generation of skeletons for all supported languages -- There is no code that is specific to one particular language. The package -- looks for a sub-directory with the name of the language and checks that all -- skeleton-related template files are present. Then it fills the Template -- mappings and generate the corresponding code. package body TASTE.Backend.Skeletons is procedure Generate (Model : TASTE_Model) is Template : constant IV_As_Template := Interface_View_Template (Model.Interface_View); Prefix : constant String := Model.Configuration.Binary_Path.all & "templates/skeletons/"; use Ada.Strings.Unbounded; type Output is (Header, Code); -- Function checking that all templates files are available to support -- a given language (based on the directory name). function Is_Template_Present (Path : String) return Boolean is (Exists (Path) and then Kind (Path) = Directory and then Exists (Path & "interface-signature.tmplt") and then Exists (Path & "header.tmplt") and then Exists (Path & "body.tmplt") and then Exists (Path & "body-filename.tmplt") and then Exists (Path & "header-filename.tmplt") and then Exists (Path & "interface-body-parameter.tmplt") and then Exists (Path & "interface-header-parameter.tmplt")); function Process_Interfaces (Interfaces : Interface_Vectors.Vector; Path : String; Target : Output) return Tag is Interfaces_Tag : Tag; Tmplt_Param : constant String := Path & "interface-" & (if Target = Header then "header" else "body") & "-parameter.tmplt"; Tmplt_Sign : constant String := Path & "interface-signature.tmplt"; begin for Each of Interfaces loop declare Pool : Translate_Set := Each.Header; Params : Tag; begin for Param of Each.Params loop declare P : constant String := Parse (Tmplt_Param, Param); begin Params := Params & P; end; end loop; Pool := Pool & Assoc ("Parameters", Params); declare New_Interface : constant String := Parse (Tmplt_Sign, Pool); begin Interfaces_Tag := Interfaces_Tag & New_Interface; end; end; end loop; return Interfaces_Tag; end Process_Interfaces; begin Put_Line ("=== Generate skeletons ==="); for Each of Model.Interface_View.Flat_Functions loop declare Language : constant String := Language_Spelling (Each); Path : constant String := Prefix & To_Lower (Language) & "/"; Proceed : constant Boolean := Is_Template_Present (Path); Hdr_Tmpl : constant Translate_Set := +Assoc ("Name", Each.Name); Func_Tmpl : constant Func_As_Template := Template.Funcs.Element (To_String (Each.Name)); Func_Hdr : constant Translate_Set := (if Proceed then Func_Tmpl.Header & Assoc ("Provided_Interfaces", Process_Interfaces (Func_Tmpl.Provided, Path, Header)) & Assoc ("Required_Interfaces", Process_Interfaces (Func_Tmpl.Required, Path, Header)) else Null_Set); Header_Text : constant String := (if Proceed then Parse (Path & "header.tmplt", Func_Hdr) else ""); Func_Body : constant Translate_Set := (if Proceed then Func_Tmpl.Header & Assoc ("Provided_Interfaces", Process_Interfaces (Func_Tmpl.Provided, Path, Code)) & Assoc ("Required_Interfaces", Process_Interfaces (Func_Tmpl.Required, Path, Code)) else Null_Set); Body_Text : constant String := (if Proceed then Parse (Path & "body.tmplt", Func_Body) else ""); begin if Proceed then Put ("*** Generating "); Put_Line (Parse (Path & "header-filename.tmplt", Hdr_Tmpl)); Put_Line (Header_Text); Put ("*** Generating "); Put_Line (Parse (Path & "body-filename.tmplt", Hdr_Tmpl)); Put_Line (Body_Text); else Put_Line ("Ignoring function " & To_String (Each.Name)); end if; end; end loop; end Generate; function Parameter_Template (Param : ASN1_Parameter) return Translate_Set is (+Assoc ("Type", Param.Sort) & Assoc ("Name", Param.Name) & Assoc ("Direction", Param.Direction'Img)); function Interface_Template (TI : Taste_Interface) return Interface_As_Template is use Template_Vectors; Result : Interface_As_Template; begin Result.Header := +Assoc ("Name", TI.Name) & Assoc ("Parent_Function", TI.Parent_Function); for Each of TI.Params loop Result.Params := Result.Params & Parameter_Template (Each); end loop; return Result; end Interface_Template; function Func_Template (F : Taste_Terminal_Function) return Func_As_Template is use Interface_Vectors; Result : Func_As_Template; List_Of_PIs : Tag; List_Of_RIs : Tag; begin Result.Header := +Assoc ("Name", F.Name) & Assoc ("Language", F.Language'Img); for Each of F.Provided loop Result.Provided := Result.Provided & Interface_Template (Each); List_Of_PIs := List_Of_PIs & Each.Name; end loop; for Each of F.Required loop Result.Required := Result.Required & Interface_Template (Each); List_Of_RIs := List_Of_RIs & Each.Name; end loop; Result.Header := Result.Header & Assoc ("List_Of_PIs", List_Of_PIs) & Assoc ("List_Of_RIs", List_Of_RIs); return Result; end Func_Template; function Interface_View_Template (IV : Complete_Interface_View) return IV_As_Template is use Func_Maps; use Ada.Strings.Unbounded; Result : IV_As_Template; begin for Each of IV.Flat_Functions loop Result.Funcs.Insert (Key => To_String (Each.Name), New_Item => Func_Template (Each)); end loop; return Result; end Interface_View_Template; end TASTe.Backend.Skeletons;