Revision 13872a54 src/tools/importer/mini_vhdl_to_lustre.ml
src/tools/importer/mini_vhdl_to_lustre.ml  

5  5 
open Lustre_types 
6  6 
open Utils 
7  7  
8 
let _ = fun (_ : mini_vhdl_component_instantiation_t) > () 

9 
let _ = fun (_ : mini_vhdl_concurrent_stmt_t) > () 

10 
let _ = fun (_ : mini_vhdl_component_t) > () 

11 
let _ = fun (_ : mini_vhdl_design_file_t) > () 

12  8  
13  9 
class virtual mini_vhdl_to_lustre_map = 
14  10 
object (self) 
15  11 
inherit vhdl_2_mini_vhdl_map 
12  
16  13 
method virtual list : 'a . ('a > 'a) > 'a list > 'a list 
17 
method virtual mini_vhdl_component_instantiation_t : 

18 
mini_vhdl_component_instantiation_t > statement 

19 
method virtual mini_vhdl_concurrent_stmt_t : 

20 
mini_vhdl_concurrent_stmt_t > statement 

21 
method virtual mini_vhdl_component_t : 

22 
mini_vhdl_component_t > top_decl_desc 

23 
method virtual mini_vhdl_design_file_t : 

24 
mini_vhdl_design_file_t > program 

25  
26 
method mini_vhdl_declaration_t : mini_vhdl_declaration_t > mini_vhdl_declaration_t= 

27 
fun x > x 

14 
method virtual option : 'a . ('a > 'a) > 'a option > 'a option 

15 
method virtual string : string > string 

16  
17 
method vhdl_type_t : vhdl_type_t > vhdl_type_t= 

18 
fun x > 

19 
match x with 

20 
 Base a > let a = self#string a in Base a 

21 
 Range (a,b,c) > 

22 
let a = self#option self#string a in 

23 
let b = self#int b in let c = self#int c in Range (a, b, c) 

24 
 Bit_vector (a,b) > 

25 
let a = self#int a in let b = self#int b in Bit_vector (a, b) 

26 
 Array { indexes; const; definition } > 

27 
let indexes = self#list self#vhdl_name_t indexes in 

28 
let const = self#option self#vhdl_constraint_t const in 

29 
let definition = self#vhdl_subtype_indication_t definition in 

30 
Array { indexes; const; definition } 

31 
 Record a > 

32 
let a = self#list self#vhdl_element_declaration_t a in Record a 

33 
 Enumerated a > 

34 
let a = self#list self#vhdl_name_t a in Enumerated a 

35 
 Void > Void 

36  
37 
method vhdl_element_declaration_t : 

38 
vhdl_element_declaration_t > vhdl_element_declaration_t= 

39 
fun { names; definition } > 

40 
let names = self#list self#vhdl_name_t names in 

41 
let definition = self#vhdl_subtype_indication_t definition in 

42 
{ names; definition } 

43  
44 
method vhdl_subtype_indication_t : 

45 
vhdl_subtype_indication_t > vhdl_subtype_indication_t= 

46 
fun { name; functionName; const } > 

47 
let name = self#vhdl_name_t name in 

48 
let functionName = self#vhdl_name_t functionName in 

49 
let const = self#vhdl_constraint_t const in 

50 
{ name; functionName; const } 

51  
52 
method vhdl_discrete_range_t : 

53 
vhdl_discrete_range_t > vhdl_discrete_range_t= 

54 
fun x > 

55 
match x with 

56 
 SubDiscreteRange a > 

57 
let a = self#vhdl_subtype_indication_t a in SubDiscreteRange a 

58 
 NamedRange a > let a = self#vhdl_name_t a in NamedRange a 

59 
 DirectedRange { direction; from; _to } > 

60 
let direction = self#string direction in 

61 
let from = self#vhdl_expr_t from in 

62 
let _to = self#vhdl_expr_t _to in 

63 
DirectedRange { direction; from; _to } 

64  
65 
method vhdl_constraint_t : vhdl_constraint_t > vhdl_constraint_t= 

66 
fun x > 

67 
match x with 

68 
 RefConstraint { ref_name } > 

69 
let ref_name = self#vhdl_name_t ref_name in 

70 
RefConstraint { ref_name } 

71 
 RangeConstraint { range } > 

72 
let range = self#vhdl_discrete_range_t range in 

73 
RangeConstraint { range } 

74 
 IndexConstraint { ranges } > 

