## lustrec / src / backends / VHDL / vhdl_2_mini_vhdl_map.ml @ 010428a7

History | View | Annotate | Download (38.6 KB)

1 | 5bbf7413 | Arnaud Dieumegard | open Vhdl_ast |
---|---|---|---|

2 | open Mini_vhdl_ast |
||

3 | 23b37f25 | Arnaud Dieumegard | open Vhdl_ast_fold_sensitivity |

4 | 5bbf7413 | Arnaud Dieumegard | |

5 | 76f9de64 | Arnaud Dieumegard | type db_tuple_t = |

6 | { |
||

7 | mutable entity: vhdl_entity_t; |
||

8 | mutable architecture: vhdl_architecture_t; |
||

9 | 4aa05aca | Arnaud Dieumegard | mutable architecture_signals: mini_vhdl_declaration_t list; |

10 | 010428a7 | Arnaud Dieumegard | mutable architecture_ports: vhdl_port_t list; |

11 | mutable architecture_generics: vhdl_port_t list; |
||

12 | mutable assigned_names: vhdl_name_t list; |
||

13 | 76f9de64 | Arnaud Dieumegard | mutable contexts: vhdl_load_t list; |

14 | } |
||

15 | |||

16 | 23b37f25 | Arnaud Dieumegard | let get_sensitivity_list = object (self) |

