Revision 4a92cb37 src/backends/VHDL/vhdl_2_mini_vhdl_map.ml
src/backends/VHDL/vhdl_2_mini_vhdl_map.ml  

5  5 
{ 
6  6 
mutable entity: vhdl_entity_t; 
7  7 
mutable architecture: vhdl_architecture_t; 
8 
mutable architecture_signals_names: vhdl_name_t list; 

8  9 
mutable contexts: vhdl_load_t list; 
9  10 
} 
10  11  
...  ...  
100  101 
method virtual filter_entity : ((vhdl_load_t list * vhdl_entity_t) list * vhdl_name_t) > 
101  102 
(vhdl_load_t list * vhdl_entity_t) 
102  103  
103 
val mutable db : db_tuple_t list = [] 

104  
104 
(************************* 

105 
* Begin vhdl_name_t helpers 

106 
*) 

105  107 
method simplify_name_t : vhdl_name_t > vhdl_name_t= 
106  108 
fun n > 
109 
let lower a = String.lowercase_ascii a in 

110 
let n = self#lower_vhdl_name_t n in 

107  111 
match n with 
112 
 Selected (a::[]) > self#simplify_name_t a 

108  113 
 Selected (NoName::tl) > self#simplify_name_t (Selected tl) 
109 
 Selected ((Simple (s))::tl) > if (s = "work"  s= "Work")


114 
 Selected ((Simple (s))::tl) > if (lower s = "work")


110  115 
then self#simplify_name_t (Selected tl) 
111  116 
else n 
112 
 Selected (a::[]) > a 

117 
 Selected ((Identifier (s))::tl) > if (lower s = "work") 

118 
then self#simplify_name_t (Selected tl) 

119 
else n 

113  120 
 _ > n 
114 


121  
122 
method lower_vhdl_name_t : vhdl_name_t > vhdl_name_t= 

123 
fun x > 

124 
let lower a = String.lowercase_ascii a in 

125 
match x with 

126 
 Simple a > Simple (lower a) 

127 
 Identifier a > Identifier (lower a) 

