1

open Vhdl_ast

2


3

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

4

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

5

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

6

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

7

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

8

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

9

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

10

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

11

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

12

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

13

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

14

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

15

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

16

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

17

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

18

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

19

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

20

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

21

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

22

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

23

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

24

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

25

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

26

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

27

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

28

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

29

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

30

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

31

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

32

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

33

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

34

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

35

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

36

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

37

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

38

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

39

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

40

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

41


42

class virtual vhdl_map =

43

object (self)

44

method virtual string : string > string

45

method virtual list : 'a . ('a > 'a) > 'a list > 'a list

46

method virtual unit : unit > unit

47

method virtual bool : bool > bool

48

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

49

method virtual int : int > int

50

method virtual vhdl_name_t : vhdl_name_t > vhdl_name_t

51

method virtual vhdl_definition_t : vhdl_definition_t > vhdl_definition_t

52

method virtual vhdl_port_t : vhdl_port_t > vhdl_port_t

53

method virtual vhdl_expr_t : vhdl_expr_t > vhdl_expr_t

54

method virtual vhdl_port_mode_t : vhdl_port_mode_t > vhdl_port_mode_t

55

method virtual vhdl_subtype_indication_t : vhdl_subtype_indication_t > vhdl_subtype_indication_t

56

method virtual vhdl_conditional_signal_t : vhdl_conditional_signal_t > vhdl_conditional_signal_t

57

method virtual vhdl_process_t : vhdl_process_t > vhdl_process_t

58

method virtual vhdl_selected_signal_t : vhdl_selected_signal_t > vhdl_selected_signal_t

59

method virtual vhdl_signal_selection_t : vhdl_signal_selection_t > vhdl_signal_selection_t

60

method virtual vhdl_suffix_selection_t : vhdl_suffix_selection_t > vhdl_suffix_selection_t

61

method virtual vhdl_declaration_t : vhdl_declaration_t > vhdl_declaration_t

62

method virtual vhdl_sequential_stmt_t : vhdl_sequential_stmt_t > vhdl_sequential_stmt_t

63

method virtual vhdl_signal_condition_t : vhdl_signal_condition_t > vhdl_signal_condition_t

64

method virtual vhdl_cst_val_t : vhdl_cst_val_t > vhdl_cst_val_t

65

method virtual vhdl_subprogram_spec_t : vhdl_subprogram_spec_t > vhdl_subprogram_spec_t

66

method virtual vhdl_discrete_range_t : vhdl_discrete_range_t > vhdl_discrete_range_t

67

method virtual vhdl_parameter_t : vhdl_parameter_t > vhdl_parameter_t

68

method virtual vhdl_concurrent_stmt_t : vhdl_concurrent_stmt_t > vhdl_concurrent_stmt_t

69

method virtual vhdl_declaration_t : vhdl_declaration_t > vhdl_declaration_t

70

method virtual vhdl_architecture_t : vhdl_architecture_t > vhdl_architecture_t

71

method virtual vhdl_configuration_t : vhdl_configuration_t > vhdl_configuration_t

72

method virtual vhdl_entity_t : vhdl_entity_t > vhdl_entity_t

73

method virtual vhdl_package_t : vhdl_package_t > vhdl_package_t

74

method virtual vhdl_library_unit_t : vhdl_library_unit_t > vhdl_library_unit_t

75

method virtual vhdl_load_t : vhdl_load_t > vhdl_load_t

76

method virtual vhdl_design_unit_t : vhdl_design_unit_t > vhdl_design_unit_t

77

method virtual vhdl_design_file_t : vhdl_design_file_t > vhdl_design_file_t

78


79

method vhdl_cst_val_t : vhdl_cst_val_t > vhdl_cst_val_t=

80

fun x >

81

match x with

82

 CstInt a > let a = self#int a in CstInt a

83

 CstStdLogic a > let a = self#string a in CstStdLogic a

84

 CstLiteral a > let a = self#string a in CstLiteral a

85


86

method vhdl_type_t : vhdl_type_t > vhdl_type_t=

87

fun x >

88

match x with

89

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

90

 Range (a,b,c) >

91

let a = self#option self#string a in

92

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

93

 Bit_vector (a,b) >

94

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

95

 Array (a,b,c) >

96

let a = self#int a in

97

let b = self#int b in

