taste-backend-skeletons.adb 8.6 KB
Newer Older
Maxime Perrotin's avatar
Maxime Perrotin committed
1
with Text_IO; use Text_IO;
2
with Ada.Strings.Unbounded,
3
     Ada.Characters.Handling,
Maxime Perrotin's avatar
Maxime Perrotin committed
4
     Ada.Exceptions,
Maxime Perrotin's avatar
Maxime Perrotin committed
5
     Ada.Directories;
6

7
use Ada.Characters.Handling,
Maxime Perrotin's avatar
Maxime Perrotin committed
8
    Ada.Exceptions,
Maxime Perrotin's avatar
Maxime Perrotin committed
9
    Ada.Directories;
Maxime Perrotin's avatar
Maxime Perrotin committed
10

Maxime Perrotin's avatar
Maxime Perrotin committed
11
12
13
14
15
16
--  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.

Maxime Perrotin's avatar
Maxime Perrotin committed
17
18
package body TASTE.Backend.Skeletons is
   procedure Generate (Model : TASTE_Model) is
Maxime Perrotin's avatar
Maxime Perrotin committed
19
      Template : constant IV_As_Template :=
Maxime Perrotin's avatar
Maxime Perrotin committed
20
        Interface_View_Template (Model.Interface_View);
Maxime Perrotin's avatar
Maxime Perrotin committed
21

22
23
      Prefix : constant String := Model.Configuration.Binary_Path.all
        & "templates/skeletons/";
Maxime Perrotin's avatar
Maxime Perrotin committed
24

25
      use Ada.Strings.Unbounded;
Maxime Perrotin's avatar
Maxime Perrotin committed
26
      type Output is (Header, Code);
Maxime Perrotin's avatar
Maxime Perrotin committed
27
28
29
30
31
32
33
34
35
36
37
38
39

      --  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"));

Maxime Perrotin's avatar
Maxime Perrotin committed
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
      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
56
                  declare
Maxime Perrotin's avatar
Maxime Perrotin committed
57
                     P : constant String := Parse (Tmplt_Param, Param);
58
                  begin
Maxime Perrotin's avatar
Maxime Perrotin committed
59
                     Params := Params & P;
60
                  end;
Maxime Perrotin's avatar
Maxime Perrotin committed
61
62
               end loop;
               Pool := Pool & Assoc ("Parameters", Params);
Maxime Perrotin's avatar
Maxime Perrotin committed
63
               declare
Maxime Perrotin's avatar
Maxime Perrotin committed
64
                  New_Interface : constant String := Parse (Tmplt_Sign, Pool);
Maxime Perrotin's avatar
Maxime Perrotin committed
65
               begin
Maxime Perrotin's avatar
Maxime Perrotin committed
66
                  Interfaces_Tag := Interfaces_Tag & New_Interface;
Maxime Perrotin's avatar
Maxime Perrotin committed
67
               end;
Maxime Perrotin's avatar
Maxime Perrotin committed
68
69
70
71
72
73
74
75
76
77
            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) & "/";
Maxime Perrotin's avatar
Maxime Perrotin committed
78
            Proceed    : constant Boolean := Is_Template_Present (Path);
Maxime Perrotin's avatar
Maxime Perrotin committed
79
            Hdr_Tmpl   : constant Translate_Set := +Assoc ("Name", Each.Name);
Maxime Perrotin's avatar
Maxime Perrotin committed
80

Maxime Perrotin's avatar
Maxime Perrotin committed
81
82
            Func_Tmpl  : constant Func_As_Template :=
              Template.Funcs.Element (To_String (Each.Name));
Maxime Perrotin's avatar
Maxime Perrotin committed
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102

            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 :=
103
104
105
106
107
                            (if Proceed
                             then Parse (Path & "body.tmplt", Func_Body)
                             else "");
            Output_Src  : constant String :=
                            Model.Configuration.Output_Dir.all
Maxime Perrotin's avatar
Maxime Perrotin committed
108
                            & "/" & To_Lower (To_String (Each.Name))
109
                            & "/" & Language