75 
let ranges = self#list self#vhdl_discrete_range_t ranges in 

76 
IndexConstraint { ranges } 

77 
 ArrayConstraint { ranges; sub } > 

78 
let ranges = self#list self#vhdl_discrete_range_t ranges in 

79 
let sub = self#vhdl_constraint_t sub in 

80 
ArrayConstraint { ranges; sub } 

81 
 RecordConstraint > RecordConstraint 

82 
 NoConstraint > NoConstraint 

83  
84 
method vhdl_definition_t : vhdl_definition_t > vhdl_definition_t= 

85 
fun x > 

86 
match x with 

87 
 Type { name; definition } > 

88 
let name = self#vhdl_name_t name in 

89 
let definition = self#vhdl_type_t definition in 

90 
Type { name; definition } 

91 
 Subtype { name; typ } > 

92 
let name = self#vhdl_name_t name in 

93 
let typ = self#vhdl_subtype_indication_t typ in 

94 
Subtype { name; typ } 

95  
96 
method vhdl_expr_t : vhdl_expr_t > vhdl_expr_t= 

97 
fun x > 

98 
match x with 

99 
 Call a > let a = self#vhdl_name_t a in Call a 

100 
 Cst { value; unit_name } > 

101 
let value = self#vhdl_cst_val_t value in 

102 
let unit_name = self#option self#vhdl_name_t unit_name in 

103 
Cst { value; unit_name } 

104 
 Op { id; args } > 

105 
let id = self#string id in 

106 
let args = self#list self#vhdl_expr_t args in Op { id; args } 

107 
 IsNull > IsNull 

108 
 Time { value; phy_unit } > 

109 
let value = self#int value in 

110 
let phy_unit = self#string phy_unit in Time { value; phy_unit } 

111 
 Sig { name; att } > 

112 
let name = self#vhdl_name_t name in 

113 
let att = self#option self#vhdl_signal_attributes_t att in 

114 
Sig { name; att } 

115 
 SuffixMod { expr; selection } > 

116 
let expr = self#vhdl_expr_t expr in 

117 
let selection = self#vhdl_suffix_selection_t selection in 

118 
SuffixMod { expr; selection } 

119 
 Aggregate { elems } > 

120 
let elems = self#list self#vhdl_element_assoc_t elems in 

121 
Aggregate { elems } 

122 
 QualifiedExpression { type_mark; aggregate; expression } > 

123 
let type_mark = self#vhdl_name_t type_mark in 

124 
let aggregate = self#list self#vhdl_element_assoc_t aggregate in 

125 
let expression = self#option self#vhdl_expr_t expression in 

126 
QualifiedExpression { type_mark; aggregate; expression } 

127 
 Others > Others 

128  
129 
method vhdl_name_t : vhdl_name_t > vhdl_name_t= 

130 
fun x > 

131 
match x with 

132 
 Simple a > let a = self#string a in Simple a 

133 
 Identifier a > let a = self#string a in Identifier a 

134 
 Selected a > let a = self#list self#vhdl_name_t a in Selected a 

135 
 Index { id; exprs } > 

136 
let id = self#vhdl_name_t id in 

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

138 
Index { id; exprs } 

139 
 Slice { id; range } > 

140 
let id = self#vhdl_name_t id in 

141 
let range = self#vhdl_discrete_range_t range in 

142 
Slice { id; range } 

143 
 Attribute { id; designator; expr } > 

144 
let id = self#vhdl_name_t id in 

145 
let designator = self#vhdl_name_t designator in 

146 
let expr = self#vhdl_expr_t expr in 

147 
Attribute { id; designator; expr } 

148 
 Function { id; assoc_list } > 

149 
let id = self#vhdl_name_t id in 

150 
let assoc_list = self#list self#vhdl_assoc_element_t assoc_list 

151 
in 

152 
Function { id; assoc_list } 

153 
 Open > Open 

154 
 NoName > NoName 

155  
156 
method vhdl_assoc_element_t : 

157 
vhdl_assoc_element_t > vhdl_assoc_element_t= 

158 
fun 

159 
{ formal_name; formal_arg; actual_name; actual_designator; 

160 
actual_expr } 

161 
> 

162 
let formal_name = self#option self#vhdl_name_t formal_name in 

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

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

165 
let actual_designator = 

166 
self#option self#vhdl_name_t actual_designator in 

167 
let actual_expr = self#option self#vhdl_expr_t actual_expr in 