98

let c = self#vhdl_type_t c in Array (a, b, c)

99

 Enumerated a > let a = self#list self#string a in Enumerated a

100

 Void > Void

101

method vhdl_subtype_indication_t :

102

vhdl_subtype_indication_t > vhdl_subtype_indication_t=

103

fun { name; functionName; const } >

104

let name = self#vhdl_name_t name in

105

let functionName = self#vhdl_name_t functionName in

106

let const = self#vhdl_constraint_t const in

107

{ name; functionName; const }

108

method vhdl_discrete_range_t :

109

vhdl_discrete_range_t > vhdl_discrete_range_t=

110

fun x >

111

match x with

112

 SubDiscreteRange a >

113

let a = self#vhdl_subtype_indication_t a in SubDiscreteRange a

114

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

115

 DirectedRange { direction; from; _to } >

116

let direction = self#string direction in

117

let from = self#vhdl_expr_t from in

118

let _to = self#vhdl_expr_t _to in

119

DirectedRange { direction; from; _to }

120


121

method vhdl_constraint_t : vhdl_constraint_t > vhdl_constraint_t=

122

fun x >

123

match x with

124

 RefConstraint { ref_name } >

125

let ref_name = self#vhdl_name_t ref_name in

126

RefConstraint { ref_name }

127

 RangeConstraint { range } >

128

let range = self#vhdl_discrete_range_t range in

129

RangeConstraint { range }

130

 IndexConstraint { ranges } >

131

let ranges = self#list self#vhdl_discrete_range_t ranges in

132

IndexConstraint { ranges }

133

 ArrayConstraint { ranges; sub } >

134

let ranges = self#list self#vhdl_discrete_range_t ranges in

135

let sub = self#vhdl_constraint_t sub in

136

ArrayConstraint { ranges; sub }

137

 RecordConstraint > RecordConstraint

138

 NoConstraint > NoConstraint

139


140

method vhdl_definition_t : vhdl_definition_t > vhdl_definition_t=

141

fun x >

142

match x with

143

 Type { name; definition } >

144

let name = self#vhdl_name_t name in

145

let definition = self#vhdl_type_t definition in

146

Type { name; definition }

147

 Subtype { name; typ } >

148

let name = self#vhdl_name_t name in

149

let typ = self#vhdl_subtype_indication_t typ in

150

Subtype { name; typ }

151

method vhdl_expr_t : vhdl_expr_t > vhdl_expr_t=

152

fun x >

153

match x with

154

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

155

 Cst a > let a = self#vhdl_cst_val_t a in Cst a

156

 Op { id; args } >

157

let id = self#string id in

158

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

159

 IsNull > IsNull

160

 Time { value; phy_unit } >

161

let value = self#int value in

162

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

163

 Sig { name; att } >

164

let name = self#vhdl_name_t name in

165

let att = self#option self#vhdl_signal_attributes_t att in

166

Sig { name; att }

167

 SuffixMod { expr; selection } >

168

let expr = self#vhdl_expr_t expr in

169

let selection = self#vhdl_suffix_selection_t selection in

170

SuffixMod { expr; selection }

171

 Aggregate { elems } >

172

let elems = self#list self#vhdl_element_assoc_t elems in

173

Aggregate { elems }

174

 Others > Others

175

method vhdl_name_t : vhdl_name_t > vhdl_name_t=

176

fun x >

177

match x with

178

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

179

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

180

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

181

 Index { id; exprs } >

182

let id = self#vhdl_name_t id in

183

let exprs = self#list self#vhdl_expr_t exprs in

184

Index { id; exprs }

185

 Slice { id; range } >

186

let id = self#vhdl_name_t id in

187

let range = self#vhdl_discrete_range_t range in

188

Slice { id; range }

189

 Attribute { id; designator; expr } >

190

let id = self#vhdl_name_t id in

191

let designator = self#vhdl_name_t designator in

192

let expr = self#vhdl_expr_t expr in

193

Attribute { id; designator; expr }

194

 Function { id; assoc_list } >

195

let id = self#vhdl_name_t id in

196

let assoc_list = self#list self#vhdl_assoc_element_t assoc_list

197

in

198

Function { id; assoc_list }

199

 NoName > NoName

200

method vhdl_assoc_element_t :

201