Maxime Perrotin's avatar
Maxime Perrotin committed
110
111
112
113
114
115
116
117
118
119
120
                            & "/" & "src" & "/";
            --  Get header and body filenames from templates
            Header_File : constant String :=
                            (if Proceed then Parse
                               (Path & "header-filename.tmplt", Hdr_Tmpl)
                             else "");
            Body_File   : constant String :=
                            (if Proceed then Parse
                               (Path & "body-filename.tmplt", Hdr_Tmpl)
                             else "");
            Output      : File_Type;
Maxime Perrotin's avatar
Maxime Perrotin committed
121
         begin
Maxime Perrotin's avatar
Maxime Perrotin committed
122
            if Proceed then
Maxime Perrotin's avatar
Maxime Perrotin committed
123
               --  Create directory tree (output/function/language/src)
124
               Create_Path (Output_Src);
Maxime Perrotin's avatar
Maxime Perrotin committed
125
126
127
128
129
130
131
132
133
134
135
136
137
138
               Put_Line ("***  Generating " & Header_File);
               Create (File => Output,
                       Mode => Out_File,
                       Name => Output_Src & Header_File);
               Put_Line (Output, Header_Text);
               Close (Output);
               if not Exists (Output_Src & Body_File) then
                  Put_Line ("***  Generating " & Body_File);
                  Create (File => Output,
                          Mode => Out_File,
                          Name => Output_Src & Body_File);
                  Put_Line (Output, Body_Text);
                  Close (Output);
               end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
139
            else
Maxime Perrotin's avatar
Maxime Perrotin committed
140
               Put_Line ("Ignoring function " & To_String (Each.Name));
Maxime Perrotin's avatar
Maxime Perrotin committed
141
            end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
142
143
144
145
146
147
148
149
         exception
            when E : End_Error =>
               if Is_Open (Output) then
                  Close (Output);
               end if;
               raise Skeleton_Error with "Generation of skeleton for function "
                 & To_String (Each.Name) & " failed : "
                 & Exception_Message (E);
150
151
         end;
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
   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;
175
      use Ctxt_Params;
Maxime Perrotin's avatar
Maxime Perrotin committed
176
177
178
      Result      : Func_As_Template;
      List_Of_PIs : Tag;
      List_Of_RIs : Tag;
Maxime Perrotin's avatar
Maxime Perrotin committed
179
      Timers      : Tag;
Maxime Perrotin's avatar
Maxime Perrotin committed
180
181
   begin
      Result.Header := +Assoc ("Name", F.Name)
182
183
        & Assoc ("Language", Language_Spelling (F))
        & Assoc ("Has_Context", (Length (F.Context_Params) > 0));
Maxime Perrotin's avatar
Maxime Perrotin committed
184
185
      for Each of F.Provided loop
         Result.Provided := Result.Provided & Interface_Template (Each);
Maxime Perrotin's avatar
Maxime Perrotin committed
186
         List_Of_PIs := List_Of_PIs & Each.Name;
Maxime Perrotin's avatar
Maxime Perrotin committed
187
188
189
      end loop;
      for Each of F.Required loop
         Result.Required := Result.Required & Interface_Template (Each);
Maxime Perrotin's avatar
Maxime Perrotin committed
190
         List_Of_RIs := List_Of_RIs & Each.Name;
Maxime Perrotin's avatar
Maxime Perrotin committed
191
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
192
193
194
      for Each of F.Timers loop
         Timers := Timers & Each;
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
195
196
      Result.Header := Result.Header
        & Assoc ("List_Of_PIs", List_Of_PIs)
Maxime Perrotin's avatar
Maxime Perrotin committed
197
198
        & Assoc ("List_Of_RIs", List_Of_RIs)
        & Assoc ("Timers", Timers);
Maxime Perrotin's avatar
Maxime Perrotin committed
199
200
201
202
203
      return Result;
   end Func_Template;

   function Interface_View_Template (IV : Complete_Interface_View)
                                     return IV_As_Template is
204
205
      use Func_Maps;
      use Ada.Strings.Unbounded;
Maxime Perrotin's avatar
Maxime Perrotin committed
206
207
208
      Result : IV_As_Template;
   begin
      for Each of IV.Flat_Functions loop
209
210
         Result.Funcs.Insert (Key      => To_String (Each.Name),
                              New_Item => Func_Template (Each));
Maxime Perrotin's avatar
Maxime Perrotin committed
211
212
213
214
215
      end loop;
      return Result;
   end Interface_View_Template;

end TASTe.Backend.Skeletons;