168 
{ 

169 
formal_name; 

170 
formal_arg; 

171 
actual_name; 

172 
actual_designator; 

173 
actual_expr 

174 
} 

175  
176 
method vhdl_element_assoc_t : 

177 
vhdl_element_assoc_t > vhdl_element_assoc_t= 

178 
fun { choices; expr } > 

179 
let choices = self#list self#vhdl_expr_t choices in 

180 
let expr = self#vhdl_expr_t expr in { choices; expr } 

181  
182 
method vhdl_array_attributes_t : 

183 
vhdl_array_attributes_t > vhdl_array_attributes_t= 

184 
fun x > 

185 
match x with 

186 
 AAttInt { id; arg } > 

187 
let id = self#string id in 

188 
let arg = self#int arg in AAttInt { id; arg } 

189 
 AAttAscending > AAttAscending 

190  
191 
method vhdl_signal_attributes_t : 

192 
vhdl_signal_attributes_t > vhdl_signal_attributes_t= 

193 
fun x > match x with  SigAtt a > let a = self#string a in SigAtt a 

194  
195 
method vhdl_string_attributes_t : 

196 
vhdl_string_attributes_t > vhdl_string_attributes_t= 

197 
fun x > 

198 
match x with  StringAtt a > let a = self#string a in StringAtt a 

199  
200 
method vhdl_suffix_selection_t : 

201 
vhdl_suffix_selection_t > vhdl_suffix_selection_t= 

202 
fun x > 

203 
match x with 

204 
 Idx a > let a = self#int a in Idx a 

205 
 SuffixRange (a,b) > 

206 
let a = self#int a in let b = self#int b in SuffixRange (a, b) 

207  
208 
method mini_vhdl_sequential_stmt_t : 

209 
mini_vhdl_sequential_stmt_t > mini_vhdl_sequential_stmt_t= 

210 
fun x > 

211 
match x with 

212 
 VarAssign { label; lhs; rhs } > 

213 
let label = self#option self#vhdl_name_t label in 

214 
let lhs = self#vhdl_name_t lhs in 

215 
let rhs = self#vhdl_expr_t rhs in VarAssign { label; lhs; rhs } 

216 
 SigSeqAssign { label; lhs; rhs } > 

217 
let label = self#option self#vhdl_name_t label in 

218 
let lhs = self#vhdl_name_t lhs in 

219 
let rhs = self#list self#vhdl_waveform_element_t rhs in 

220 
SigSeqAssign { label; lhs; rhs } 

221 
 SigCondAssign { label; lhs; rhs; delay } > 

222 
let label = self#option self#vhdl_name_t label in 

223 
let lhs = self#vhdl_name_t lhs in 

224 
let rhs = self#list self#vhdl_signal_condition_t rhs in 

225 
let delay = self#option self#vhdl_expr_t delay in 

226 
SigCondAssign { label; lhs; rhs; delay } 

227 
 SigSelectAssign { label; lhs; sel; branches; delay } > 

228 
let label = self#option self#vhdl_name_t label in 

229 
let lhs = self#vhdl_name_t lhs in 

230 
let sel = self#vhdl_expr_t sel in 

231 
let branches = self#list self#vhdl_signal_selection_t branches 

232 
in 

233 
let delay = self#option self#vhdl_expr_t delay in 

234 
SigSelectAssign { label; lhs; sel; branches; delay } 

235 
 If { label; if_cases; default } > 

236 
let label = self#option self#vhdl_name_t label in 

237 
let if_cases = self#list self#mini_vhdl_if_case_t if_cases in 

238 
let default = self#list self#mini_vhdl_sequential_stmt_t default 

239 
in 

240 
If { label; if_cases; default } 

241 
 Case { label; guard; branches } > 

242 
let label = self#option self#vhdl_name_t label in 

243 
let guard = self#vhdl_expr_t guard in 

244 
let branches = self#list self#mini_vhdl_case_item_t branches in 

245 
Case { label; guard; branches } 

246 
 Exit { label; loop_label; condition } > 

247 
let label = self#option self#vhdl_name_t label in 

248 
let loop_label = self#option self#string loop_label in 

249 
let condition = self#option self#vhdl_expr_t condition in 

250 
Exit { label; loop_label; condition } 

251 
 Assert { label; cond; report; severity } > 

252 
let label = self#option self#vhdl_name_t label in 

253 
let cond = self#vhdl_expr_t cond in 

254 
let report = self#vhdl_expr_t report in 

255 
let severity = self#vhdl_expr_t severity in 