17 | inherit ['acc] fold_sensitivity as super |
||

18 | end |
||

19 | |||

20 | 5bbf7413 | Arnaud Dieumegard | let _ = fun (_ : vhdl_cst_val_t) -> () |

21 | let _ = fun (_ : vhdl_type_t) -> () |
||

22 | let _ = fun (_ : vhdl_element_declaration_t) -> () |
||

23 | let _ = fun (_ : vhdl_subtype_indication_t) -> () |
||

24 | let _ = fun (_ : vhdl_discrete_range_t) -> () |
||

25 | let _ = fun (_ : vhdl_constraint_t) -> () |
||

26 | let _ = fun (_ : vhdl_definition_t) -> () |
||

27 | let _ = fun (_ : vhdl_expr_t) -> () |
||

28 | let _ = fun (_ : vhdl_name_t) -> () |
||

29 | let _ = fun (_ : vhdl_assoc_element_t) -> () |
||

30 | let _ = fun (_ : vhdl_element_assoc_t) -> () |
||

31 | let _ = fun (_ : vhdl_array_attributes_t) -> () |
||

32 | let _ = fun (_ : vhdl_signal_attributes_t) -> () |
||

33 | let _ = fun (_ : vhdl_string_attributes_t) -> () |
||

34 | let _ = fun (_ : vhdl_suffix_selection_t) -> () |
||

35 | let _ = fun (_ : 'basetype vhdl_type_attributes_t) -> () |
||

36 | let _ = fun (_ : vhdl_parameter_t) -> () |
||

37 | let _ = fun (_ : vhdl_subprogram_spec_t) -> () |
||

38 | let _ = fun (_ : vhdl_sequential_stmt_t) -> () |
||

39 | let _ = fun (_ : vhdl_if_case_t) -> () |
||

40 | let _ = fun (_ : vhdl_case_item_t) -> () |
||

41 | let _ = fun (_ : vhdl_declaration_t) -> () |
||

42 | let _ = fun (_ : vhdl_signal_selection_t) -> () |
||

43 | let _ = fun (_ : vhdl_declarative_item_t) -> () |
||

44 | let _ = fun (_ : vhdl_waveform_element_t) -> () |
||

45 | let _ = fun (_ : vhdl_signal_condition_t) -> () |
||

46 | let _ = fun (_ : vhdl_conditional_signal_t) -> () |
||

47 | let _ = fun (_ : vhdl_process_t) -> () |
||

48 | let _ = fun (_ : vhdl_selected_signal_t) -> () |
||

49 | let _ = fun (_ : vhdl_port_mode_t) -> () |
||

50 | let _ = fun (_ : vhdl_component_instantiation_t) -> () |
||

51 | let _ = fun (_ : vhdl_concurrent_stmt_t) -> () |
||

52 | let _ = fun (_ : vhdl_port_t) -> () |
||

53 | let _ = fun (_ : vhdl_entity_t) -> () |
||

54 | let _ = fun (_ : vhdl_package_t) -> () |
||

55 | let _ = fun (_ : vhdl_load_t) -> () |
||

56 | let _ = fun (_ : vhdl_architecture_t) -> () |
||

57 | let _ = fun (_ : vhdl_configuration_t) -> () |
||

58 | let _ = fun (_ : vhdl_library_unit_t) -> () |
||

59 | let _ = fun (_ : vhdl_design_unit_t) -> () |
||

60 | let _ = fun (_ : vhdl_design_file_t) -> () |
||

61 | |||

62 | class virtual vhdl_2_mini_vhdl_map = |
||

63 | object (self) |
||

64 | method virtual string : string -> string |
||

65 | method virtual list : 'a . ('a -> 'a) -> 'a list -> 'a list |
||

66 | method virtual unit : unit -> unit |
||

67 | method virtual bool : bool -> bool |
||

68 | method virtual option : 'a . ('a -> 'a) -> 'a option -> 'a option |
||

69 | method virtual int : int -> int |
||

70 | method virtual vhdl_name_t : vhdl_name_t -> vhdl_name_t |
||

71 | method virtual vhdl_definition_t : vhdl_definition_t -> vhdl_definition_t |
||

72 | method virtual vhdl_port_t : vhdl_port_t -> vhdl_port_t |
||

73 | method virtual vhdl_expr_t : vhdl_expr_t -> vhdl_expr_t |
||

74 | method virtual vhdl_port_mode_t : vhdl_port_mode_t -> vhdl_port_mode_t |
||

75 | method virtual vhdl_element_declaration_t : vhdl_element_declaration_t -> vhdl_element_declaration_t |
||

76 | method virtual vhdl_subtype_indication_t : vhdl_subtype_indication_t -> vhdl_subtype_indication_t |
||

77 | method virtual vhdl_conditional_signal_t : vhdl_conditional_signal_t -> vhdl_conditional_signal_t |
||

78 | method virtual vhdl_selected_signal_t : vhdl_selected_signal_t -> vhdl_selected_signal_t |
||

79 | method virtual vhdl_signal_selection_t : vhdl_signal_selection_t -> vhdl_signal_selection_t |
||

80 | method virtual vhdl_suffix_selection_t : vhdl_suffix_selection_t -> vhdl_suffix_selection_t |
||

81 | method virtual vhdl_waveform_element_t : vhdl_waveform_element_t -> vhdl_waveform_element_t |
||

82 | method virtual vhdl_signal_condition_t : vhdl_signal_condition_t -> vhdl_signal_condition_t |
||

83 | method virtual vhdl_cst_val_t : vhdl_cst_val_t -> vhdl_cst_val_t |
||

84 | method virtual vhdl_subprogram_spec_t : vhdl_subprogram_spec_t -> vhdl_subprogram_spec_t |
||

85 | method virtual vhdl_discrete_range_t : vhdl_discrete_range_t -> vhdl_discrete_range_t |
||

86 | method virtual vhdl_parameter_t : vhdl_parameter_t -> vhdl_parameter_t |
||

87 | 4aa05aca | Arnaud Dieumegard | method virtual vhdl_declaration_t : vhdl_declaration_t -> mini_vhdl_declaration_t |

88 | 5bbf7413 | Arnaud Dieumegard | method virtual vhdl_configuration_t : vhdl_configuration_t -> unit |

89 | method virtual vhdl_entity_t : vhdl_entity_t -> unit |
||

90 | method virtual vhdl_library_unit_t : vhdl_library_unit_t -> unit |
||

91 | method virtual vhdl_load_t : vhdl_load_t -> vhdl_load_t |
||

92 | method virtual vhdl_design_unit_t : vhdl_design_unit_t -> unit |
||

93 | 4aa05aca | Arnaud Dieumegard | |

94 | method virtual vhdl_declarative_item_t : vhdl_declarative_item_t -> mini_vhdl_declarative_item_t |
||

95 | method virtual vhdl_process_t : vhdl_process_t -> mini_vhdl_process_t |
||

96 | method virtual vhdl_concurrent_stmt_t : vhdl_concurrent_stmt_t -> mini_vhdl_concurrent_stmt_t |
||

97 | method virtual vhdl_sequential_stmt_t : vhdl_sequential_stmt_t -> mini_vhdl_sequential_stmt_t |
||

98 | 5bbf7413 | Arnaud Dieumegard | method virtual vhdl_design_file_t : vhdl_design_file_t -> mini_vhdl_design_file_t |

99 | |||

100 | 4aa05aca | Arnaud Dieumegard | method virtual vhdl_package_t : (vhdl_load_t list * vhdl_package_t) -> mini_vhdl_package_t |

101 | 5bbf7413 | Arnaud Dieumegard | method virtual vhdl_architecture_t : ((vhdl_load_t list * vhdl_package_t) list * |

102 | (vhdl_load_t list * vhdl_entity_t) list * |
||

103 | (vhdl_load_t list * vhdl_configuration_t) list * |
||

104 | (vhdl_load_t list * vhdl_architecture_t)) -> mini_vhdl_component_t |
||

105 | 76f9de64 | Arnaud Dieumegard | method virtual vhdl_component_instantiation_t : vhdl_component_instantiation_t -> mini_vhdl_component_instantiation_t |

106 | 5bbf7413 | Arnaud Dieumegard | method virtual declarative_items_declarations : vhdl_declarative_item_t list -> vhdl_declaration_t list |

107 | method virtual declarative_items_definitions : vhdl_declarative_item_t list -> vhdl_definition_t list |
||

108 | method virtual declarative_items_uses : vhdl_declarative_item_t list -> vhdl_load_t list |
||

109 | method virtual filter_entity : ((vhdl_load_t list * vhdl_entity_t) list * vhdl_name_t) -> |
||

110 | (vhdl_load_t list * vhdl_entity_t) |
||

111 | |||

112 | 4a92cb37 | Arnaud Dieumegard | (************************* |

113 | * Begin vhdl_name_t helpers |
||

114 | *) |
||

115 | 76f9de64 | Arnaud Dieumegard | method simplify_name_t : vhdl_name_t -> vhdl_name_t= |

116 | fun n -> |
||

117 | 4a92cb37 | Arnaud Dieumegard | let lower a = String.lowercase_ascii a in |

118 | let n = self#lower_vhdl_name_t n in |
||

119 | 76f9de64 | Arnaud Dieumegard | match n with |

120 | 4a92cb37 | Arnaud Dieumegard | | Selected (a::[]) -> self#simplify_name_t a |

121 | 76f9de64 | Arnaud Dieumegard | | Selected (NoName::tl) -> self#simplify_name_t (Selected tl) |

122 | 4a92cb37 | Arnaud Dieumegard | | Selected ((Simple (s))::tl) -> if (lower s = "work") |

123 | 76f9de64 | Arnaud Dieumegard | then self#simplify_name_t (Selected tl) |

124 | else n |
||

125 | 4a92cb37 | Arnaud Dieumegard | | Selected ((Identifier (s))::tl) -> if (lower s = "work") |

126 | then self#simplify_name_t (Selected tl) |
||

127 | else n |
||

128 | 76f9de64 | Arnaud Dieumegard | | _ -> n |

129 | 4a92cb37 | Arnaud Dieumegard | |

130 | method lower_vhdl_name_t : vhdl_name_t -> vhdl_name_t= |
||

131 | fun x -> |
||

132 | let lower a = String.lowercase_ascii a in |
||

133 | match x with |
||

134 | | Simple a -> Simple (lower a) |
||

135 | | Identifier a -> Identifier (lower a) |
||

136 | | Selected a -> Selected (self#list self#lower_vhdl_name_t a) |
||

137 | | Index { id; exprs } -> |
||

138 | let id = self#lower_vhdl_name_t id in |
||

139 | let exprs = self#list self#vhdl_expr_t exprs in |
||

140 | Index { id; exprs } |
||

141 | | Slice { id; range } -> |
||

142 | let id = self#lower_vhdl_name_t id in |
||

143 | let range = self#vhdl_discrete_range_t range in |
||

144 | Slice { id; range } |
||

145 | | Attribute { id; designator; expr } -> |
||

146 | let id = self#lower_vhdl_name_t id in |
||

147 | let designator = self#lower_vhdl_name_t designator in |
||

148 | let expr = self#vhdl_expr_t expr in |
||

149 | Attribute { id; designator; expr } |
||

150 | | Function { id; assoc_list } -> |
||

151 | let id = self#lower_vhdl_name_t id in |
||

152 | let assoc_list = self#list self#vhdl_assoc_element_t assoc_list in |
||

153 | Function { id; assoc_list } |
||

154 | | NoName -> NoName |
||

155 | |||

156 | method to_string_vhdl_name_t : vhdl_name_t -> string= |
||

157 | fun x -> |
||

158 | match x with |
||

159 | | Simple a -> a |
||

160 | | Identifier a -> a |
||

161 | | Selected a -> String.concat "." (List.map self#to_string_vhdl_name_t a) |
||

162 | | Index { id; exprs } -> self#to_string_vhdl_name_t id |
||

163 | | Slice { id; range } -> self#to_string_vhdl_name_t id |
||

164 | | Attribute { id; designator; expr } -> self#to_string_vhdl_name_t id |
||

165 | | Function { id; assoc_list } -> self#to_string_vhdl_name_t id |
||

166 | | NoName -> "NoName" |
||

167 | 4aa05aca | Arnaud Dieumegard | |

168 | method flatten_vhdl_name_t : vhdl_name_t -> vhdl_name_t= |
||

169 | fun x -> |
||

170 | match x with |
||

171 | | Simple a -> Simple (a) |
||

172 | | Identifier a -> Simple (a) |
||

173 | | Selected (hd::tl) -> Simple (String.concat "__" ((self#to_string_vhdl_name_t (self#flatten_vhdl_name_t hd))::[self#to_string_vhdl_name_t (self#flatten_vhdl_name_t (Selected (tl)))])) |
||

174 | | _ -> failwith ("Impossible to flatten name value [" ^ self#to_string_vhdl_name_t x ^ "]") |
||

175 | |||

176 | method postfix_flatten_vhdl_name_t : vhdl_name_t -> string -> vhdl_name_t= |
||

177 | fun x -> |
||

178 | fun postfix -> |
||

179 | let flattened = self#flatten_vhdl_name_t x in |
||

180 | match flattened with |
||

181 | | Simple a -> Simple (a ^ postfix) |
||

182 | | Identifier a -> Identifier (a ^ postfix) |
||

183 | | _ -> failwith ("Impossible to postfix name value [" ^ self#to_string_vhdl_name_t x ^ "]") |
||

184 | |||

185 | |||

186 | 4a92cb37 | Arnaud Dieumegard | (************************* |

187 | * End vhdl_name_t helpers |
||

188 | *) |
||

189 | |||

190 | (************************* |
||

191 | * Begin DB helpers |
||

192 | *) |
||

193 | val mutable db : db_tuple_t list = [] |
||

194 | |||

195 | 010428a7 | Arnaud Dieumegard | method get_db : db_tuple_t list = db |

196 | |||

197 | 76f9de64 | Arnaud Dieumegard | method db_add_tuple : db_tuple_t -> unit= |

198 | fun x -> db <- x::db |
||

199 | |||

200 | method db_get : vhdl_architecture_t -> (vhdl_entity_t * vhdl_load_t list)= |
||

201 | fun x -> |
||

202 | let rec find a dbl = |
||

203 | match dbl with |
||

204 | 4a92cb37 | Arnaud Dieumegard | | [] -> failwith ("No matching tuple in DB for architecture [" ^ self#to_string_vhdl_name_t x.name ^ "]") |

205 | 76f9de64 | Arnaud Dieumegard | | e::tl -> if (e.architecture = a) then (e.entity, e.contexts) else find a tl in find x db |

206 | |||

207 | 4a92cb37 | Arnaud Dieumegard | method get_tuple_from_archi_and_entity_name : (vhdl_name_t * vhdl_name_t) -> db_tuple_t= |

208 | 76f9de64 | Arnaud Dieumegard | fun (a_name,e_name) -> |

209 | 4a92cb37 | Arnaud Dieumegard | let a_name = self#simplify_name_t a_name in |

210 | let e_name = self#simplify_name_t e_name in |
||

211 | 76f9de64 | Arnaud Dieumegard | let rec find (a_name,e_name) dbl = |

212 | match dbl with |
||

213 | 4a92cb37 | Arnaud Dieumegard | | [] -> failwith ("No matching tuple in DB for architecture [" ^ self#to_string_vhdl_name_t a_name ^ |

214 | "] and entity [" ^ self#to_string_vhdl_name_t e_name ^ "]") |
||

215 | | e::tl -> |
||

216 | let inner_e_arch_name = self#simplify_name_t e.architecture.name in |
||

217 | let inner_e_ent_name = self#simplify_name_t e.entity.name in |
||

218 | if ((inner_e_arch_name = a_name) && (inner_e_ent_name = e_name)) |
||

219 | then e |
||

220 | else find (a_name,e_name) tl in |
||

221 | 76f9de64 | Arnaud Dieumegard | find (a_name,e_name) db |

222 | 010428a7 | Arnaud Dieumegard | |

223 | method filter_entity : ((vhdl_load_t list * vhdl_entity_t) list * vhdl_name_t) -> |
||

224 | (vhdl_load_t list * vhdl_entity_t) = |
||

225 | fun ( entities_pair, filter_name ) -> |
||

226 | let rec filter ep n = match ep with |
||

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

228 | | (c,{name; generics; ports; declaration; stmts})::tl -> |
||

229 | if (name = n) then |
||

230 | List.hd ep |
||

231 | else filter (List.tl ep) n in |
||

232 | filter entities_pair filter_name |
||

233 | 4a92cb37 | Arnaud Dieumegard | (******************* |

234 | * End DB helpers |
||

235 | *) |
||

236 | 76f9de64 | Arnaud Dieumegard | |

237 | 010428a7 | Arnaud Dieumegard | (******************* |

238 | * Begin declarative_item_t projections |
||

239 | *) |
||

240 | method declarative_items_declarations : vhdl_declarative_item_t list -> vhdl_declaration_t list = |
||

241 | fun x -> |
||

242 | match x with |
||

243 | | {use_clause=_; declaration=Some a;definition=_}::tl -> a::(self#declarative_items_declarations tl) |
||

244 | | _::tl -> self#declarative_items_declarations tl |
||

245 | | [] -> [] |
||

246 | |||

247 | method declarative_items_definitions : vhdl_declarative_item_t list -> vhdl_definition_t list = |
||

248 | fun x -> |
||

249 | match x with |
||

250 | | {use_clause=_; declaration=_;definition=Some a}::tl -> a::(self#declarative_items_definitions tl) |
||

251 | | _::tl -> self#declarative_items_definitions tl |
||

252 | | [] -> [] |
||

253 | |||

254 | method declarative_items_uses : vhdl_declarative_item_t list -> vhdl_load_t list = |
||

255 | fun x -> |
||

256 | match x with |
||

257 | | {use_clause=Some a; declaration=_;definition=_}::tl -> a::(self#declarative_items_uses tl) |
||

258 | | _::tl -> self#declarative_items_uses tl |
||

259 | | [] -> [] |
||

260 | (****************** |
||

261 | * End declarative_item_t projections |
||

262 | *) |
||

263 | |||

264 | (***************** |
||

265 | * Begin names_t extraction |
||

266 | *) |
||

267 | method mini_vhdl_concurrent_stmt_t_assigned_signals_names : mini_vhdl_concurrent_stmt_t -> vhdl_name_t list= |
||

268 | fun x -> |
||

269 | match x with |
||

270 | | Process a -> List.flatten (List.map self#mini_vhdl_sequential_stmt_t_assigned_signals_names a.body) |
||

271 | | ComponentInst a -> [] |
||

272 | |||

273 | method mini_vhdl_sequential_stmt_t_assigned_signals_names : |
||

274 | mini_vhdl_sequential_stmt_t -> vhdl_name_t list= |
||

275 | fun x -> |
||

276 | match x with |
||

277 | | VarAssign { label; lhs; rhs } -> [lhs] |
||

278 | | SigSeqAssign { label; lhs; rhs } -> [lhs] |
||

279 | | SigCondAssign { label; lhs; rhs; delay} -> [lhs] |
||

280 | | SigSelectAssign { label; lhs; sel; branches; delay } -> [lhs] |
||

281 | | If { label; if_cases; default } -> |
||

282 | let if_cases_stmts = List.flatten (List.map (fun x -> x.if_block) if_cases) in |
||

283 | List.flatten (List.map self#mini_vhdl_sequential_stmt_t_assigned_signals_names (if_cases_stmts@default)) |
||

284 | | Case { label; guard; branches } -> |
||

285 | let case_branches_stmts = List.flatten (List.map (fun x -> x.when_stmt) branches) in |
||

286 | List.flatten (List.map self#mini_vhdl_sequential_stmt_t_assigned_signals_names case_branches_stmts) |
||

287 | | ProcedureCall { label; name; assocs } -> [] (* TODO: resolve this *) |
||

288 | | _ -> [] |
||

289 | (**************** |
||

290 | *End names_t extraction |
||

291 | *) |
||

292 | |||

293 | 5bbf7413 | Arnaud Dieumegard | method vhdl_cst_val_t : vhdl_cst_val_t -> vhdl_cst_val_t= |

294 | fun x -> |
||

295 | match x with |
||

296 | | CstInt a -> let a = self#int a in CstInt a |
||

297 | | CstStdLogic a -> let a = self#string a in CstStdLogic a |
||

298 | | CstLiteral a -> let a = self#string a in CstLiteral a |
||

299 | |||

300 | method vhdl_type_t : vhdl_type_t -> vhdl_type_t= |
||

301 | fun x -> |
||

302 | match x with |
||

303 | | Base a -> let a = self#string a in Base a |
||

304 | | Range (a,b,c) -> |
||

305 | let a = self#option self#string a in |
||

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

307 | | Bit_vector (a,b) -> |
||

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

309 | | Array { indexes; const; definition } -> |
||

310 | 4a92cb37 | Arnaud Dieumegard | let indexes = self#list self#lower_vhdl_name_t indexes in |

311 | 5bbf7413 | Arnaud Dieumegard | let const = self#option self#vhdl_constraint_t const in |

312 | let definition = self#vhdl_subtype_indication_t definition in |
||

313 | Array { indexes; const; definition } |
||

314 | | Record a -> |
||

315 | let a = self#list self#vhdl_element_declaration_t a in Record a |
||

316 | | Enumerated a -> |
||

317 | 4a92cb37 | Arnaud Dieumegard | let a = self#list self#lower_vhdl_name_t a in Enumerated a |

318 | 5bbf7413 | Arnaud Dieumegard | | Void -> Void |

319 | 4a92cb37 | Arnaud Dieumegard | |

320 | 5bbf7413 | Arnaud Dieumegard | method vhdl_element_declaration_t : |

321 | vhdl_element_declaration_t -> vhdl_element_declaration_t= |
||

322 | fun { names; definition } -> |
||

323 | 4a92cb37 | Arnaud Dieumegard | let names = self#list self#lower_vhdl_name_t names in |

324 | 5bbf7413 | Arnaud Dieumegard | let definition = self#vhdl_subtype_indication_t definition in |

325 | { names; definition } |
||

326 | 4a92cb37 | Arnaud Dieumegard | |

327 | 5bbf7413 | Arnaud Dieumegard | method vhdl_subtype_indication_t : |

328 | vhdl_subtype_indication_t -> vhdl_subtype_indication_t= |
||

329 | fun { name; functionName; const } -> |
||

330 | 4a92cb37 | Arnaud Dieumegard | let name = self#lower_vhdl_name_t name in |

331 | let functionName = self#lower_vhdl_name_t functionName in |
||

332 | 5bbf7413 | Arnaud Dieumegard | let const = self#vhdl_constraint_t const in |

333 | { name; functionName; const } |
||

334 | 4a92cb37 | Arnaud Dieumegard | |

335 | 5bbf7413 | Arnaud Dieumegard | method vhdl_discrete_range_t : |

336 | vhdl_discrete_range_t -> vhdl_discrete_range_t= |
||

337 | fun x -> |
||

338 | match x with |
||

339 | | SubDiscreteRange a -> |
||

340 | let a = self#vhdl_subtype_indication_t a in SubDiscreteRange a |
||

341 | 4a92cb37 | Arnaud Dieumegard | | NamedRange a -> let a = self#lower_vhdl_name_t a in NamedRange a |

342 | 5bbf7413 | Arnaud Dieumegard | | DirectedRange { direction; from; _to } -> |

343 | let direction = self#string direction in |
||

344 | let from = self#vhdl_expr_t from in |
||

345 | let _to = self#vhdl_expr_t _to in |
||

346 | DirectedRange { direction; from; _to } |
||

347 | |||

348 | method vhdl_constraint_t : vhdl_constraint_t -> vhdl_constraint_t= |
||

349 | fun x -> |
||

350 | match x with |
||

351 | | RefConstraint { ref_name } -> |
||

352 | 4a92cb37 | Arnaud Dieumegard | let ref_name = self#lower_vhdl_name_t ref_name in |

353 | 5bbf7413 | Arnaud Dieumegard | RefConstraint { ref_name } |

354 | | RangeConstraint { range } -> |
||

355 | let range = self#vhdl_discrete_range_t range in |
||

356 | RangeConstraint { range } |
||

357 | | IndexConstraint { ranges } -> |
||

358 | let ranges = self#list self#vhdl_discrete_range_t ranges in |
||

359 | IndexConstraint { ranges } |
||

360 | | ArrayConstraint { ranges; sub } -> |
||

361 | let ranges = self#list self#vhdl_discrete_range_t ranges in |
||

362 | let sub = self#vhdl_constraint_t sub in |
||

363 | ArrayConstraint { ranges; sub } |
||

364 | | RecordConstraint -> RecordConstraint |
||

365 | | NoConstraint -> NoConstraint |
||

366 | |||

367 | method vhdl_definition_t : vhdl_definition_t -> vhdl_definition_t= |
||

368 | fun x -> |
||

369 | match x with |
||

370 | | Type { name; definition } -> |
||

371 | 4a92cb37 | Arnaud Dieumegard | let name = self#lower_vhdl_name_t name in |

372 | 5bbf7413 | Arnaud Dieumegard | let definition = self#vhdl_type_t definition in |

373 | Type { name; definition } |
||

374 | | Subtype { name; typ } -> |
||

375 | 4a92cb37 | Arnaud Dieumegard | let name = self#lower_vhdl_name_t name in |

376 | 5bbf7413 | Arnaud Dieumegard | let typ = self#vhdl_subtype_indication_t typ in |

377 | Subtype { name; typ } |
||

378 | 4a92cb37 | Arnaud Dieumegard | |

379 | 5bbf7413 | Arnaud Dieumegard | method vhdl_expr_t : vhdl_expr_t -> vhdl_expr_t= |

380 | fun x -> |
||

381 | match x with |
||

382 | 4a92cb37 | Arnaud Dieumegard | | Call a -> let a = self#lower_vhdl_name_t a in Call a |

383 | 5bbf7413 | Arnaud Dieumegard | | Cst { value; unit_name } -> |

384 | let value = self#vhdl_cst_val_t value in |
||

385 | 4a92cb37 | Arnaud Dieumegard | let unit_name = self#option self#lower_vhdl_name_t unit_name in |

386 | 5bbf7413 | Arnaud Dieumegard | Cst { value; unit_name } |

387 | | Op { id; args } -> |
||

388 | let id = self#string id in |
||

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

390 | | IsNull -> IsNull |
||

391 | | Time { value; phy_unit } -> |
||

392 | let value = self#int value in |
||

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

394 | | Sig { name; att } -> |
||

395 | 4a92cb37 | Arnaud Dieumegard | let name = self#lower_vhdl_name_t name in |

396 | 5bbf7413 | Arnaud Dieumegard | let att = self#option self#vhdl_signal_attributes_t att in |

397 | Sig { name; att } |
||

398 | | SuffixMod { expr; selection } -> |
||

399 | let expr = self#vhdl_expr_t expr in |
||

400 | let selection = self#vhdl_suffix_selection_t selection in |
||

401 | SuffixMod { expr; selection } |
||

402 | | Aggregate { elems } -> |
||

403 | let elems = self#list self#vhdl_element_assoc_t elems in |
||

404 | Aggregate { elems } |
||

405 | | QualifiedExpression { type_mark; aggregate; expression } -> |
||

406 | 4a92cb37 | Arnaud Dieumegard | let type_mark = self#lower_vhdl_name_t type_mark in |

407 | 5bbf7413 | Arnaud Dieumegard | let aggregate = self#list self#vhdl_element_assoc_t aggregate in |

408 | let expression = self#option self#vhdl_expr_t expression in |
||

409 | QualifiedExpression { type_mark; aggregate; expression } |
||

410 | | Others -> Others |
||

411 | 4a92cb37 | Arnaud Dieumegard | |

412 | 5bbf7413 | Arnaud Dieumegard | method vhdl_name_t : vhdl_name_t -> vhdl_name_t= |

413 | fun x -> |
||

414 | match x with |
||

415 | | Simple a -> let a = self#string a in Simple a |
||

416 | | Identifier a -> let a = self#string a in Identifier a |
||

417 | 4a92cb37 | Arnaud Dieumegard | | Selected a -> let a = self#list self#lower_vhdl_name_t a in Selected a |

418 | 5bbf7413 | Arnaud Dieumegard | | Index { id; exprs } -> |

419 | 4a92cb37 | Arnaud Dieumegard | let id = self#lower_vhdl_name_t id in |

420 | 5bbf7413 | Arnaud Dieumegard | let exprs = self#list self#vhdl_expr_t exprs in |

421 | Index { id; exprs } |
||

422 | | Slice { id; range } -> |
||

423 | 4a92cb37 | Arnaud Dieumegard | let id = self#lower_vhdl_name_t id in |

424 | 5bbf7413 | Arnaud Dieumegard | let range = self#vhdl_discrete_range_t range in |

425 | Slice { id; range } |
||

426 | | Attribute { id; designator; expr } -> |
||

427 | 4a92cb37 | Arnaud Dieumegard | let id = self#lower_vhdl_name_t id in |

428 | let designator = self#lower_vhdl_name_t designator in |
||

429 | 5bbf7413 | Arnaud Dieumegard | let expr = self#vhdl_expr_t expr in |

430 | Attribute { id; designator; expr } |
||

431 | | Function { id; assoc_list } -> |
||

432 | 4a92cb37 | Arnaud Dieumegard | let id = self#lower_vhdl_name_t id in |

433 | 5bbf7413 | Arnaud Dieumegard | let assoc_list = self#list self#vhdl_assoc_element_t assoc_list |

434 | in |
||

435 | Function { id; assoc_list } |
||

436 | | NoName -> NoName |
||

437 | 4a92cb37 | Arnaud Dieumegard | |

438 | 5bbf7413 | Arnaud Dieumegard | method vhdl_assoc_element_t : |

439 | vhdl_assoc_element_t -> vhdl_assoc_element_t= |
||

440 | fun |
||

441 | { formal_name; formal_arg; actual_name; actual_designator; |
||

442 | actual_expr } |
||

443 | -> |
||

444 | 4a92cb37 | Arnaud Dieumegard | let formal_name = self#option self#lower_vhdl_name_t formal_name in |

445 | let formal_arg = self#option self#lower_vhdl_name_t formal_arg in |
||

446 | let actual_name = self#option self#lower_vhdl_name_t actual_name in |
||

447 | 5bbf7413 | Arnaud Dieumegard | let actual_designator = |

448 | 4a92cb37 | Arnaud Dieumegard | self#option self#lower_vhdl_name_t actual_designator in |

449 | 5bbf7413 | Arnaud Dieumegard | let actual_expr = self#option self#vhdl_expr_t actual_expr in |

450 | { |
||

451 | formal_name; |
||

452 | formal_arg; |
||

453 | actual_name; |
||

454 | actual_designator; |
||

455 | actual_expr |
||

456 | } |
||

457 | 4a92cb37 | Arnaud Dieumegard | |

458 | 5bbf7413 | Arnaud Dieumegard | method vhdl_element_assoc_t : |

459 | vhdl_element_assoc_t -> vhdl_element_assoc_t= |
||

460 | fun { choices; expr } -> |
||

461 | let choices = self#list self#vhdl_expr_t choices in |
||

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

463 | 4a92cb37 | Arnaud Dieumegard | |

464 | 5bbf7413 | Arnaud Dieumegard | method vhdl_array_attributes_t : |

465 | vhdl_array_attributes_t -> vhdl_array_attributes_t= |
||

466 | fun x -> |
||

467 | match x with |
||

468 | | AAttInt { id; arg } -> |
||

469 | let id = self#string id in |
||

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

471 | | AAttAscending -> AAttAscending |
||

472 | 4a92cb37 | Arnaud Dieumegard | |

473 | 5bbf7413 | Arnaud Dieumegard | method vhdl_signal_attributes_t : |

474 | vhdl_signal_attributes_t -> vhdl_signal_attributes_t= |
||

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

476 | 4a92cb37 | Arnaud Dieumegard | |

477 | 5bbf7413 | Arnaud Dieumegard | method vhdl_string_attributes_t : |

478 | vhdl_string_attributes_t -> vhdl_string_attributes_t= |
||

479 | fun x -> |
||

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

481 | 4a92cb37 | Arnaud Dieumegard | |

482 | 5bbf7413 | Arnaud Dieumegard | method vhdl_suffix_selection_t : vhdl_suffix_selection_t -> vhdl_suffix_selection_t= |

483 | fun x -> |
||

484 | match x with |
||

485 | | Idx a -> let a = self#int a in Idx a |
||

486 | | SuffixRange (a,b) -> |
||

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

488 | |||

489 | method vhdl_type_attributes_t : |
||

490 | 'a . |
||

491 | ('a -> 'a) -> 'a vhdl_type_attributes_t -> 'a vhdl_type_attributes_t= |
||

492 | fun _basetype -> |
||

493 | fun x -> |
||

494 | match x with |
||

495 | | TAttNoArg { id } -> let id = self#string id in TAttNoArg { id } |
||

496 | | TAttIntArg { id; arg } -> |
||

497 | let id = self#string id in |
||

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

499 | | TAttValArg { id; arg } -> |
||

500 | let id = self#string id in |
||

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

502 | | TAttStringArg { id; arg } -> |
||

503 | let id = self#string id in |
||

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

505 | |||

506 | method vhdl_parameter_t : vhdl_parameter_t -> vhdl_parameter_t= |
||

507 | fun { names; mode; typ; init_val } -> |
||

508 | 4a92cb37 | Arnaud Dieumegard | let names = self#list self#lower_vhdl_name_t names in |

509 | 5bbf7413 | Arnaud Dieumegard | let mode = self#list self#string mode in |

510 | let typ = self#vhdl_subtype_indication_t typ in |
||

511 | let init_val = self#option self#vhdl_cst_val_t init_val in |
||

512 | { names; mode; typ; init_val } |
||

513 | |||

514 | method vhdl_subprogram_spec_t : |
||

515 | vhdl_subprogram_spec_t -> vhdl_subprogram_spec_t= |
||

516 | fun { name; subprogram_type; typeMark; parameters; isPure } -> |
||

517 | let name = self#string name in |
||

518 | let subprogram_type = self#string subprogram_type in |
||

519 | 4a92cb37 | Arnaud Dieumegard | let typeMark = self#lower_vhdl_name_t typeMark in |

520 | 5bbf7413 | Arnaud Dieumegard | let parameters = self#list self#vhdl_parameter_t parameters in |

521 | let isPure = self#bool isPure in |
||

522 | { name; subprogram_type; typeMark; parameters; isPure } |
||

523 | |||

524 | method vhdl_sequential_stmt_t : |
||

525 | 4aa05aca | Arnaud Dieumegard | vhdl_sequential_stmt_t -> mini_vhdl_sequential_stmt_t= |

526 | 5bbf7413 | Arnaud Dieumegard | fun x -> |

527 | match x with |
||

528 | | VarAssign { label; lhs; rhs } -> |
||

529 | 23b37f25 | Arnaud Dieumegard | let label = match label with NoName -> None | _ -> Some (self#lower_vhdl_name_t label) in |

530 | 4a92cb37 | Arnaud Dieumegard | let lhs = self#lower_vhdl_name_t lhs in |

531 | 5bbf7413 | Arnaud Dieumegard | let rhs = self#vhdl_expr_t rhs in VarAssign { label; lhs; rhs } |

532 | | SigSeqAssign { label; lhs; rhs } -> |
||

533 | 23b37f25 | Arnaud Dieumegard | let label = match label with NoName -> None | _ -> Some (self#lower_vhdl_name_t label) in |

534 | 4a92cb37 | Arnaud Dieumegard | let lhs = self#lower_vhdl_name_t lhs in |

535 | 23b37f25 | Arnaud Dieumegard | let rhs = self#list self#vhdl_waveform_element_t rhs in |

536 | 5bbf7413 | Arnaud Dieumegard | SigSeqAssign { label; lhs; rhs } |

537 | | If { label; if_cases; default } -> |
||

538 | 23b37f25 | Arnaud Dieumegard | let label = match label with NoName -> None | _ -> Some (self#lower_vhdl_name_t label) in |

539 | 4aa05aca | Arnaud Dieumegard | let if_cases = List.map self#vhdl_if_case_t if_cases in |

540 | let default = List.map self#vhdl_sequential_stmt_t default in |
||

541 | 5bbf7413 | Arnaud Dieumegard | If { label; if_cases; default } |

542 | | Case { label; guard; branches } -> |
||

543 | 23b37f25 | Arnaud Dieumegard | let label = match label with NoName -> None | _ -> Some (self#lower_vhdl_name_t label) in |

544 | 5bbf7413 | Arnaud Dieumegard | let guard = self#vhdl_expr_t guard in |

545 | 4aa05aca | Arnaud Dieumegard | let branches = List.map self#vhdl_case_item_t branches in |

546 | 5bbf7413 | Arnaud Dieumegard | Case { label; guard; branches } |

547 | | Exit { label; loop_label; condition } -> |
||

548 | 23b37f25 | Arnaud Dieumegard | let label = match label with NoName -> None | _ -> Some (self#lower_vhdl_name_t label) in |

549 | 5bbf7413 | Arnaud Dieumegard | let loop_label = self#option self#string loop_label in |

550 | let condition = self#option self#vhdl_expr_t condition in |
||

551 | Exit { label; loop_label; condition } |
||

552 | | Assert { label; cond; report; severity } -> |
||

553 | 23b37f25 | Arnaud Dieumegard | let label = match label with NoName -> None | _ -> Some (self#lower_vhdl_name_t label) in |

554 | 5bbf7413 | Arnaud Dieumegard | let cond = self#vhdl_expr_t cond in |

555 | let report = self#vhdl_expr_t report in |
||

556 | let severity = self#vhdl_expr_t severity in |
||

557 | Assert { label; cond; report; severity } |
||

558 | | ProcedureCall { label; name; assocs } -> |
||

559 | 23b37f25 | Arnaud Dieumegard | let label = match label with NoName -> None | _ -> Some (self#lower_vhdl_name_t label) in |

560 | 4a92cb37 | Arnaud Dieumegard | let name = self#lower_vhdl_name_t name in |

561 | 5bbf7413 | Arnaud Dieumegard | let assocs = self#list self#vhdl_assoc_element_t assocs in |

562 | ProcedureCall { label; name; assocs } |
||

563 | | Wait -> Wait |
||

564 | | Null { label } -> |
||

565 | 23b37f25 | Arnaud Dieumegard | let label = match label with NoName -> None | _ -> Some (self#lower_vhdl_name_t label) in |

566 | Null { label } |
||

567 | 5bbf7413 | Arnaud Dieumegard | | Return { label; expr } -> |

568 | 4a92cb37 | Arnaud Dieumegard | let label = self#option self#lower_vhdl_name_t label in |

569 | 5bbf7413 | Arnaud Dieumegard | let expr = self#option self#vhdl_expr_t expr in |

570 | Return { label; expr } |
||

571 | 4a92cb37 | Arnaud Dieumegard | |

572 | 4aa05aca | Arnaud Dieumegard | method vhdl_if_case_t : vhdl_if_case_t -> mini_vhdl_if_case_t= |

573 | 5bbf7413 | Arnaud Dieumegard | fun { if_cond; if_block } -> |

574 | let if_cond = self#vhdl_expr_t if_cond in |
||

575 | 4aa05aca | Arnaud Dieumegard | let if_block = List.map self#vhdl_sequential_stmt_t if_block in |

576 | 5bbf7413 | Arnaud Dieumegard | { if_cond; if_block } |

577 | 4a92cb37 | Arnaud Dieumegard | |

578 | 4aa05aca | Arnaud Dieumegard | method vhdl_case_item_t : vhdl_case_item_t -> mini_vhdl_case_item_t= |

579 | 5bbf7413 | Arnaud Dieumegard | fun { when_cond; when_stmt } -> |

580 | let when_cond = self#list self#vhdl_expr_t when_cond in |
||

581 | 4aa05aca | Arnaud Dieumegard | let when_stmt = List.map self#vhdl_sequential_stmt_t when_stmt in |

582 | 5bbf7413 | Arnaud Dieumegard | { when_cond; when_stmt } |

583 | |||

584 | 4aa05aca | Arnaud Dieumegard | method vhdl_declaration_t : vhdl_declaration_t -> mini_vhdl_declaration_t= |

585 | 5bbf7413 | Arnaud Dieumegard | fun x -> |

586 | match x with |
||

587 | | VarDecl { names; typ; init_val } -> |
||

588 | 4a92cb37 | Arnaud Dieumegard | let names = self#list self#lower_vhdl_name_t names in |

589 | 5bbf7413 | Arnaud Dieumegard | let typ = self#vhdl_subtype_indication_t typ in |

590 | let init_val = self#vhdl_expr_t init_val in |
||

591 | VarDecl { names; typ; init_val } |
||

592 | | CstDecl { names; typ; init_val } -> |
||

593 | 4a92cb37 | Arnaud Dieumegard | let names = self#list self#lower_vhdl_name_t names in |

594 | 5bbf7413 | Arnaud Dieumegard | let typ = self#vhdl_subtype_indication_t typ in |

595 | let init_val = self#vhdl_expr_t init_val in |
||

596 | CstDecl { names; typ; init_val } |
||

597 | | SigDecl { names; typ; init_val } -> |
||

598 | 4a92cb37 | Arnaud Dieumegard | let names = self#list self#lower_vhdl_name_t names in |

599 | 5bbf7413 | Arnaud Dieumegard | let typ = self#vhdl_subtype_indication_t typ in |

600 | let init_val = self#vhdl_expr_t init_val in |
||

601 | SigDecl { names; typ; init_val } |
||

602 | | ComponentDecl { name; generics; ports } -> |
||

603 | 4a92cb37 | Arnaud Dieumegard | let name = self#lower_vhdl_name_t name in |

604 | 5bbf7413 | Arnaud Dieumegard | let generics = self#list self#vhdl_port_t generics in |

605 | let ports = self#list self#vhdl_port_t ports in |
||

606 | ComponentDecl { name; generics; ports } |
||

607 | | Subprogram { spec; decl_part; stmts } -> |
||

608 | let spec = self#vhdl_subprogram_spec_t spec in |
||

609 | 4aa05aca | Arnaud Dieumegard | let decl_part = List.map self#vhdl_declaration_t decl_part in |

610 | let stmts = List.map self#vhdl_sequential_stmt_t stmts in |
||

611 | 5bbf7413 | Arnaud Dieumegard | Subprogram { spec; decl_part; stmts } |

612 | |||

613 | method vhdl_declarative_item_t : |
||

614 | 4aa05aca | Arnaud Dieumegard | vhdl_declarative_item_t -> mini_vhdl_declarative_item_t= |

615 | 5bbf7413 | Arnaud Dieumegard | fun { use_clause; declaration; definition } -> |

616 | let use_clause = self#option self#vhdl_load_t use_clause in |
||

617 | 4aa05aca | Arnaud Dieumegard | let declaration = |

618 | match declaration with |
||

619 | | None -> None |
||

620 | | Some a -> Some (self#vhdl_declaration_t a) in |
||

621 | 5bbf7413 | Arnaud Dieumegard | let definition = self#option self#vhdl_definition_t definition in |

622 | { use_clause; declaration; definition } |
||

623 | |||

624 | method vhdl_waveform_element_t : |
||

625 | vhdl_waveform_element_t -> vhdl_waveform_element_t= |
||

626 | fun { value; delay } -> |
||

627 | let value = self#option self#vhdl_expr_t value in |
||

628 | let delay = self#option self#vhdl_expr_t delay in { value; delay } |
||

629 | |||

630 | method vhdl_signal_condition_t : |
||

631 | vhdl_signal_condition_t -> vhdl_signal_condition_t= |
||

632 | fun { expr; cond } -> |
||

633 | let expr = self#list self#vhdl_waveform_element_t expr in |
||

634 | let cond = self#option self#vhdl_expr_t cond in { expr; cond } |
||

635 | |||

636 | method vhdl_signal_selection_t : |
||

637 | vhdl_signal_selection_t -> vhdl_signal_selection_t= |
||

638 | fun { expr; when_sel } -> |
||

639 | let expr = self#list self#vhdl_waveform_element_t expr in |
||

640 | let when_sel = self#list self#vhdl_expr_t when_sel in |
||

641 | { expr; when_sel } |
||

642 | |||

643 | method vhdl_conditional_signal_t : |
||

644 | vhdl_conditional_signal_t -> vhdl_conditional_signal_t= |
||

645 | fun { postponed; label; lhs; rhs; delay } -> |
||

646 | let postponed = self#bool postponed in |
||

647 | 4a92cb37 | Arnaud Dieumegard | let label = self#lower_vhdl_name_t label in |

648 | let lhs = self#lower_vhdl_name_t lhs in |
||

649 | 5bbf7413 | Arnaud Dieumegard | let rhs = self#list self#vhdl_signal_condition_t rhs in |

650 | let delay = self#vhdl_expr_t delay in |
||

651 | { postponed; label; lhs; rhs; delay } |
||

652 | |||

653 | 4aa05aca | Arnaud Dieumegard | method vhdl_process_t : vhdl_process_t -> mini_vhdl_process_t= |

654 | 5bbf7413 | Arnaud Dieumegard | fun { id; declarations; active_sigs; body } -> |

655 | 4a92cb37 | Arnaud Dieumegard | let id = self#lower_vhdl_name_t id in |

656 | 4aa05aca | Arnaud Dieumegard | let declarations = List.map self#vhdl_declarative_item_t declarations in |

657 | 4a92cb37 | Arnaud Dieumegard | let active_sigs = self#list self#lower_vhdl_name_t active_sigs in |

658 | 4aa05aca | Arnaud Dieumegard | let body = List.map self#vhdl_sequential_stmt_t body in |

659 | 23b37f25 | Arnaud Dieumegard | let postponed = false in |

660 | let label = None in |
||

661 | { id; declarations; active_sigs; body; postponed; label } |
||

662 | 5bbf7413 | Arnaud Dieumegard | |

663 | method vhdl_selected_signal_t : |
||

664 | vhdl_selected_signal_t -> vhdl_selected_signal_t= |
||

665 | fun { postponed; label; lhs; sel; branches; delay } -> |
||

666 | let postponed = self#bool postponed in |
||

667 | 4a92cb37 | Arnaud Dieumegard | let label = self#lower_vhdl_name_t label in |

668 | let lhs = self#lower_vhdl_name_t lhs in |
||

669 | 5bbf7413 | Arnaud Dieumegard | let sel = self#vhdl_expr_t sel in |

670 | let branches = self#list self#vhdl_signal_selection_t branches in |
||

671 | let delay = self#option self#vhdl_expr_t delay in |
||

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

673 | |||

674 | method vhdl_port_mode_t : vhdl_port_mode_t -> vhdl_port_mode_t= |
||

675 | fun x -> x |
||

676 | |||

677 | method vhdl_component_instantiation_t : |
||

678 | 76f9de64 | Arnaud Dieumegard | vhdl_component_instantiation_t -> mini_vhdl_component_instantiation_t= |

679 | 5bbf7413 | Arnaud Dieumegard | fun { name; inst_unit; inst_unit_type; archi_name; generic_map; port_map } -> |

680 | 4a92cb37 | Arnaud Dieumegard | let name = self#lower_vhdl_name_t name in |

681 | let archi_name = self#option self#lower_vhdl_name_t archi_name in |
||

682 | let inst_unit = self#lower_vhdl_name_t inst_unit in |
||

683 | 76f9de64 | Arnaud Dieumegard | let db_tuple = match archi_name with |

684 | 4a92cb37 | Arnaud Dieumegard | | None -> failwith ("Component [" ^ self#to_string_vhdl_name_t name ^ "] is not an entity") |

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

686 | 76f9de64 | Arnaud Dieumegard | let archi = db_tuple.architecture in |

687 | let entity = db_tuple.entity in |
||

688 | 5bbf7413 | Arnaud Dieumegard | let generic_map = self#list self#vhdl_assoc_element_t generic_map in |

689 | let port_map = self#list self#vhdl_assoc_element_t port_map in |
||

690 | 76f9de64 | Arnaud Dieumegard | { name; archi; entity; generic_map; port_map } |

691 | 5bbf7413 | Arnaud Dieumegard | |

692 | method vhdl_concurrent_stmt_t : |
||

693 | 76f9de64 | Arnaud Dieumegard | vhdl_concurrent_stmt_t -> mini_vhdl_concurrent_stmt_t= |

694 | 5bbf7413 | Arnaud Dieumegard | fun x -> |

695 | match x with |
||

696 | 4aa05aca | Arnaud Dieumegard | | SigAssign a -> |

697 | Process { |
||

698 | id = self#postfix_flatten_vhdl_name_t a.lhs "__implicit_process"; |
||

699 | declarations = []; |
||

700 | 010428a7 | Arnaud Dieumegard | active_sigs = get_sensitivity_list#vhdl_concurrent_stmt_t x []; |

701 | 23b37f25 | Arnaud Dieumegard | body = (SigCondAssign { |

702 | label = None; |
||

703 | 4aa05aca | Arnaud Dieumegard | lhs = a.lhs; |

704 | rhs = a.rhs; |
||

705 | 23b37f25 | Arnaud Dieumegard | delay = match a.delay with | IsNull -> None | _ -> Some a.delay |

706 | })::[]; |
||

707 | postponed = a.postponed; |
||

708 | label = match a.label with | NoName -> None | _ -> Some a.label |
||

709 | 4aa05aca | Arnaud Dieumegard | } |

710 | 5bbf7413 | Arnaud Dieumegard | | Process a -> let a = self#vhdl_process_t a in Process a |

711 | 23b37f25 | Arnaud Dieumegard | | SelectedSig a -> |

712 | Process { |
||

713 | id = self#postfix_flatten_vhdl_name_t a.lhs "__implicit_process"; |
||

714 | declarations = []; |
||

715 | 010428a7 | Arnaud Dieumegard | active_sigs = get_sensitivity_list#vhdl_concurrent_stmt_t x []; |

716 | 23b37f25 | Arnaud Dieumegard | body = (SigSelectAssign { |

717 | label = None; |
||

718 | lhs = a.lhs; |
||

719 | sel = a.sel; |
||

720 | branches = a.branches; |
||

721 | delay = a.delay |
||

722 | })::[]; |
||

723 | postponed = a.postponed; |
||

724 | label = match a.label with | NoName -> None | _ -> Some a.label |
||

725 | } |
||

726 | 010428a7 | Arnaud Dieumegard | | ComponentInst a -> let a = self#vhdl_component_instantiation_t a in ComponentInst a |

727 | 5bbf7413 | Arnaud Dieumegard | |

728 | method vhdl_port_t : vhdl_port_t -> vhdl_port_t= |
||

729 | fun { names; mode; typ; expr } -> |
||

730 | 4a92cb37 | Arnaud Dieumegard | let names = self#list self#lower_vhdl_name_t names in |

731 | 5bbf7413 | Arnaud Dieumegard | let mode = self#vhdl_port_mode_t mode in |

732 | let typ = self#vhdl_subtype_indication_t typ in |
||

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

734 | |||

735 | method vhdl_entity_t : vhdl_entity_t -> unit = |
||

736 | 76f9de64 | Arnaud Dieumegard | fun { name; generics; ports; declaration; stmts } -> () |

737 | 5bbf7413 | Arnaud Dieumegard | |

738 | 4aa05aca | Arnaud Dieumegard | method vhdl_package_t : (vhdl_load_t list * vhdl_package_t) -> mini_vhdl_package_t= |

739 | 5bbf7413 | Arnaud Dieumegard | fun ( ctxs, {name; shared_defs; shared_decls; shared_uses }) -> |

740 | 4a92cb37 | Arnaud Dieumegard | let name = self#lower_vhdl_name_t name in |

741 | 5bbf7413 | Arnaud Dieumegard | let shared_defs = self#list self#vhdl_definition_t shared_defs in |

742 | 4aa05aca | Arnaud Dieumegard | let shared_decls = List.map self#vhdl_declaration_t shared_decls in |

743 | 5bbf7413 | Arnaud Dieumegard | let shared_uses = self#list self#vhdl_load_t shared_uses @ ctxs in |

744 | { name; shared_defs; shared_decls; shared_uses } |
||

745 | |||

746 | method vhdl_load_t : vhdl_load_t -> vhdl_load_t= |
||

747 | fun x -> |
||

748 | match x with |
||

749 | 4a92cb37 | Arnaud Dieumegard | | Library a -> let a = self#list self#lower_vhdl_name_t a in Library a |

750 | | Use a -> let a = self#list self#lower_vhdl_name_t a in Use a |
||

751 | 5bbf7413 | Arnaud Dieumegard | |

752 | method vhdl_architecture_t : ((vhdl_load_t list * vhdl_package_t) list * |
||

753 | (vhdl_load_t list * vhdl_entity_t) list * |
||

754 | (vhdl_load_t list * vhdl_configuration_t) list * |
||

755 | (vhdl_load_t list * vhdl_architecture_t)) -> mini_vhdl_component_t= |
||

756 | 010428a7 | Arnaud Dieumegard | fun ( packs_pairs, ents_pairs, confs_pairs, (arch_ctx, arch) ) -> |

757 | 5bbf7413 | Arnaud Dieumegard | let names = arch.name::(arch.entity::[]) in |

758 | let (ref_ent_ctx,ref_ent) = self#filter_entity (ents_pairs, arch.entity) in |
||

759 | let contexts = |
||

760 | 3340aff0 | Arnaud Dieumegard | ref_ent_ctx @ (* Referenced entity context elements *) |

761 | 76f9de64 | Arnaud Dieumegard | arch_ctx @ (* Architecture context elements *) |

762 | self#declarative_items_uses ref_ent.declaration @ (* Referenced entity inner context elements *) |
||

763 | self#declarative_items_uses arch.declarations in (* Architecture inner context elements *) |
||

764 | 5bbf7413 | Arnaud Dieumegard | let declarations = |

765 | 76f9de64 | Arnaud Dieumegard | self#declarative_items_declarations ref_ent.declaration @ (* Referenced entity inner declarations *) |

766 | self#declarative_items_declarations arch.declarations in (* Architecture inner declarations *) |
||

767 | 5bbf7413 | Arnaud Dieumegard | let definitions = |

768 | 76f9de64 | Arnaud Dieumegard | self#declarative_items_definitions ref_ent.declaration @ (* Referenced entity inner definitions *) |

769 | self#declarative_items_definitions arch.declarations in (* Architecture inner definitions *) |
||

770 | 5bbf7413 | Arnaud Dieumegard | let body = |

771 | 76f9de64 | Arnaud Dieumegard | List.map self#vhdl_concurrent_stmt_t ref_ent.stmts @ (* Referenced entity concurrent statement *) |

772 | List.map self#vhdl_concurrent_stmt_t arch.body in (* Architecture concurrent statements *) |
||

773 | 3340aff0 | Arnaud Dieumegard | let generics = ref_ent.generics in (* Referenced entity generics *) |

774 | 4a37b02a | Arnaud Dieumegard | let ports = ref_ent.ports in (* Referenced entity ports *) |

775 | 4aa05aca | Arnaud Dieumegard | let declarations = List.map self#vhdl_declaration_t declarations in |

776 | let signals = |
||

777 | let rec find_sig_decls declarations = |
||

778 | match declarations with |
||

779 | | [] -> [] |
||

780 | | (SigDecl (s))::tl -> (SigDecl (s))::find_sig_decls tl |
||

781 | | _::tl -> find_sig_decls tl in find_sig_decls declarations in |
||

782 | 010428a7 | Arnaud Dieumegard | let assigned_names = List.flatten (List.map self#mini_vhdl_concurrent_stmt_t_assigned_signals_names body) in |

783 | (* TODO: Flatten component instantiation from here *) |
||

784 | 4aa05aca | Arnaud Dieumegard | self#db_add_tuple { entity=ref_ent; |

785 | architecture=arch; |
||

786 | 010428a7 | Arnaud Dieumegard | architecture_signals=signals; |

787 | architecture_ports=ports; |
||

788 | architecture_generics=generics; |
||

789 | assigned_names=assigned_names; |
||

790 | contexts=contexts; |
||

791 | 4aa05aca | Arnaud Dieumegard | }; |

792 | { names; |
||

793 | generics=generics; |
||

794 | ports=ports; |
||

795 | contexts=contexts; |
||

796 | declarations=declarations; |
||

797 | definitions=definitions; |
||

798 | 010428a7 | Arnaud Dieumegard | body=body |

799 | 4aa05aca | Arnaud Dieumegard | } |

800 | 5bbf7413 | Arnaud Dieumegard | |

801 | method vhdl_configuration_t : |
||

802 | vhdl_configuration_t -> unit= self#unit |
||

803 | |||

804 | method vhdl_library_unit_t : vhdl_library_unit_t -> unit= |
||

805 | 76f9de64 | Arnaud Dieumegard | fun x -> () |

806 | 5bbf7413 | Arnaud Dieumegard | |

807 | method vhdl_design_unit_t : vhdl_design_unit_t -> unit= |
||

808 | 76f9de64 | Arnaud Dieumegard | fun { contexts; library } -> () |

809 | 5bbf7413 | Arnaud Dieumegard | |

810 | method vhdl_design_file_t : vhdl_design_file_t -> mini_vhdl_design_file_t= |
||

811 | fun { design_units } -> |
||

812 | let rec inline_df l packs ents archs confs = match l with |
||

813 | | [] -> (List.rev packs, List.rev ents, List.rev archs, List.rev confs) |
||

814 | | {contexts = c; library = lib}::tl -> match lib with |
||

815 | | Package p -> inline_df tl ((c,p)::packs) ents archs confs |
||

816 | | Entities e -> inline_df tl packs ((c,e)::ents) archs confs |
||

817 | | Architecture a -> inline_df tl packs ents ((c,a)::archs) confs |
||

818 | | Configuration conf -> inline_df tl packs ents archs ((c,conf)::confs) in |
||

819 | let (p,e,a,con) = inline_df design_units [] [] [] [] in |
||

820 | let app x = self#vhdl_architecture_t (p,e,con,x) in |
||

821 | let components = List.map app a in |
||

822 | let packages = List.map self#vhdl_package_t p in |
||

823 | { components; packages } |
||

824 | |||

825 | end |