vhdl_assoc_element_t > vhdl_assoc_element_t=

202

fun

203

{ formal_name; formal_arg; actual_name; actual_designator;

204

actual_expr }

205

>

206

let formal_name = self#option self#vhdl_name_t formal_name in

207

let formal_arg = self#option self#vhdl_name_t formal_arg in

208

let actual_name = self#option self#vhdl_name_t actual_name in

209

let actual_designator =

210

self#option self#vhdl_name_t actual_designator in

211

let actual_expr = self#option self#vhdl_expr_t actual_expr in

212

{

213

formal_name;

214

formal_arg;

215

actual_name;

216

actual_designator;

217

actual_expr

218

}

219

method vhdl_element_assoc_t :

220

vhdl_element_assoc_t > vhdl_element_assoc_t=

221

fun { choices; expr } >

222

let choices = self#list self#vhdl_expr_t choices in

223

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

224

method vhdl_array_attributes_t :

225

vhdl_array_attributes_t > vhdl_array_attributes_t=

226

fun x >

227

match x with

228

 AAttInt { id; arg } >

229

let id = self#string id in

230

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

231

 AAttAscending > AAttAscending

232

method vhdl_signal_attributes_t :

233

vhdl_signal_attributes_t > vhdl_signal_attributes_t=

234

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

235

method vhdl_string_attributes_t :

236

vhdl_string_attributes_t > vhdl_string_attributes_t=

237

fun x >

238

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

239

method vhdl_suffix_selection_t : vhdl_suffix_selection_t > vhdl_suffix_selection_t=

240

fun x >

241

match x with

242

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

243

 SuffixRange (a,b) >

244

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

245


246

method vhdl_type_attributes_t :

247

'a .

248

('a > 'a) > 'a vhdl_type_attributes_t > 'a vhdl_type_attributes_t=

249

fun _basetype >

250

fun x >

251

match x with

252

 TAttNoArg { id } > let id = self#string id in TAttNoArg { id }

253

 TAttIntArg { id; arg } >

254

let id = self#string id in

255

let arg = self#int arg in TAttIntArg { id; arg }

256

 TAttValArg { id; arg } >

257

let id = self#string id in

258

let arg = _basetype arg in TAttValArg { id; arg }

259

 TAttStringArg { id; arg } >

260

let id = self#string id in

261

let arg = self#string arg in TAttStringArg { id; arg }

262


263

method vhdl_parameter_t : vhdl_parameter_t > vhdl_parameter_t=

264

fun { names; mode; typ; init_val } >

265

let names = self#list self#vhdl_name_t names in

266

let mode = self#list self#string mode in

267

let typ = self#vhdl_subtype_indication_t typ in

268

let init_val = self#option self#vhdl_cst_val_t init_val in

269

{ names; mode; typ; init_val }

270


271

method vhdl_subprogram_spec_t :

272

vhdl_subprogram_spec_t > vhdl_subprogram_spec_t=

273

fun { name; typeMark; parameters; isPure } >

274

let name = self#string name in

275

let typeMark = self#vhdl_name_t typeMark in

276

let parameters = self#list self#vhdl_parameter_t parameters in

277

let isPure = self#bool isPure in

278

{ name; typeMark; parameters; isPure }

279


280

method vhdl_sequential_stmt_t :

281

vhdl_sequential_stmt_t > vhdl_sequential_stmt_t=

282

fun x >

283

match x with

284

 VarAssign { label; lhs; rhs } >

285

let label = self#vhdl_name_t label in

286

let lhs = self#vhdl_name_t lhs in

287

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

288

 SigSeqAssign { label; lhs; rhs } >

289

let label = self#vhdl_name_t label in

290

let lhs = self#vhdl_name_t lhs in

291

let rhs = self#list self#vhdl_expr_t rhs in

292

SigSeqAssign { label; lhs; rhs }

293

 If { label; if_cases; default } >

294

let label = self#vhdl_name_t label in

295

let if_cases = self#list self#vhdl_if_case_t if_cases in

296

let default = self#list self#vhdl_sequential_stmt_t default in

297

If { label; if_cases; default }

298

 Case { label; guard; branches } >

299

let label = self#vhdl_name_t label in

300

let guard = self#vhdl_expr_t guard in

301

let branches = self#list self#vhdl_case_item_t branches in