256 
Assert { label; cond; report; severity } 

257 
 ProcedureCall { label; name; assocs } > 

258 
let label = self#option self#vhdl_name_t label in 

259 
let name = self#vhdl_name_t name in 

260 
let assocs = self#list self#vhdl_assoc_element_t assocs in 

261 
ProcedureCall { label; name; assocs } 

262 
 Wait > Wait 

263 
 Null { label } > 

264 
let label = self#option self#vhdl_name_t label in Null { label } 

265 
 Return { label; expr } > 

266 
let label = self#option self#vhdl_name_t label in 

267 
let expr = self#option self#vhdl_expr_t expr in 

268 
Return { label; expr } 

269  
270 
method mini_vhdl_if_case_t : mini_vhdl_if_case_t > mini_vhdl_if_case_t= 

271 
fun { if_cond; if_block } > 

272 
let if_cond = self#vhdl_expr_t if_cond in 

273 
let if_block = self#list self#mini_vhdl_sequential_stmt_t if_block 

274 
in 

275 
{ if_cond; if_block } 

276  
277 
method mini_vhdl_case_item_t : 

278 
mini_vhdl_case_item_t > mini_vhdl_case_item_t= 

279 
fun { when_cond; when_stmt } > 

280 
let when_cond = self#list self#vhdl_expr_t when_cond in 

281 
let when_stmt = self#list self#mini_vhdl_sequential_stmt_t when_stmt 

282 
in 

283 
{ when_cond; when_stmt } 

284  
285 
method mini_vhdl_declaration_t : 

286 
mini_vhdl_declaration_t > mini_vhdl_declaration_t= 

287 
fun x > 

288 
match x with 

289 
 VarDecl { names; typ; init_val } > 

290 
let names = self#list self#vhdl_name_t names in 

291 
let typ = self#vhdl_subtype_indication_t typ in 

292 
let init_val = self#vhdl_expr_t init_val in 

293 
VarDecl { names; typ; init_val } 

294 
 CstDecl { names; typ; init_val } > 

295 
let names = self#list self#vhdl_name_t names in 

296 
let typ = self#vhdl_subtype_indication_t typ in 

297 
let init_val = self#vhdl_expr_t init_val in 

298 
CstDecl { names; typ; init_val } 

299 
 SigDecl { names; typ; init_val } > 

300 
let names = self#list self#vhdl_name_t names in 

301 
let typ = self#vhdl_subtype_indication_t typ in 

302 
let init_val = self#vhdl_expr_t init_val in 

303 
SigDecl { names; typ; init_val } 

304 
 ComponentDecl { name; generics; ports } > 

305 
let name = self#vhdl_name_t name in 

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

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

308 
ComponentDecl { name; generics; ports } 

309 
 Subprogram { spec; decl_part; stmts } > 

310 
let spec = self#vhdl_subprogram_spec_t spec in 

311 
let decl_part = self#list self#mini_vhdl_declaration_t decl_part 

312 
in 

313 
let stmts = self#list self#mini_vhdl_sequential_stmt_t stmts in 

314 
Subprogram { spec; decl_part; stmts } 

315  
316 
method mini_vhdl_declarative_item_t : 

317 
mini_vhdl_declarative_item_t > mini_vhdl_declarative_item_t= 

318 
fun { use_clause; declaration; definition } > 

319 
let use_clause = self#option self#vhdl_load_t use_clause in 

320 
let declaration = 

321 
self#option self#mini_vhdl_declaration_t declaration in 

322 
let definition = self#option self#vhdl_definition_t definition in 

323 
{ use_clause; declaration; definition } 

28  324  
29  325 
method mini_vhdl_process_t : mini_vhdl_process_t > mini_vhdl_process_t= 
30 
fun x > x 

326 
fun { id; declarations; active_sigs; body; postponed; label } > 

327 
let id = self#vhdl_name_t id in 

328 
let declarations = 

329 
self#list self#mini_vhdl_declarative_item_t declarations in 

330 
let active_sigs = self#list self#vhdl_name_t active_sigs in 

331 
let body = self#list self#mini_vhdl_sequential_stmt_t body in 

332 
let postponed = self#bool postponed in 

333 
let label = self#option self#vhdl_name_t label in 

334 
{ id; declarations; active_sigs; body; postponed; label } 

31  335  
32  336 
method mini_vhdl_component_instantiation_t : 
33  337 
mini_vhdl_component_instantiation_t > statement= 
Also available in: Unified diff