1

open Vhdl_ast

2


3

let _ = fun (_ : vhdl_cst_val_t) > ()

4

let _ = fun (_ : vhdl_type_t) > ()

5

let _ = fun (_ : vhdl_element_declaration_t) > ()

6

let _ = fun (_ : vhdl_subtype_indication_t) > ()

7

let _ = fun (_ : vhdl_discrete_range_t) > ()

8

let _ = fun (_ : vhdl_constraint_t) > ()

9

let _ = fun (_ : vhdl_definition_t) > ()

10

let _ = fun (_ : vhdl_expr_t) > ()

11

let _ = fun (_ : vhdl_name_t) > ()

12

let _ = fun (_ : vhdl_assoc_element_t) > ()

13

let _ = fun (_ : vhdl_element_assoc_t) > ()

14

let _ = fun (_ : vhdl_array_attributes_t) > ()

15

let _ = fun (_ : vhdl_signal_attributes_t) > ()

16

let _ = fun (_ : vhdl_string_attributes_t) > ()

17

let _ = fun (_ : vhdl_suffix_selection_t) > ()

18

(*let _ = fun (_ : 'basetype vhdl_type_attributes_t) > () *)

19

let _ = fun (_ : vhdl_parameter_t) > ()

20

let _ = fun (_ : vhdl_subprogram_spec_t) > ()

21

let _ = fun (_ : vhdl_waveform_element_t) > ()

22

let _ = fun (_ : vhdl_sequential_stmt_t) > ()

23

let _ = fun (_ : vhdl_if_case_t) > ()

24

let _ = fun (_ : vhdl_case_item_t) > ()

25

let _ = fun (_ : vhdl_port_mode_t) > ()

26

let _ = fun (_ : vhdl_port_t) > ()

27

let _ = fun (_ : vhdl_declaration_t) > ()

28

let _ = fun (_ : vhdl_load_t) > ()

29

let _ = fun (_ : vhdl_declarative_item_t) > ()

30

let _ = fun (_ : vhdl_signal_condition_t) > ()

31

let _ = fun (_ : vhdl_signal_selection_t) > ()

32

let _ = fun (_ : vhdl_conditional_signal_t) > ()

33

let _ = fun (_ : vhdl_process_t) > ()

34

let _ = fun (_ : vhdl_selected_signal_t) > ()

35

let _ = fun (_ : vhdl_component_instantiation_t) > ()

36

let _ = fun (_ : vhdl_concurrent_stmt_t) > ()

37

let _ = fun (_ : vhdl_entity_t) > ()

38

let _ = fun (_ : vhdl_package_t) > ()

39

let _ = fun (_ : vhdl_architecture_t) > ()

40

let _ = fun (_ : vhdl_configuration_t) > ()

41

let _ = fun (_ : vhdl_library_unit_t) > ()

42

let _ = fun (_ : vhdl_design_unit_t) > ()

43

let _ = fun (_ : vhdl_design_file_t) > ()

44

let _ = fun (_ : vhdl_file_t) > ()

45


46

class virtual ['acc] fold_sensitivity =

47

object (self)

48


49

method list : 'a. ('a > 'acc > 'acc) > 'a list > 'acc > 'acc=

50

fun f > fun l > fun acc > List.fold_right f l acc

51


52

method option : 'a. ('a > 'acc > 'acc) > 'a option > 'acc > 'acc=

53

fun f > fun e > fun acc > match e with None > acc  Some e > f e acc

54


55

method string : string > 'acc > 'acc=

56

fun e > fun acc > acc

57


58

method int : int > 'acc > 'acc=

59

fun e > fun acc > acc

60


61

method bool : bool > 'acc > 'acc=

62

fun e > fun acc > acc

63


64

method vhdl_cst_val_t : vhdl_cst_val_t > 'acc > 'acc=

65

fun x >

66

fun acc > acc

67


68

method vhdl_type_t : vhdl_type_t > 'acc > 'acc=

69

fun x >

70

fun acc > acc

71


72

method vhdl_element_declaration_t :

73

vhdl_element_declaration_t > 'acc > 'acc=

74

fun { ed_names; definition } >

75

fun acc > acc

76


77

method vhdl_subtype_indication_t :

78

vhdl_subtype_indication_t > 'acc > 'acc=

79

fun { si_name; functionName; const } >

80

fun acc >

81

let acc = self#vhdl_name_t si_name acc in

82

let acc = self#vhdl_name_t functionName acc in

83

let acc = self#vhdl_constraint_t const acc in acc

84


85

method vhdl_discrete_range_t : vhdl_discrete_range_t > 'acc > 'acc=

86

fun x >

87

fun acc >

88

match x with

89

 SubDiscreteRange a > self#vhdl_subtype_indication_t a acc

90

 NamedRange a > self#vhdl_name_t a acc

91

 DirectedRange { direction; from; _to } >

92

let acc = self#vhdl_expr_t from acc in

93

let acc = self#vhdl_expr_t _to acc in acc

94


95

method vhdl_constraint_t : vhdl_constraint_t > 'acc > 'acc=

96

fun x >

97

fun acc >

98

match x with

99

 RefConstraint { ref_name } > self#vhdl_name_t ref_name acc

100

 RangeConstraint { range } > self#vhdl_discrete_range_t range acc

101

 IndexConstraint { ranges } >

102

self#list self#vhdl_discrete_range_t ranges acc

103

 ArrayConstraint { ranges; sub } >

104

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

105

let acc = self#vhdl_constraint_t sub acc in acc

106

 RecordConstraint > acc

107

 NoConstraint > acc

108


109

method vhdl_definition_t : vhdl_definition_t > 'acc > 'acc=

110

fun x >

111

fun acc >

112

match x with

113

 Type { name; definition } >

114

let acc = self#vhdl_name_t name acc in

115

let acc = self#vhdl_type_t definition acc in acc

116

 Subtype { name; typ } >

117

let acc = self#vhdl_name_t name acc in

118

let acc = self#vhdl_subtype_indication_t typ acc in acc

119


120

method vhdl_expr_t : vhdl_expr_t > 'acc > 'acc=

121

fun x >

122

fun acc >

123

match x with

124

 Call a > a::acc

125

 Cst { value; unit_name } >

126

let acc = self#vhdl_cst_val_t value acc in

127

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

128

 Op { id; args } >

129

let acc = self#string id acc in

130

let acc = self#list self#vhdl_expr_t args acc in acc

131

 IsNull > acc

132

 Time { value; phy_unit } >

133

let acc = self#int value acc in

134

let acc = self#string phy_unit acc in acc

135

 Sig { name; att } >

136

let acc = name::acc in

137

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

138

acc

139

 SuffixMod { expr; selection } >

140

let acc = self#vhdl_expr_t expr acc in

141

let acc = self#vhdl_suffix_selection_t selection acc in acc

142

 Aggregate { elems } >

143

self#list self#vhdl_element_assoc_t elems acc

144

 QualifiedExpression { type_mark; aggregate; expression } >

145

let acc = type_mark::acc in

146

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

147

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

148

 Others > acc

149


150

method vhdl_name_t : vhdl_name_t > 'acc > 'acc=

151

fun x >

152

fun acc >

153

match x with

154

 Simple a > x::acc

155

 Identifier a > x::acc

156

 Selected a > a@acc

157

 Index { id; exprs } > x::acc

158

 Slice { id; range } > x::acc

159

 Attribute { id; designator; expr } >

160

let acc = x::acc in

161

let acc = self#vhdl_expr_t expr acc in acc

162

 Function { id; assoc_list } >

163

let acc = x::acc in

164

let acc = self#list self#vhdl_assoc_element_t assoc_list acc

165

in

166

acc

167

 Open > acc

168

 NoName > acc

169


170

method vhdl_assoc_element_t : vhdl_assoc_element_t > 'acc > 'acc=

171

fun

172

{ formal_name; formal_arg; actual_name; actual_designator;

173

actual_expr }

174

>

175

fun acc >

176

let acc = match formal_name with None > acc  Some a > a::acc in

177

let acc = match formal_arg with None > acc  Some a > a::acc in

178

let acc = match actual_name with None > acc  Some a > a::acc in

179

let acc = match actual_designator with None > acc  Some a > a::acc in

180

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

181


182

method vhdl_element_assoc_t : vhdl_element_assoc_t > 'acc > 'acc=

183

fun { choices; expr } >

184

fun acc >

185

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

186

let acc = self#vhdl_expr_t expr acc in acc

187


188

method vhdl_array_attributes_t : vhdl_array_attributes_t > 'acc > 'acc=

189

fun x >

190

fun acc >

191

match x with

192

 AAttInt { id; arg } >

193

let acc = self#string id acc in

194

let acc = self#int arg acc in acc

195

 AAttAscending > acc

196


197

method vhdl_signal_attributes_t :

198

vhdl_signal_attributes_t > 'acc > 'acc=

199

fun x > fun acc > match x with  SigAtt a > self#string a acc

200


201

method vhdl_string_attributes_t :

202

vhdl_string_attributes_t > 'acc > 'acc=

203

fun x > fun acc > match x with  StringAtt a > self#string a acc

204


205

method vhdl_suffix_selection_t : vhdl_suffix_selection_t > 'acc > 'acc=

206

fun x >

207

fun acc >

208

match x with

209

 Idx a > self#int a acc

210

 SuffixRange (a,b) >

211

let acc = self#int a acc in let acc = self#int b acc in acc

212


213

(* method vhdl_type_attributes_t :

214

'a . ('a > 'acc > 'acc) > 'a vhdl_type_attributes_t > 'acc > 'acc=

215

fun _basetype >

216

fun x >

217

fun acc >

218

match x with

219

 TAttNoArg { id } > self#string id acc

220

 TAttIntArg { id; arg } >

221

let acc = self#string id acc in

222

let acc = self#int arg acc in acc

223

 TAttValArg { id; arg } >

224

let acc = self#string id acc in

225

let acc = _basetype arg acc in acc

226

 TAttStringArg { id; arg } >

227

let acc = self#string id acc in

228

let acc = self#string arg acc in acc *)

229


230

method vhdl_parameter_t : vhdl_parameter_t > 'acc > 'acc=

231

fun { parameter_names; parameter_mode; parameter_typ; init_val } >

232

fun acc >

233

let acc = self#list self#vhdl_name_t parameter_names acc in

234

let acc = self#list self#string parameter_mode acc in

235

let acc = self#vhdl_subtype_indication_t parameter_typ acc in

236

let acc = self#option self#vhdl_cst_val_t init_val acc in acc

237


238

method vhdl_subprogram_spec_t : vhdl_subprogram_spec_t > 'acc > 'acc=

239

fun { ss_name; subprogram_type; typeMark; parameters; isPure } >

240

fun acc >

241

let acc = self#string ss_name acc in

242

let acc = self#string subprogram_type acc in

243

let acc = self#vhdl_name_t typeMark acc in

244

let acc = self#list self#vhdl_parameter_t parameters acc in

245

let acc = self#bool isPure acc in acc

246


247

method vhdl_waveform_element_t : vhdl_waveform_element_t > 'acc > 'acc=

248

fun { value; we_delay } >

249

fun acc >

250

let acc = self#option self#vhdl_expr_t value acc in

251

let acc = self#option self#vhdl_expr_t we_delay acc in acc

252


253

method vhdl_sequential_stmt_t : vhdl_sequential_stmt_t > 'acc > 'acc=

254

fun x >

255

fun acc >

256

match x with

257

 VarAssign { label; seqs_lhs; rhs } >

258

let acc = self#vhdl_expr_t rhs acc in acc

259

 SigSeqAssign { label; seqs_lhs; rhs } >

260

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

261

acc

262

 If { label; if_cases; default } >

263

let acc = self#list self#vhdl_if_case_t if_cases acc in

264

let acc = self#list self#vhdl_sequential_stmt_t default acc in

265

acc

266

 Case { label; guard; branches } >

267

let acc = self#vhdl_expr_t guard acc in

268

let acc = self#list self#vhdl_case_item_t branches acc in acc

269

 Exit { label; loop_label; condition } >

270

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

271

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

272

 Assert { label; cond; report; severity } >

273

let acc = self#vhdl_expr_t cond acc in

274

let acc = self#vhdl_expr_t report acc in

275

let acc = self#vhdl_expr_t severity acc in acc

276

 ProcedureCall { label; name; assocs } >

277

let acc = self#vhdl_name_t name acc in

278

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

279

acc

280

 Wait > acc

281

 Null { label } > acc

282

 Return { label; expr } >

283

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

284


285

method vhdl_if_case_t : vhdl_if_case_t > 'acc > 'acc=

286

fun { if_cond; if_block } >

287

fun acc >

288

let acc = self#vhdl_expr_t if_cond acc in

289

let acc = self#list self#vhdl_sequential_stmt_t if_block acc in

290

acc

291


292

method vhdl_case_item_t : vhdl_case_item_t > 'acc > 'acc=

293

fun { when_cond; when_stmt } >

294

fun acc >

295

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

296

let acc = self#list self#vhdl_sequential_stmt_t when_stmt acc in

297

acc

298


299

method vhdl_port_mode_t : vhdl_port_mode_t > 'acc > 'acc=

300

fun _ > fun acc > acc

301


302

method vhdl_port_t : vhdl_port_t > 'acc > 'acc=

303

fun { port_names; port_mode; port_typ; port_expr } >

304

fun acc >

305

let acc = self#list self#vhdl_name_t port_names acc in

306

let acc = self#vhdl_port_mode_t port_mode acc in

307

let acc = self#vhdl_subtype_indication_t port_typ acc in

308

let acc = self#vhdl_expr_t port_expr acc in acc

309


310

method vhdl_declaration_t : vhdl_declaration_t > 'acc > 'acc=

311

fun x >

312

fun acc > acc

313


314

method vhdl_load_t : vhdl_load_t > 'acc > 'acc=

315

fun x >

316

fun acc > acc

317


318

method vhdl_declarative_item_t : vhdl_declarative_item_t > 'acc > 'acc=

319

fun { use_clause; di_declaration; di_definition } >

320

fun acc > acc

321


322

method vhdl_signal_condition_t : vhdl_signal_condition_t > 'acc > 'acc=

323

fun { sc_expr; cond } >

324

fun acc >

325

let acc = self#list self#vhdl_waveform_element_t sc_expr acc in

326

let acc = self#option self#vhdl_expr_t cond acc in acc

327


328

method vhdl_signal_selection_t : vhdl_signal_selection_t > 'acc > 'acc=

329

fun { ss_expr; when_sel } >

330

fun acc >

331

let acc = self#list self#vhdl_waveform_element_t ss_expr acc in

332

let acc = self#list self#vhdl_expr_t when_sel acc in acc

333


334

method vhdl_conditional_signal_t :

335

vhdl_conditional_signal_t > 'acc > 'acc=

336

fun { cs_postponed; cs_label; cs_lhs; rhs; cs_delay } >

337

fun acc >

338

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

339

let acc = self#vhdl_expr_t cs_delay acc in acc

340


341

method vhdl_process_t : vhdl_process_t > 'acc > 'acc=

342

fun { id; p_declarations; active_sigs; p_body } >

343

fun acc >

344

let acc = self#list self#vhdl_sequential_stmt_t p_body acc in acc

345


346

method vhdl_selected_signal_t : vhdl_selected_signal_t > 'acc > 'acc=

347

fun { ss_postponed; ss_label; ss_lhs; sel; branches; ss_delay } >

348

fun acc >

349

let acc = self#vhdl_expr_t sel acc in

350

let acc = self#list self#vhdl_signal_selection_t branches acc in

351

let acc = self#option self#vhdl_expr_t ss_delay acc in acc

352


353

method vhdl_component_instantiation_t :

354

vhdl_component_instantiation_t > 'acc > 'acc=

355

fun

356

{ ci_name; inst_unit; inst_unit_type; archi_name; generic_map; port_map

357

}

358

>

359

fun acc > acc

360


361

method vhdl_concurrent_stmt_t : vhdl_concurrent_stmt_t > 'acc > 'acc=

362

fun x >

363

fun acc >

364

match x with

365

 SigAssign a > self#vhdl_conditional_signal_t a acc

366

 Process a > self#vhdl_process_t a acc

367

 SelectedSig a > self#vhdl_selected_signal_t a acc

368

 ComponentInst a > self#vhdl_component_instantiation_t a acc

369


370

method vhdl_entity_t : vhdl_entity_t > 'acc > 'acc=

371

fun { e_name; generics; ports; e_declaration; stmts } >

372

fun acc > acc

373


374

method vhdl_package_t : vhdl_package_t > 'acc > 'acc=

375

fun { p_name; shared_defs; shared_decls; shared_uses } >

376

fun acc > acc

377


378

method vhdl_architecture_t : vhdl_architecture_t > 'acc > 'acc=

379

fun { a_name; entity; a_declarations; a_body } >

380

fun acc > acc

381


382

method vhdl_configuration_t : vhdl_configuration_t > 'acc > 'acc=

383

fun x > fun acc > acc

384


385

method vhdl_library_unit_t : vhdl_library_unit_t > 'acc > 'acc=

386

fun x >

387

fun acc > acc

388


389

method vhdl_design_unit_t : vhdl_design_unit_t > 'acc > 'acc=

390

fun { contexts; library } >

391

fun acc > acc

392


393

method vhdl_design_file_t : vhdl_design_file_t > 'acc > 'acc=

394

fun { design_units } >

395

fun acc > acc

396


397

method vhdl_file_t : vhdl_file_t > 'acc > 'acc=

398

fun { design_file } >

399

fun acc > acc

400

end