302

Case { label; guard; branches }

303

 Exit { label; loop_label; condition } >

304

let label = self#vhdl_name_t label in

305

let loop_label = self#option self#string loop_label in

306

let condition = self#option self#vhdl_expr_t condition in

307

Exit { label; loop_label; condition }

308

 Assert { label; cond; report; severity } >

309

let label = self#vhdl_name_t label in

310

let cond = self#vhdl_expr_t cond in

311

let report = self#vhdl_expr_t report in

312

let severity = self#vhdl_expr_t severity in

313

Assert { label; cond; report; severity }

314

 Wait > Wait

315

 Null { label } >

316

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

317

 Return { label } >

318

let label = self#vhdl_name_t label in Return { label }

319

method vhdl_if_case_t : vhdl_if_case_t > vhdl_if_case_t=

320

fun { if_cond; if_block } >

321

let if_cond = self#vhdl_expr_t if_cond in

322

let if_block = self#list self#vhdl_sequential_stmt_t if_block in

323

{ if_cond; if_block }

324

method vhdl_case_item_t : vhdl_case_item_t > vhdl_case_item_t=

325

fun { when_cond; when_stmt } >

326

let when_cond = self#list self#vhdl_expr_t when_cond in

327

let when_stmt = self#list self#vhdl_sequential_stmt_t when_stmt in

328

{ when_cond; when_stmt }

329


330

method vhdl_declaration_t : vhdl_declaration_t > vhdl_declaration_t=

331

fun x >

332

match x with

333

 VarDecl { names; typ; init_val } >

334

let names = self#list self#vhdl_name_t names in

335

let typ = self#vhdl_subtype_indication_t typ in

336

let init_val = self#option self#vhdl_cst_val_t init_val in

337

VarDecl { names; typ; init_val }

338

 CstDecl { names; typ; init_val } >

339

let names = self#list self#vhdl_name_t names in

340

let typ = self#vhdl_subtype_indication_t typ in

341

let init_val = self#vhdl_cst_val_t init_val in

342

CstDecl { names; typ; init_val }

343

 SigDecl { names; typ; init_val } >

344

let names = self#list self#vhdl_name_t names in

345

let typ = self#vhdl_subtype_indication_t typ in

346

let init_val = self#option self#vhdl_cst_val_t init_val in

347

SigDecl { names; typ; init_val }

348

 Subprogram { name; kind; spec; decl_part; stmts } >

349

let name = self#vhdl_name_t name in

350

let kind = self#string kind in

351

let spec = self#vhdl_subprogram_spec_t spec in

352

let decl_part = self#list self#vhdl_declaration_t decl_part in

353

let stmts = self#list self#vhdl_sequential_stmt_t stmts in

354

Subprogram { name; kind; spec; decl_part; stmts }

355


356

method vhdl_signal_condition_t : vhdl_signal_condition_t > vhdl_signal_condition_t=

357

fun { expr; cond } >

358

let expr = self#list self#vhdl_expr_t expr in

359

let cond = self#vhdl_expr_t cond in { expr; cond }

360


361

method vhdl_signal_selection_t : vhdl_signal_selection_t > vhdl_signal_selection_t=

362

fun { expr; when_sel } >

363

let expr = self#vhdl_expr_t expr in

364

let when_sel = self#list self#vhdl_expr_t when_sel in

365

{ expr; when_sel }

366


367

method vhdl_conditional_signal_t :

368

vhdl_conditional_signal_t > vhdl_conditional_signal_t=

369

fun { postponed; label; lhs; rhs; cond; delay } >

370

let postponed = self#bool postponed in

371

let label = self#vhdl_name_t label in

372

let lhs = self#vhdl_name_t lhs in

373

let rhs = self#list self#vhdl_signal_condition_t rhs in

374

let cond = self#vhdl_expr_t cond in

375

let delay = self#vhdl_expr_t delay in

376

{ postponed; label; lhs; rhs; cond; delay }

377


378


379

method vhdl_process_t : vhdl_process_t > vhdl_process_t=

380

fun { id; declarations; active_sigs; body } >

381

let id = self#vhdl_name_t id in

382

let declarations =

383

self#option (self#list self#vhdl_declaration_t) declarations in

384

let active_sigs = self#list self#vhdl_name_t active_sigs in

385