128 
 Selected a > Selected (self#list self#lower_vhdl_name_t a) 

129 
 Index { id; exprs } > 

130 
let id = self#lower_vhdl_name_t id in 

131 
let exprs = self#list self#vhdl_expr_t exprs in 

132 
Index { id; exprs } 

133 
 Slice { id; range } > 

134 
let id = self#lower_vhdl_name_t id in 

135 
let range = self#vhdl_discrete_range_t range in 

136 
Slice { id; range } 

137 
 Attribute { id; designator; expr } > 

138 
let id = self#lower_vhdl_name_t id in 

139 
let designator = self#lower_vhdl_name_t designator in 

140 
let expr = self#vhdl_expr_t expr in 

141 
Attribute { id; designator; expr } 

142 
 Function { id; assoc_list } > 

143 
let id = self#lower_vhdl_name_t id in 

144 
let assoc_list = self#list self#vhdl_assoc_element_t assoc_list in 

145 
Function { id; assoc_list } 

146 
 NoName > NoName 

147 


148 
method to_string_vhdl_name_t : vhdl_name_t > string= 

149 
fun x > 

150 
match x with 

151 
 Simple a > a 

152 
 Identifier a > a 

153 
 Selected a > String.concat "." (List.map self#to_string_vhdl_name_t a) 

154 
 Index { id; exprs } > self#to_string_vhdl_name_t id 

155 
 Slice { id; range } > self#to_string_vhdl_name_t id 

156 
 Attribute { id; designator; expr } > self#to_string_vhdl_name_t id 

157 
 Function { id; assoc_list } > self#to_string_vhdl_name_t id 

158 
 NoName > "NoName" 

159 
(************************* 

160 
* End vhdl_name_t helpers 

161 
*) 

162  
163 
(************************* 

164 
* Begin DB helpers 

165 
*) 

166 
val mutable db : db_tuple_t list = [] 

167  
115  168 
method db_add_tuple : db_tuple_t > unit= 
116  169 
fun x > db < x::db 
117  170  
...  ...  
119  172 
fun x > 
120  173 
let rec find a dbl = 
121  174 
match dbl with 
122 
 [] > failwith "No matching tuple in DB"


175 
 [] > failwith ("No matching tuple in DB for architecture [" ^ self#to_string_vhdl_name_t x.name ^ "]")


123  176 
 e::tl > if (e.architecture = a) then (e.entity, e.contexts) else find a tl in find x db 
124  177  
125 
method get_get_from_archi_entity_name : (vhdl_name_t * vhdl_name_t) > db_tuple_t=


178 
method get_tuple_from_archi_and_entity_name : (vhdl_name_t * vhdl_name_t) > db_tuple_t=


126  179 
fun (a_name,e_name) > 
180 
let a_name = self#simplify_name_t a_name in 

181 
let e_name = self#simplify_name_t e_name in 

127  182 
let rec find (a_name,e_name) dbl = 
128  183 
match dbl with 
129 
 [] > failwith "No matching tuple in DB" 

130 
 e::tl > if ((self#simplify_name_t e.architecture.name = self#simplify_name_t a_name) && (self#simplify_name_t e.entity.name = self#simplify_name_t e_name)) 

131 
then e 

132 
else find (a_name,e_name) tl in 

184 
 [] > failwith ("No matching tuple in DB for architecture [" ^ self#to_string_vhdl_name_t a_name ^ 

185 
"] and entity [" ^ self#to_string_vhdl_name_t e_name ^ "]") 

186 
 e::tl > 

187 
let inner_e_arch_name = self#simplify_name_t e.architecture.name in 

188 
let inner_e_ent_name = self#simplify_name_t e.entity.name in 

189 
if ((inner_e_arch_name = a_name) && (inner_e_ent_name = e_name)) 

190 
then e 

191 
else find (a_name,e_name) tl in 

133  192 
find (a_name,e_name) db 
193 
(******************* 

194 
* End DB helpers 

195 
*) 

134  196  
135  197 
method vhdl_cst_val_t : vhdl_cst_val_t > vhdl_cst_val_t= 
136  198 
fun x > 
...  ...  
149  211 
 Bit_vector (a,b) > 
150  212 
let a = self#int a in let b = self#int b in Bit_vector (a, b) 
151  213 
 Array { indexes; const; definition } > 
152 
let indexes = self#list self#vhdl_name_t indexes in 

214 
let indexes = self#list self#lower_vhdl_name_t indexes in


153  215 
let const = self#option self#vhdl_constraint_t const in 
154  216 
let definition = self#vhdl_subtype_indication_t definition in 
155  217 
Array { indexes; const; definition } 
156  218 
 Record a > 
157  219 
let a = self#list self#vhdl_element_declaration_t a in Record a 
158  220 
 Enumerated a > 
159 
let a = self#list self#vhdl_name_t a in Enumerated a 

221 
let a = self#list self#lower_vhdl_name_t a in Enumerated a


160  222 
 Void > Void 
223  
161  224 
method vhdl_element_declaration_t : 
162  225 
vhdl_element_declaration_t > vhdl_element_declaration_t= 
163  226 
fun { names; definition } > 
164 
let names = self#list self#vhdl_name_t names in 

227 
let names = self#list self#lower_vhdl_name_t names in


165  228 
let definition = self#vhdl_subtype_indication_t definition in 
166  229 
{ names; definition } 
230  
167  231 
method vhdl_subtype_indication_t : 
168  232 
vhdl_subtype_indication_t > vhdl_subtype_indication_t= 
169  233 
fun { name; functionName; const } > 
170 
let name = self#vhdl_name_t name in 

171 
let functionName = self#vhdl_name_t functionName in 

234 
let name = self#lower_vhdl_name_t name in


235 
let functionName = self#lower_vhdl_name_t functionName in


172  236 
let const = self#vhdl_constraint_t const in 
173  237 
{ name; functionName; const } 
238  
174  239 
method vhdl_discrete_range_t : 
175  240 
vhdl_discrete_range_t > vhdl_discrete_range_t= 
176  241 
fun x > 
177  242 
match x with 
178  243 
 SubDiscreteRange a > 
179  244 
let a = self#vhdl_subtype_indication_t a in SubDiscreteRange a 
180 
 NamedRange a > let a = self#vhdl_name_t a in NamedRange a 

245 
 NamedRange a > let a = self#lower_vhdl_name_t a in NamedRange a


181  246 
 DirectedRange { direction; from; _to } > 
182  247 
let direction = self#string direction in 
183  248 
let from = self#vhdl_expr_t from in 
...  ...  
188  253 
fun x > 
189  254 
match x with 
190  255 
 RefConstraint { ref_name } > 
191 
let ref_name = self#vhdl_name_t ref_name in 

256 
let ref_name = self#lower_vhdl_name_t ref_name in


192  257 
RefConstraint { ref_name } 
193  258 
 RangeConstraint { range } > 
194  259 
let range = self#vhdl_discrete_range_t range in 
...  ...  
207  272 
fun x > 
208  273 
match x with 
209  274 
 Type { name; definition } > 
210 
let name = self#vhdl_name_t name in 

275 
let name = self#lower_vhdl_name_t name in


211  276 
let definition = self#vhdl_type_t definition in 
212  277 
Type { name; definition } 
213  278 
 Subtype { name; typ } > 
214 
let name = self#vhdl_name_t name in 

279 
let name = self#lower_vhdl_name_t name in


215  280 
let typ = self#vhdl_subtype_indication_t typ in 
216  281 
Subtype { name; typ } 
282  
217  283 
method vhdl_expr_t : vhdl_expr_t > vhdl_expr_t= 
218  284 
fun x > 
219  285 
match x with 
220 
 Call a > let a = self#vhdl_name_t a in Call a 

286 
 Call a > let a = self#lower_vhdl_name_t a in Call a


221  287 
 Cst { value; unit_name } > 
222  288 
let value = self#vhdl_cst_val_t value in 
223 
let unit_name = self#option self#vhdl_name_t unit_name in 

289 
let unit_name = self#option self#lower_vhdl_name_t unit_name in


224  290 
Cst { value; unit_name } 
225  291 
 Op { id; args } > 
226  292 
let id = self#string id in 
...  ...  
230  296 
let value = self#int value in 
231  297 
let phy_unit = self#string phy_unit in Time { value; phy_unit } 
232  298 
 Sig { name; att } > 
233 
let name = self#vhdl_name_t name in 

299 
let name = self#lower_vhdl_name_t name in


234  300 
let att = self#option self#vhdl_signal_attributes_t att in 
235  301 
Sig { name; att } 
236  302 
 SuffixMod { expr; selection } > 
...  ...  
241  307 
let elems = self#list self#vhdl_element_assoc_t elems in 
242  308 
Aggregate { elems } 
243  309 
 QualifiedExpression { type_mark; aggregate; expression } > 
244 
let type_mark = self#vhdl_name_t type_mark in 

310 
let type_mark = self#lower_vhdl_name_t type_mark in


245  311 
let aggregate = self#list self#vhdl_element_assoc_t aggregate in 
246  312 
let expression = self#option self#vhdl_expr_t expression in 
247  313 
QualifiedExpression { type_mark; aggregate; expression } 
248  314 
 Others > Others 
315  
249  316 
method vhdl_name_t : vhdl_name_t > vhdl_name_t= 
250  317 
fun x > 
251  318 
match x with 
252  319 
 Simple a > let a = self#string a in Simple a 
253  320 
 Identifier a > let a = self#string a in Identifier a 
254 
 Selected a > let a = self#list self#vhdl_name_t a in Selected a 

321 
 Selected a > let a = self#list self#lower_vhdl_name_t a in Selected a


255  322 
 Index { id; exprs } > 
256 
let id = self#vhdl_name_t id in 

323 
let id = self#lower_vhdl_name_t id in


257  324 
let exprs = self#list self#vhdl_expr_t exprs in 
258  325 
Index { id; exprs } 
259  326 
 Slice { id; range } > 
260 
let id = self#vhdl_name_t id in 

327 
let id = self#lower_vhdl_name_t id in


261  328 
let range = self#vhdl_discrete_range_t range in 
262  329 
Slice { id; range } 
263  330 
 Attribute { id; designator; expr } > 
264 
let id = self#vhdl_name_t id in 

265 
let designator = self#vhdl_name_t designator in 

331 
let id = self#lower_vhdl_name_t id in


332 
let designator = self#lower_vhdl_name_t designator in


266  333 
let expr = self#vhdl_expr_t expr in 
267  334 
Attribute { id; designator; expr } 
268  335 
 Function { id; assoc_list } > 
269 
let id = self#vhdl_name_t id in 

336 
let id = self#lower_vhdl_name_t id in


270  337 
let assoc_list = self#list self#vhdl_assoc_element_t assoc_list 
271  338 
in 
272  339 
Function { id; assoc_list } 
273  340 
 NoName > NoName 
341  
274  342 
method vhdl_assoc_element_t : 
275  343 
vhdl_assoc_element_t > vhdl_assoc_element_t= 
276  344 
fun 
277  345 
{ formal_name; formal_arg; actual_name; actual_designator; 
278  346 
actual_expr } 
279  347 
> 
280 
let formal_name = self#option self#vhdl_name_t formal_name in 

281 
let formal_arg = self#option self#vhdl_name_t formal_arg in 

282 
let actual_name = self#option self#vhdl_name_t actual_name in 

348 
let formal_name = self#option self#lower_vhdl_name_t formal_name in


349 
let formal_arg = self#option self#lower_vhdl_name_t formal_arg in


350 
let actual_name = self#option self#lower_vhdl_name_t actual_name in


283  351 
let actual_designator = 
284 
self#option self#vhdl_name_t actual_designator in 

352 
self#option self#lower_vhdl_name_t actual_designator in


285  353 
let actual_expr = self#option self#vhdl_expr_t actual_expr in 
286  354 
{ 
287  355 
formal_name; 
...  ...  
290  358 
actual_designator; 
291  359 
actual_expr 
292  360 
} 
361  
293  362 
method vhdl_element_assoc_t : 
294  363 
vhdl_element_assoc_t > vhdl_element_assoc_t= 
295  364 
fun { choices; expr } > 
296  365 
let choices = self#list self#vhdl_expr_t choices in 
297  366 
let expr = self#vhdl_expr_t expr in { choices; expr } 
367  
298  368 
method vhdl_array_attributes_t : 
299  369 
vhdl_array_attributes_t > vhdl_array_attributes_t= 
300  370 
fun x > 
...  ...  
303  373 
let id = self#string id in 
304  374 
let arg = self#int arg in AAttInt { id; arg } 
305  375 
 AAttAscending > AAttAscending 
376  
306  377 
method vhdl_signal_attributes_t : 
307  378 
vhdl_signal_attributes_t > vhdl_signal_attributes_t= 
308  379 
fun x > match x with  SigAtt a > let a = self#string a in SigAtt a 
380  
309  381 
method vhdl_string_attributes_t : 
310  382 
vhdl_string_attributes_t > vhdl_string_attributes_t= 
311  383 
fun x > 
312  384 
match x with  StringAtt a > let a = self#string a in StringAtt a 
385  
313  386 
method vhdl_suffix_selection_t : vhdl_suffix_selection_t > vhdl_suffix_selection_t= 
314  387 
fun x > 
315  388 
match x with 
...  ...  
336  409  
337  410 
method vhdl_parameter_t : vhdl_parameter_t > vhdl_parameter_t= 
338  411 
fun { names; mode; typ; init_val } > 
339 
let names = self#list self#vhdl_name_t names in 

412 
let names = self#list self#lower_vhdl_name_t names in


340  413 
let mode = self#list self#string mode in 
341  414 
let typ = self#vhdl_subtype_indication_t typ in 
342  415 
let init_val = self#option self#vhdl_cst_val_t init_val in 
...  ...  
347  420 
fun { name; subprogram_type; typeMark; parameters; isPure } > 
348  421 
let name = self#string name in 
349  422 
let subprogram_type = self#string subprogram_type in 
350 
let typeMark = self#vhdl_name_t typeMark in 

423 
let typeMark = self#lower_vhdl_name_t typeMark in


351  424 
let parameters = self#list self#vhdl_parameter_t parameters in 
352  425 
let isPure = self#bool isPure in 
353  426 
{ name; subprogram_type; typeMark; parameters; isPure } 
...  ...  
357  430 
fun x > 
358  431 
match x with 
359  432 
 VarAssign { label; lhs; rhs } > 
360 
let label = self#vhdl_name_t label in 

361 
let lhs = self#vhdl_name_t lhs in 

433 
let label = self#lower_vhdl_name_t label in


434 
let lhs = self#lower_vhdl_name_t lhs in


362  435 
let rhs = self#vhdl_expr_t rhs in VarAssign { label; lhs; rhs } 
363  436 
 SigSeqAssign { label; lhs; rhs } > 
364 
let label = self#vhdl_name_t label in 

365 
let lhs = self#vhdl_name_t lhs in 

437 
let label = self#lower_vhdl_name_t label in


438 
let lhs = self#lower_vhdl_name_t lhs in


366  439 
let rhs = self#list self#vhdl_waveform_element_t rhs in 
367  440 
SigSeqAssign { label; lhs; rhs } 
368  441 
 If { label; if_cases; default } > 
369 
let label = self#vhdl_name_t label in 

442 
let label = self#lower_vhdl_name_t label in


370  443 
let if_cases = self#list self#vhdl_if_case_t if_cases in 
371  444 
let default = self#list self#vhdl_sequential_stmt_t default in 
372  445 
If { label; if_cases; default } 
373  446 
 Case { label; guard; branches } > 
374 
let label = self#vhdl_name_t label in 

447 
let label = self#lower_vhdl_name_t label in


375  448 
let guard = self#vhdl_expr_t guard in 
376  449 
let branches = self#list self#vhdl_case_item_t branches in 
377  450 
Case { label; guard; branches } 
378  451 
 Exit { label; loop_label; condition } > 
379 
let label = self#vhdl_name_t label in 

452 
let label = self#lower_vhdl_name_t label in


380  453 
let loop_label = self#option self#string loop_label in 
381  454 
let condition = self#option self#vhdl_expr_t condition in 
382  455 
Exit { label; loop_label; condition } 
383  456 
 Assert { label; cond; report; severity } > 
384 
let label = self#vhdl_name_t label in 

457 
let label = self#lower_vhdl_name_t label in


385  458 
let cond = self#vhdl_expr_t cond in 
386  459 
let report = self#vhdl_expr_t report in 
387  460 
let severity = self#vhdl_expr_t severity in 
388  461 
Assert { label; cond; report; severity } 
389  462 
 ProcedureCall { label; name; assocs } > 
390 
let label = self#vhdl_name_t label in 

391 
let name = self#vhdl_name_t name in 

463 
let label = self#lower_vhdl_name_t label in


464 
let name = self#lower_vhdl_name_t name in


392  465 
let assocs = self#list self#vhdl_assoc_element_t assocs in 
393  466 
ProcedureCall { label; name; assocs } 
394  467 
 Wait > Wait 
395  468 
 Null { label } > 
396 
let label = self#vhdl_name_t label in Null { label } 

469 
let label = self#lower_vhdl_name_t label in Null { label }


397  470 
 Return { label; expr } > 
398 
let label = self#option self#vhdl_name_t label in 

471 
let label = self#option self#lower_vhdl_name_t label in


399  472 
let expr = self#option self#vhdl_expr_t expr in 
400  473 
Return { label; expr } 
474  
401  475 
method vhdl_if_case_t : vhdl_if_case_t > vhdl_if_case_t= 
402  476 
fun { if_cond; if_block } > 
403  477 
let if_cond = self#vhdl_expr_t if_cond in 
404  478 
let if_block = self#list self#vhdl_sequential_stmt_t if_block in 
405  479 
{ if_cond; if_block } 
480  
406  481 
method vhdl_case_item_t : vhdl_case_item_t > vhdl_case_item_t= 
407  482 
fun { when_cond; when_stmt } > 
408  483 
let when_cond = self#list self#vhdl_expr_t when_cond in 
...  ...  
413  488 
fun x > 
414  489 
match x with 
415  490 
 VarDecl { names; typ; init_val } > 
416 
let names = self#list self#vhdl_name_t names in 

491 
let names = self#list self#lower_vhdl_name_t names in


417  492 
let typ = self#vhdl_subtype_indication_t typ in 
418  493 
let init_val = self#vhdl_expr_t init_val in 
419  494 
VarDecl { names; typ; init_val } 
420  495 
 CstDecl { names; typ; init_val } > 
421 
let names = self#list self#vhdl_name_t names in 

496 
let names = self#list self#lower_vhdl_name_t names in


422  497 
let typ = self#vhdl_subtype_indication_t typ in 
423  498 
let init_val = self#vhdl_expr_t init_val in 
424  499 
CstDecl { names; typ; init_val } 
425  500 
 SigDecl { names; typ; init_val } > 
426 
let names = self#list self#vhdl_name_t names in 

501 
let names = self#list self#lower_vhdl_name_t names in


427  502 
let typ = self#vhdl_subtype_indication_t typ in 
428  503 
let init_val = self#vhdl_expr_t init_val in 
429  504 
SigDecl { names; typ; init_val } 
430  505 
 ComponentDecl { name; generics; ports } > 
431 
let name = self#vhdl_name_t name in 

506 
let name = self#lower_vhdl_name_t name in


432  507 
let generics = self#list self#vhdl_port_t generics in 
433  508 
let ports = self#list self#vhdl_port_t ports in 
434  509 
ComponentDecl { name; generics; ports } 
...  ...  
469  544 
vhdl_conditional_signal_t > vhdl_conditional_signal_t= 
470  545 
fun { postponed; label; lhs; rhs; delay } > 
471  546 
let postponed = self#bool postponed in 
472 
let label = self#vhdl_name_t label in 

473 
let lhs = self#vhdl_name_t lhs in 

547 
let label = self#lower_vhdl_name_t label in


548 
let lhs = self#lower_vhdl_name_t lhs in


474  549 
let rhs = self#list self#vhdl_signal_condition_t rhs in 
475  550 
let delay = self#vhdl_expr_t delay in 
476  551 
{ postponed; label; lhs; rhs; delay } 
477  552  
478  553 
method vhdl_process_t : vhdl_process_t > vhdl_process_t= 
479  554 
fun { id; declarations; active_sigs; body } > 
480 
let id = self#vhdl_name_t id in 

555 
let id = self#lower_vhdl_name_t id in


481  556 
let declarations = self#list self#vhdl_declarative_item_t declarations in 
482 
let active_sigs = self#list self#vhdl_name_t active_sigs in 

557 
let active_sigs = self#list self#lower_vhdl_name_t active_sigs in


483  558 
let body = self#list self#vhdl_sequential_stmt_t body in 
484  559 
{ id; declarations; active_sigs; body } 
485  560  
...  ...  
487  562 
vhdl_selected_signal_t > vhdl_selected_signal_t= 
488  563 
fun { postponed; label; lhs; sel; branches; delay } > 
489  564 
let postponed = self#bool postponed in 
490 
let label = self#vhdl_name_t label in 

491 
let lhs = self#vhdl_name_t lhs in 

565 
let label = self#lower_vhdl_name_t label in


566 
let lhs = self#lower_vhdl_name_t lhs in


492  567 
let sel = self#vhdl_expr_t sel in 
493  568 
let branches = self#list self#vhdl_signal_selection_t branches in 
494  569 
let delay = self#option self#vhdl_expr_t delay in 
...  ...  
500  575 
method vhdl_component_instantiation_t : 
501  576 
vhdl_component_instantiation_t > mini_vhdl_component_instantiation_t= 
502  577 
fun { name; inst_unit; inst_unit_type; archi_name; generic_map; port_map } > 
503 
let name = self#vhdl_name_t name in 

504 
let archi_name = self#option self#vhdl_name_t archi_name in 

578 
let name = self#lower_vhdl_name_t name in 

579 
let archi_name = self#option self#lower_vhdl_name_t archi_name in 

580 
let inst_unit = self#lower_vhdl_name_t inst_unit in 

505  581 
let db_tuple = match archi_name with 
506 
 None > failwith "Component is not an entity"


507 
 Some a > self#get_get_from_archi_entity_name (a,inst_unit) in (* Get corresponding tuple in db *)


582 
 None > failwith ("Component [" ^ self#to_string_vhdl_name_t name ^ "] is not an entity")


583 
 Some a > self#get_tuple_from_archi_and_entity_name (a, inst_unit) in (* Get corresponding tuple in db *)


508  584 
let archi = db_tuple.architecture in 
509  585 
let entity = db_tuple.entity in 
510  586 
let generic_map = self#list self#vhdl_assoc_element_t generic_map in 
...  ...  
522  598  
523  599 
method vhdl_port_t : vhdl_port_t > vhdl_port_t= 
524  600 
fun { names; mode; typ; expr } > 
525 
let names = self#list self#vhdl_name_t names in 

601 
let names = self#list self#lower_vhdl_name_t names in


526  602 
let mode = self#vhdl_port_mode_t mode in 
527  603 
let typ = self#vhdl_subtype_indication_t typ in 
528  604 
let expr = self#vhdl_expr_t expr in { names; mode; typ; expr } 
529  605  
530  606 
method vhdl_entity_t : vhdl_entity_t > unit = 
531  607 
fun { name; generics; ports; declaration; stmts } > () 
532 
(* let name = self#vhdl_name_t name in 

533 
let generics = self#list self#vhdl_port_t generics in 

534 
let ports = self#list self#vhdl_port_t ports in 

535 
let declaration = self#list self#vhdl_declarative_item_t declaration 

536 
in 

537 
let stmts = self#list self#vhdl_concurrent_stmt_t stmts in () *) 

538  
539 


540  608  
541  609 
method vhdl_package_t : (vhdl_load_t list * vhdl_package_t) > vhdl_package_t= 
542  610 
fun ( ctxs, {name; shared_defs; shared_decls; shared_uses }) > 
543 
let name = self#vhdl_name_t name in 

611 
let name = self#lower_vhdl_name_t name in


544  612 
let shared_defs = self#list self#vhdl_definition_t shared_defs in 
545  613 
let shared_decls = self#list self#vhdl_declaration_t shared_decls in 
546  614 
let shared_uses = self#list self#vhdl_load_t shared_uses @ ctxs in 
...  ...  
549  617 
method vhdl_load_t : vhdl_load_t > vhdl_load_t= 
550  618 
fun x > 
551  619 
match x with 
552 
 Library a > let a = self#list self#vhdl_name_t a in Library a 

553 
 Use a > let a = self#list self#vhdl_name_t a in Use a 

620 
 Library a > let a = self#list self#lower_vhdl_name_t a in Library a


621 
 Use a > let a = self#list self#lower_vhdl_name_t a in Use a


554  622  
555  623 
method vhdl_architecture_t : ((vhdl_load_t list * vhdl_package_t) list * 
556  624 
(vhdl_load_t list * vhdl_entity_t) list * 
...  ...  
559  627 
fun ( packs_pairs, ents_pairs, confs_pairs, (arch_ctx, arch) ) > 
560  628 
let names = arch.name::(arch.entity::[]) in 
561  629 
let (ref_ent_ctx,ref_ent) = self#filter_entity (ents_pairs, arch.entity) in 
562 
self#db_add_tuple {entity=ref_ent; architecture=arch; contexts=ref_ent_ctx@arch_ctx}; 

630 
self#db_add_tuple {entity=ref_ent; architecture=arch; architecture_signals_names=[]; contexts=ref_ent_ctx@arch_ctx};


563  631 
let contexts = 
564  632 
ref_ent_ctx @ (* Referenced entity context elements *) 
565  633 
arch_ctx @ (* Architecture context elements *) 
...  ...  
576  644 
List.map self#vhdl_concurrent_stmt_t arch.body in (* Architecture concurrent statements *) 
577  645 
let generics = ref_ent.generics in (* Referenced entity generics *) 
578  646 
let ports = ref_ent.ports in (* Referenced entity ports *) 
647 
(* Add declarations names in db *) 

579  648 
{ names; generics=generics; ports=ports; contexts=contexts; declarations=declarations; definitions=definitions; body=body } 
580  649  
581  650 
method declarative_items_declarations : vhdl_declarative_item_t list > vhdl_declaration_t list = 
...  ...  
603  672 
(vhdl_load_t list * vhdl_entity_t) = 
604  673 
fun ( entities_pair, filter_name ) > 
605  674 
let rec filter ep n = match ep with 
606 
 [] > failwith "Impossible to find a matching entity"


675 
 [] > failwith ("Impossible to find an entity with name [" ^ self#to_string_vhdl_name_t filter_name ^ "]")


607  676 
 (c,{name; generics; ports; declaration;stmts})::tl > 
608  677 
if (name = n) then 
609  678 
List.hd ep 
...  ...  
615  684  
616  685 
method vhdl_library_unit_t : vhdl_library_unit_t > unit= 
617  686 
fun x > () 
618 
(* match x with 

619 
 Package a > let a = self#vhdl_package_t ([],a) in () 

620 
 Entities a > let a = self#vhdl_entity_t a in () 

621 
 Architecture a > 

622 
let a = self#vhdl_architecture_t ([],[],[],([],a)) in () 

623 
 Configuration a > 

624 
let a = self#vhdl_configuration_t a in () *) 

625  687  
626  688 
method vhdl_design_unit_t : vhdl_design_unit_t > unit= 
627  689 
fun { contexts; library } > () 
628 
(* let contexts = self#list self#vhdl_load_t contexts in 

629 
let library = self#vhdl_library_unit_t library in () *) 

630  690  
631  691 
method vhdl_design_file_t : vhdl_design_file_t > mini_vhdl_design_file_t= 
632  692 
fun { design_units } > 
Also available in: Unified diff