taste-backend-skeletons.adb 6.82 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.Directories;
5

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

Maxime Perrotin's avatar
Maxime Perrotin committed
9
10
11
12
13
14
--  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
15
16
package body TASTE.Backend.Skeletons is
   procedure Generate (Model : TASTE_Model) is
Maxime Perrotin's avatar
Maxime Perrotin committed
17
      Template : constant IV_As_Template :=
Maxime Perrotin's avatar
Maxime Perrotin committed
18
        Interface_View_Template (Model.Interface_View);
Maxime Perrotin's avatar
Maxime Perrotin committed
19

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

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

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

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

            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 "");
Maxime Perrotin's avatar
Maxime Perrotin committed
102
         begin
Maxime Perrotin's avatar
Maxime Perrotin committed
103
            if Proceed then
Maxime Perrotin's avatar
Maxime Perrotin committed
104
105
               Put ("***  Generating ");
               Put_Line (Parse (Path & "header-filename.tmplt", Hdr_Tmpl));
Maxime Perrotin's avatar
Maxime Perrotin committed
106
               Put_Line (Header_Text);
Maxime Perrotin's avatar
Maxime Perrotin committed
107
108
               Put ("***  Generating ");
               Put_Line (Parse (Path & "body-filename.tmplt", Hdr_Tmpl));
Maxime Perrotin's avatar
Maxime Perrotin committed
109
               Put_Line (Body_Text);
Maxime Perrotin's avatar
Maxime Perrotin committed
110
            else
Maxime Perrotin's avatar
Maxime Perrotin committed
111
               Put_Line ("Ignoring function " & To_String (Each.Name));
Maxime Perrotin's avatar
Maxime Perrotin committed
112
            end if;
113
114
         end;
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
   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;
138
      use Ctxt_Params;
Maxime Perrotin's avatar
Maxime Perrotin committed
139
140
141
      Result      : Func_As_Template;
      List_Of_PIs : Tag;
      List_Of_RIs : Tag;
Maxime Perrotin's avatar
Maxime Perrotin committed
142
143
   begin
      Result.Header := +Assoc ("Name", F.Name)
144
145
        & Assoc ("Language", Language_Spelling (F))
        & Assoc ("Has_Context", (Length (F.Context_Params) > 0));
Maxime Perrotin's avatar
Maxime Perrotin committed
146
147
      for Each of F.Provided loop
         Result.Provided := Result.Provided & Interface_Template (Each);
Maxime Perrotin's avatar
Maxime Perrotin committed
148
         List_Of_PIs := List_Of_PIs & Each.Name;
Maxime Perrotin's avatar
Maxime Perrotin committed
149
150
151
      end loop;
      for Each of F.Required loop
         Result.Required := Result.Required & Interface_Template (Each);
Maxime Perrotin's avatar
Maxime Perrotin committed
152
         List_Of_RIs := List_Of_RIs & Each.Name;
Maxime Perrotin's avatar
Maxime Perrotin committed
153
      end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
154
155
156
      Result.Header := Result.Header
        & Assoc ("List_Of_PIs", List_Of_PIs)
        & Assoc ("List_Of_RIs", List_Of_RIs);
Maxime Perrotin's avatar
Maxime Perrotin committed
157
158
159
160
161
      return Result;
   end Func_Template;

   function Interface_View_Template (IV : Complete_Interface_View)
                                     return IV_As_Template is
162
163
      use Func_Maps;
      use Ada.Strings.Unbounded;
Maxime Perrotin's avatar
Maxime Perrotin committed
164
165
166
      Result : IV_As_Template;
   begin
      for Each of IV.Flat_Functions loop
167
168
         Result.Funcs.Insert (Key      => To_String (Each.Name),
                              New_Item => Func_Template (Each));
Maxime Perrotin's avatar
Maxime Perrotin committed
169
170
171
172
173
      end loop;
      return Result;
   end Interface_View_Template;

end TASTe.Backend.Skeletons;