let body = self#list self#vhdl_sequential_stmt_t body in

386

{ id; declarations; active_sigs; body }

387


388

method vhdl_selected_signal_t : vhdl_selected_signal_t > vhdl_selected_signal_t=

389

fun { postponed; label; lhs; sel; branches; delay } >

390

let postponed = self#bool postponed in

391

let label = self#vhdl_name_t label in

392

let lhs = self#vhdl_name_t lhs in

393

let sel = self#vhdl_expr_t sel in

394

let branches = self#list self#vhdl_signal_selection_t branches in

395

let delay = self#option self#vhdl_expr_t delay in

396

{ postponed; label; lhs; sel; branches; delay }

397


398

method vhdl_port_mode_t : vhdl_port_mode_t > vhdl_port_mode_t=

399

fun x > x

400


401

method vhdl_concurrent_stmt_t :

402

vhdl_concurrent_stmt_t > vhdl_concurrent_stmt_t=

403

fun x >

404

match x with

405

 SigAssign a > let a = self#vhdl_conditional_signal_t a in SigAssign a

406

 Process a > let a = self#vhdl_process_t a in Process a

407

 SelectedSig a > let a = self#vhdl_selected_signal_t a in SelectedSig a

408


409

method vhdl_port_t : vhdl_port_t > vhdl_port_t=

410

fun { names; mode; typ; expr } >

411

let names = self#list self#vhdl_name_t names in

412

let mode = self#vhdl_port_mode_t mode in

413

let typ = self#vhdl_subtype_indication_t typ in

414

let expr = self#vhdl_expr_t expr in { names; mode; typ; expr }

415


416

method vhdl_entity_t : vhdl_entity_t > vhdl_entity_t=

417

fun { name; generics; ports; declaration; stmts } >

418

let name = self#vhdl_name_t name in

419

let generics = self#list self#vhdl_port_t generics in

420

let ports = self#list self#vhdl_port_t ports in

421

let declaration = self#list self#vhdl_declaration_t declaration in

422

let stmts = self#list self#vhdl_concurrent_stmt_t stmts in

423

{ name; generics; ports; declaration; stmts }

424


425

method vhdl_package_t : vhdl_package_t > vhdl_package_t=

426

fun { name; shared_defs } >

427

let name = self#vhdl_name_t name in

428

let shared_defs = self#list self#vhdl_definition_t shared_defs in

429

{ name; shared_defs }

430


431

method vhdl_load_t : vhdl_load_t > vhdl_load_t=

432

fun x >

433

match x with

434

 Library a > let a = self#list self#vhdl_name_t a in Library a

435

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

436


437

method vhdl_architecture_t : vhdl_architecture_t > vhdl_architecture_t=

438

fun { name; entity; declarations; body } >

439

let name = self#vhdl_name_t name in

440

let entity = self#vhdl_name_t entity in

441

let declarations = self#list self#vhdl_declaration_t declarations in

442

let body = self#list self#vhdl_concurrent_stmt_t body in

443

{ name; entity; declarations; body }

444


445

method vhdl_configuration_t :

446

vhdl_configuration_t > vhdl_configuration_t= self#unit

447


448

method vhdl_library_unit_t : vhdl_library_unit_t > vhdl_library_unit_t=

449

fun x >

450

match x with

451

 Package a > let a = self#vhdl_package_t a in Package a

452

 Entities a > let a = self#vhdl_entity_t a in Entities a

453

 Architecture a >

454

let a = self#vhdl_architecture_t a in Architecture a

455

 Configuration a >

456

let a = self#vhdl_configuration_t a in Configuration a

457


458

method vhdl_design_unit_t : vhdl_design_unit_t > vhdl_design_unit_t=

459

fun { contexts; library } >

460

let contexts = self#list self#vhdl_load_t contexts in

461

let library = self#vhdl_library_unit_t library in

462

{ contexts; library }

463


464

method vhdl_design_file_t : vhdl_design_file_t > vhdl_design_file_t=

465

fun { design_units } >

466

let design_units = self#list self#vhdl_design_unit_t design_units in

467

{ design_units }

468


469

method vhdl_file_t : vhdl_file_t > vhdl_file_t=

470

fun { design_file } >

471

let design_file = self#vhdl_design_file_t design_file in

472

{ design_file }

473

end
