## lustrec / src / types.ml @ e8250987

History | View | Annotate | Download (16.5 KB)

1 | a2d97a3e | ploc | (********************************************************************) |
---|---|---|---|

2 | (* *) |
||

3 | (* The LustreC compiler toolset / The LustreC Development Team *) |
||

4 | (* Copyright 2012 - -- ONERA - CNRS - INPT - LIFL *) |
||

5 | (* *) |
||

6 | (* LustreC is free software, distributed WITHOUT ANY WARRANTY *) |
||

7 | (* under the terms of the GNU Lesser General Public License *) |
||

8 | (* version 2.1. *) |
||

9 | (* *) |
||

10 | (* This file was originally from the Prelude compiler *) |
||

11 | (* *) |
||

12 | (********************************************************************) |
||

13 | 22fe1c93 | ploc | |

14 | (** Types definitions and a few utility functions on types. *) |
||

15 | open Utils |
||

16 | open Dimension |
||

17 | |||

18 | 66359a5e | ploc | module type BASIC_TYPES = |

19 | sig |
||

20 | type t |
||

21 | val pp: Format.formatter -> t -> unit |
||

22 | val pp_c: Format.formatter -> t -> unit |
||

23 | val is_scalar_type: t -> bool |
||

24 | val is_numeric_type: t -> bool |
||

25 | val is_int_type: t -> bool |
||

26 | val is_real_type: t -> bool |
||

27 | val is_bool_type: t -> bool |
||

28 | val is_dimension_type: t -> bool |
||

29 | val type_int_builder: t |
||

30 | val type_real_builder: t |
||

31 | val type_bool_builder: t |
||

32 | val type_string_builder: t |
||

33 | val unify: t -> t -> unit |
||

34 | val is_unifiable: t -> t -> bool |
||

35 | end |
||

36 | |||

37 | module Basic = |
||

38 | struct |
||

39 | type t = |
||

40 | | Tstring |
||

41 | | Tint |
||

42 | | Treal |
||

43 | | Tbool |
||

44 | | Trat (* Actually unused for now. Only place where it can appear is |
||

45 | in a clock declaration *) |
||

46 | |||

47 | let type_string_builder = Tstring |
||

48 | let type_int_builder = Tint |
||

49 | let type_real_builder = Treal |
||

50 | let type_bool_builder = Tbool |
||

51 | |||

52 | open Format |
||

53 | let pp fmt t = |
||

54 | match t with |
||

55 | | Tint -> |
||

56 | fprintf fmt "int" |
||

57 | | Treal -> |
||

58 | fprintf fmt "real" |
||

59 | | Tstring -> |
||

60 | fprintf fmt "string" |
||

61 | | Tbool -> |
||

62 | fprintf fmt "bool" |
||

63 | | Trat -> |
||

64 | fprintf fmt "rat" |
||

65 | |||

66 | let pp_c = pp |
||

67 | |||

68 | let is_scalar_type t = |
||

69 | match t with |
||

70 | | Tbool |
||

71 | | Tint |
||

72 | | Treal -> true |
||

73 | | _ -> false |
||

74 | |||

75 | |||

76 | let is_numeric_type t = |
||

77 | match t with |
||

78 | | Tint |
||

79 | | Treal -> true |
||

80 | | _ -> false |
||

81 | |||

82 | let is_int_type t = t = Tint |
||

83 | let is_real_type t = t = Treal |
||

84 | let is_bool_type t = t = Tbool |
||

85 | |||

86 | let is_dimension_type t = |
||

87 | match t with |
||

88 | | Tint |
||

89 | | Tbool -> true |
||

90 | | _ -> false |
||

91 | |||

92 | let is_unifiable b1 b2 = b1 == b2 |
||

93 | let unify _ _ = () |
||

94 | end |
||

95 | |||

96 | |||

97 | |||

98 | module Make(BasicT : BASIC_TYPES) = |
||

99 | struct |
||

100 | |||

101 | module BasicT = BasicT |
||

102 | type basic_type = BasicT.t |
||

103 | type type_expr = |
||

104 | 22fe1c93 | ploc | {mutable tdesc: type_desc; |

105 | tid: int} |
||

106 | 66359a5e | ploc | and type_desc = |

107 | | Tconst of ident (* type constant *) |
||

108 | | Tbasic of basic_type |
||

109 | | Tclock of type_expr (* A type expression explicitely tagged as carrying a clock *) |
||

110 | | Tarrow of type_expr * type_expr |
||

111 | | Ttuple of type_expr list |
||

112 | | Tenum of ident list |
||

113 | | Tstruct of (ident * type_expr) list |
||

114 | | Tarray of dim_expr * type_expr |
||

115 | | Tstatic of dim_expr * type_expr (* a type carried by a dimension expression *) |
||

116 | | Tlink of type_expr (* During unification, make links instead of substitutions *) |
||

117 | | Tvar (* Monomorphic type variable *) |
||

118 | | Tunivar (* Polymorphic type variable *) |
||

119 | |||

120 | (* {mutable tdesc: type_desc; *) |
||

121 | (* tid: int} *) |
||

122 | |||

123 | (* and type_desc = *) |
||

124 | (* | Tconst of ident (\* type constant *\) *) |
||

125 | (* | Tbasic of BasicT.t *) |
||

126 | (* | Tclock of type_expr (\* A type expression explicitely tagged as carrying a clock *\) *) |
||

127 | (* | Tarrow of type_expr * type_expr *) |
||

128 | (* | Ttuple of type_expr list *) |
||

129 | (* | Tenum of ident list *) |
||

130 | (* | Tstruct of (ident * type_expr) list *) |
||

131 | (* | Tarray of dim_expr * type_expr *) |
||

132 | (* | Tstatic of dim_expr * type_expr (\* a type carried by a dimension expression *\) *) |
||

133 | (* | Tlink of type_expr (\* During unification, make links instead of substitutions *\) *) |
||

134 | (* | Tvar (\* Monomorphic type variable *\) *) |
||

135 | (* | Tunivar (\* Polymorphic type variable *\) *) |
||

136 | |||

137 | type error = |
||

138 | Unbound_value of ident |
||

139 | | Already_bound of ident |
||

140 | | Already_defined of ident |
||

141 | | Undefined_var of ISet.t |
||

142 | | Declared_but_undefined of ident |
||

143 | | Unbound_type of ident |
||

144 | | Not_a_dimension |
||

145 | | Not_a_constant |
||

146 | | Assigned_constant of ident |
||

147 | | WrongArity of int * int |
||

148 | | WrongMorphism of int * int |
||

149 | | Type_mismatch of ident |
||

150 | | Type_clash of type_expr * type_expr |
||

151 | | Poly_imported_node of ident |
||

152 | 22fe1c93 | ploc | |

153 | exception Unify of type_expr * type_expr |
||

154 | exception Error of Location.t * error |
||

155 | |||

156 | 66359a5e | ploc | let mk_basic t = Tbasic t |

157 | |||

158 | |||

159 | 22fe1c93 | ploc | (* Pretty-print*) |

160 | open Format |
||

161 | 12af4908 | xthirioux | |

162 | 66359a5e | ploc | let rec print_struct_ty_field pp_basic fmt (label, ty) = |

163 | fprintf fmt "%a : %a" pp_print_string label (print_ty_param pp_basic) ty |
||

164 | and print_ty_param pp_basic fmt ty = |
||

165 | let print_ty = print_ty_param pp_basic in |
||

166 | 22fe1c93 | ploc | match ty.tdesc with |

167 | | Tvar -> |
||

168 | fprintf fmt "_%s" (name_of_type ty.tid) |
||

169 | 66359a5e | ploc | | Tbasic t -> pp_basic fmt t |

170 | 22fe1c93 | ploc | | Tclock t -> |

171 | fprintf fmt "%a clock" print_ty t |
||

172 | | Tstatic (d, t) -> |
||

173 | fprintf fmt "(%a:%a)" Dimension.pp_dimension d print_ty t |
||

174 | | Tconst t -> |
||

175 | fprintf fmt "%s" t |
||

176 | | Tarrow (ty1,ty2) -> |
||

177 | 719f9992 | xthirioux | fprintf fmt "%a -> %a" print_ty ty1 print_ty ty2 |

178 | 22fe1c93 | ploc | | Ttuple tylist -> |

179 | fprintf fmt "(%a)" |
||

180 | e39f5319 | xthirioux | (Utils.fprintf_list ~sep:" * " print_ty) tylist |

181 | 22fe1c93 | ploc | | Tenum taglist -> |

182 | 12af4908 | xthirioux | fprintf fmt "enum {%a }" |

183 | (Utils.fprintf_list ~sep:", " pp_print_string) taglist |
||

184 | | Tstruct fieldlist -> |
||

185 | fprintf fmt "struct {%a }" |
||

186 | 66359a5e | ploc | (Utils.fprintf_list ~sep:"; " (print_struct_ty_field pp_basic)) fieldlist |

187 | 22fe1c93 | ploc | | Tarray (e, ty) -> |

188 | fprintf fmt "%a^%a" print_ty ty Dimension.pp_dimension e |
||

189 | | Tlink ty -> |
||

190 | print_ty fmt ty |
||

191 | | Tunivar -> |
||

192 | fprintf fmt "'%s" (name_of_type ty.tid) |
||

193 | |||

194 | 66359a5e | ploc | let print_ty = print_ty_param BasicT.pp |

195 | |||

196 | |||

197 | 12af4908 | xthirioux | let rec print_node_struct_ty_field fmt (label, ty) = |

198 | fprintf fmt "%a : %a" pp_print_string label print_node_ty ty |
||

199 | and print_node_ty fmt ty = |
||

200 | 7291cb80 | xthirioux | match ty.tdesc with |

201 | 96f5fe18 | xthirioux | | Tvar -> begin |

202 | 66359a5e | ploc | (*Format.eprintf "DEBUG:Types.print_node@.";*) |

203 | 96f5fe18 | xthirioux | fprintf fmt "_%s" (name_of_type ty.tid) |

204 | 66359a5e | ploc | end |

205 | | Tbasic t -> BasicT.pp fmt t |
||

206 | 7291cb80 | xthirioux | | Tclock t -> |

207 | 6afa892a | xthirioux | fprintf fmt "%a clock" print_node_ty t |

208 | 7291cb80 | xthirioux | | Tstatic (_, t) -> |

209 | fprintf fmt "%a" print_node_ty t |
||

210 | | Tconst t -> |
||

211 | fprintf fmt "%s" t |
||

212 | | Tarrow (ty1,ty2) -> |
||

213 | 6afa892a | xthirioux | fprintf fmt "%a -> %a" print_node_ty ty1 print_node_ty ty2 |

214 | 7291cb80 | xthirioux | | Ttuple tylist -> |

215 | fprintf fmt "(%a)" |
||

216 | 6afa892a | xthirioux | (Utils.fprintf_list ~sep:"*" print_node_ty) tylist |

217 | 7291cb80 | xthirioux | | Tenum taglist -> |

218 | 12af4908 | xthirioux | fprintf fmt "enum {%a }" |

219 | (Utils.fprintf_list ~sep:", " pp_print_string) taglist |
||

220 | | Tstruct fieldlist -> |
||

221 | fprintf fmt "struct {%a }" |
||

222 | (Utils.fprintf_list ~sep:"; " print_node_struct_ty_field) fieldlist |
||

223 | 7291cb80 | xthirioux | | Tarray (e, ty) -> |

224 | 6afa892a | xthirioux | fprintf fmt "%a^%a" print_node_ty ty Dimension.pp_dimension e |

225 | 7291cb80 | xthirioux | | Tlink ty -> |

226 | 6afa892a | xthirioux | print_node_ty fmt ty |

227 | 7291cb80 | xthirioux | | Tunivar -> |

228 | fprintf fmt "'%s" (name_of_type ty.tid) |
||

229 | |||

230 | 22fe1c93 | ploc | let pp_error fmt = function |

231 | | Unbound_value id -> |
||

232 | fprintf fmt "Unknown value %s@." id |
||

233 | | Unbound_type id -> |
||

234 | fprintf fmt "Unknown type %s@." id |
||

235 | | Already_bound id -> |
||

236 | fprintf fmt "%s is already declared@." id |
||

237 | | Already_defined id -> |
||

238 | fprintf fmt "Multiple definitions of variable %s@." id |
||

239 | | Not_a_constant -> |
||

240 | fprintf fmt "This expression is not a constant@." |
||

241 | 6afa892a | xthirioux | | Assigned_constant id -> |

242 | fprintf fmt "The constant %s cannot be assigned@." id |
||

243 | 22fe1c93 | ploc | | Not_a_dimension -> |

244 | fprintf fmt "This expression is not a valid dimension@." |
||

245 | | WrongArity (ar1, ar2) -> |
||

246 | fprintf fmt "Expecting %d argument(s), found %d@." ar1 ar2 |
||

247 | b616fe7a | xthirioux | | WrongMorphism (ar1, ar2) -> |

248 | fprintf fmt "Expecting %d argument(s) for homomorphic extension, found %d@." ar1 ar2 |
||

249 | b1655a21 | xthirioux | | Type_mismatch id -> |

250 | fprintf fmt "Definition and declaration of type %s don't agree@." id |
||

251 | ec433d69 | xthirioux | | Undefined_var vset -> |

252 | 22fe1c93 | ploc | fprintf fmt "No definition provided for variable(s): %a@." |

253 | (Utils.fprintf_list ~sep:"," pp_print_string) |
||

254 | ec433d69 | xthirioux | (ISet.elements vset) |

255 | 96f5fe18 | xthirioux | | Declared_but_undefined id -> |

256 | ef34b4ae | xthirioux | fprintf fmt "%s is declared but not defined@." id |

257 | 22fe1c93 | ploc | | Type_clash (ty1,ty2) -> |

258 | Utils.reset_names (); |
||

259 | fprintf fmt "Expected type %a, got type %a@." print_ty ty1 print_ty ty2 |
||

260 | | Poly_imported_node id -> |
||

261 | fprintf fmt "Imported nodes cannot have a polymorphic type@." |
||

262 | |||

263 | |||

264 | let new_id = ref (-1) |
||

265 | |||

266 | 04a63d25 | xthirioux | let rec bottom = |

267 | { tdesc = Tlink bottom; tid = -666 } |
||

268 | |||

269 | 22fe1c93 | ploc | let new_ty desc = |

270 | incr new_id; {tdesc = desc; tid = !new_id } |
||

271 | |||

272 | let new_var () = |
||

273 | new_ty Tvar |
||

274 | |||

275 | let new_univar () = |
||

276 | new_ty Tunivar |
||

277 | |||

278 | let rec repr = |
||

279 | function |
||

280 | {tdesc = Tlink t'} -> |
||

281 | repr t' |
||

282 | | t -> t |
||

283 | |||

284 | let get_static_value ty = |
||

285 | 12af4908 | xthirioux | match (repr ty).tdesc with |

286 | | Tstatic (d, _) -> Some d |
||

287 | | _ -> None |
||

288 | |||

289 | let get_field_type ty label = |
||

290 | match (repr ty).tdesc with |
||

291 | | Tstruct fl -> (try Some (List.assoc label fl) with Not_found -> None) |
||

292 | | _ -> None |
||

293 | 22fe1c93 | ploc | |

294 | 66359a5e | ploc | let rec is_static_type ty = |

295 | match (repr ty).tdesc with |
||

296 | | Tstatic (_, ty) -> true |
||

297 | | _ -> false |
||

298 | |||

299 | 04a63d25 | xthirioux | let rec is_scalar_type ty = |

300 | match (repr ty).tdesc with |
||

301 | | Tstatic (_, ty) -> is_scalar_type ty |
||

302 | 66359a5e | ploc | | Tbasic t -> BasicT.is_scalar_type t |

303 | 04a63d25 | xthirioux | | _ -> false |

304 | |||

305 | let rec is_numeric_type ty = |
||

306 | 6afa892a | xthirioux | match (repr ty).tdesc with |

307 | 04a63d25 | xthirioux | | Tstatic (_, ty) -> is_numeric_type ty |

308 | 66359a5e | ploc | | Tbasic t -> BasicT.is_numeric_type t |

309 | 6afa892a | xthirioux | | _ -> false |

310 | 66359a5e | ploc | |

311 | 04a63d25 | xthirioux | let rec is_real_type ty = |

312 | match (repr ty).tdesc with |
||

313 | | Tstatic (_, ty) -> is_real_type ty |
||

314 | 66359a5e | ploc | | Tbasic t -> BasicT.is_real_type t |

315 | | _ -> false |
||

316 | |||

317 | let rec is_int_type ty = |
||

318 | match (repr ty).tdesc with |
||

319 | | Tstatic (_, ty) -> is_int_type ty |
||

320 | | Tbasic t -> BasicT.is_int_type t |
||

321 | 04a63d25 | xthirioux | | _ -> false |

322 | |||

323 | let rec is_bool_type ty = |
||

324 | 6afa892a | xthirioux | match (repr ty).tdesc with |

325 | 04a63d25 | xthirioux | | Tstatic (_, ty) -> is_bool_type ty |

326 | 66359a5e | ploc | | Tbasic t -> BasicT.is_bool_type t |

327 | 6afa892a | xthirioux | | _ -> false |

328 | |||

329 | 3c3414c5 | ploc | let rec is_const_type ty c = |

330 | match (repr ty).tdesc with |
||

331 | | Tstatic (_, ty) -> is_const_type ty c |
||

332 | | Tconst c' -> c = c' |
||

333 | | _ -> false |
||

334 | |||

335 | 6afa892a | xthirioux | let get_clock_base_type ty = |

336 | 8f1c7e91 | xthirioux | match (repr ty).tdesc with |

337 | 6afa892a | xthirioux | | Tclock ty -> Some ty |

338 | | _ -> None |
||

339 | 8f1c7e91 | xthirioux | |

340 | e3a4e911 | xthirioux | let unclock_type ty = |

341 | let ty = repr ty in |
||

342 | match ty.tdesc with |
||

343 | | Tclock ty' -> ty' |
||

344 | | _ -> ty |
||

345 | |||

346 | 22fe1c93 | ploc | let rec is_dimension_type ty = |

347 | match (repr ty).tdesc with |
||

348 | 66359a5e | ploc | | Tbasic t -> BasicT.is_dimension_type t |

349 | 22fe1c93 | ploc | | Tclock ty' |

350 | | Tstatic (_, ty') -> is_dimension_type ty' |
||

351 | | _ -> false |
||

352 | |||

353 | b616fe7a | xthirioux | let dynamic_type ty = |

354 | 22fe1c93 | ploc | let ty = repr ty in |

355 | match ty.tdesc with |
||

356 | | Tstatic (_, ty') -> ty' |
||

357 | | _ -> ty |
||

358 | |||

359 | b616fe7a | xthirioux | let is_tuple_type ty = |

360 | match (repr ty).tdesc with |
||

361 | | Ttuple _ -> true |
||

362 | | _ -> false |
||

363 | |||

364 | 22fe1c93 | ploc | let map_tuple_type f ty = |

365 | let ty = dynamic_type ty in |
||

366 | match ty.tdesc with |
||

367 | | (Ttuple ty_list) -> { ty with tdesc = Ttuple (List.map f ty_list) } |
||

368 | | _ -> f ty |
||

369 | b174e673 | xthirioux | |

370 | 8a183477 | xthirioux | let rec is_struct_type ty = |

371 | b174e673 | xthirioux | match (repr ty).tdesc with |

372 | | Tstruct _ -> true |
||

373 | 8a183477 | xthirioux | | Tstatic (_, ty') -> is_struct_type ty' |

374 | b174e673 | xthirioux | | _ -> false |

375 | |||

376 | 2d179f5b | xthirioux | let struct_field_type ty field = |

377 | match (dynamic_type ty).tdesc with |
||

378 | | Tstruct fields -> |
||

379 | (try |
||

380 | List.assoc field fields |
||

381 | with Not_found -> assert false) |
||

382 | | _ -> assert false |
||

383 | |||

384 | 22fe1c93 | ploc | let rec is_array_type ty = |

385 | match (repr ty).tdesc with |
||

386 | | Tarray _ -> true |
||

387 | b174e673 | xthirioux | | Tstatic (_, ty') -> is_array_type ty' (* looks strange !? *) |

388 | 22fe1c93 | ploc | | _ -> false |

389 | |||

390 | let array_type_dimension ty = |
||

391 | match (dynamic_type ty).tdesc with |
||

392 | | Tarray (d, _) -> d |
||

393 | fc886259 | xthirioux | | _ -> (Format.eprintf "internal error: Types.array_type_dimension %a@." print_ty ty; assert false) |

394 | 22fe1c93 | ploc | |

395 | let rec array_type_multi_dimension ty = |
||

396 | match (dynamic_type ty).tdesc with |
||

397 | | Tarray (d, ty') -> d :: array_type_multi_dimension ty' |
||

398 | | _ -> [] |
||

399 | |||

400 | let array_element_type ty = |
||

401 | match (dynamic_type ty).tdesc with |
||

402 | | Tarray (_, ty') -> ty' |
||

403 | fc886259 | xthirioux | | _ -> (Format.eprintf "internal error: Types.array_element_type %a@." print_ty ty; assert false) |

404 | 22fe1c93 | ploc | |

405 | let rec array_base_type ty = |
||

406 | let ty = repr ty in |
||

407 | match ty.tdesc with |
||

408 | | Tarray (_, ty') |
||

409 | | Tstatic (_, ty') -> array_base_type ty' |
||

410 | | _ -> ty |
||

411 | |||

412 | b174e673 | xthirioux | let is_address_type ty = |

413 | 04a63d25 | xthirioux | is_array_type ty || is_struct_type ty || (is_real_type ty && !Options.mpfr) |

414 | b174e673 | xthirioux | |

415 | 22fe1c93 | ploc | let rec is_generic_type ty = |

416 | match (dynamic_type ty).tdesc with |
||

417 | | Tarray (d, ty') -> |
||

418 | (not (Dimension.is_dimension_const d)) || (is_generic_type ty') |
||

419 | | _ -> false |
||

420 | |||

421 | (** Splits [ty] into the [lhs,rhs] of an arrow type. Expects an arrow type |
||

422 | (ensured by language syntax) *) |
||

423 | let rec split_arrow ty = |
||

424 | match (repr ty).tdesc with |
||

425 | | Tarrow (tin,tout) -> tin,tout |
||

426 | | Tstatic (_, ty') -> split_arrow ty' |
||

427 | (* Functions are not first order, I don't think the var case |
||

428 | needs to be considered here *) |
||

429 | 870420a0 | ploc | | _ -> Format.eprintf "type %a is not a map@.Unable to split@.@?" print_ty ty; assert false |

430 | 22fe1c93 | ploc | |

431 | (** Returns the type corresponding to a type list. *) |
||

432 | let type_of_type_list tyl = |
||

433 | if (List.length tyl) > 1 then |
||

434 | new_ty (Ttuple tyl) |
||

435 | else |
||

436 | List.hd tyl |
||

437 | |||

438 | 04a63d25 | xthirioux | let rec type_list_of_type ty = |

439 | 22fe1c93 | ploc | match (repr ty).tdesc with |

440 | 04a63d25 | xthirioux | | Tstatic (_, ty) -> type_list_of_type ty |

441 | | Ttuple tl -> tl |
||

442 | | _ -> [ty] |
||

443 | 22fe1c93 | ploc | |

444 | (** [is_polymorphic ty] returns true if [ty] is polymorphic. *) |
||

445 | let rec is_polymorphic ty = |
||

446 | match ty.tdesc with |
||

447 | 66359a5e | ploc | | Tenum _ | Tvar | Tbasic _ | Tconst _ -> false |

448 | 22fe1c93 | ploc | | Tclock ty -> is_polymorphic ty |

449 | | Tarrow (ty1,ty2) -> (is_polymorphic ty1) || (is_polymorphic ty2) |
||

450 | | Ttuple tl -> List.exists (fun t -> is_polymorphic t) tl |
||

451 | 12af4908 | xthirioux | | Tstruct fl -> List.exists (fun (_, t) -> is_polymorphic t) fl |

452 | 22fe1c93 | ploc | | Tlink t' -> is_polymorphic t' |

453 | | Tarray (d, ty) |
||

454 | | Tstatic (d, ty) -> Dimension.is_polymorphic d || is_polymorphic ty |
||

455 | | Tunivar -> true |
||

456 | |||

457 | |||

458 | let mktyptuple nb typ = |
||

459 | let array = Array.make nb typ in |
||

460 | Ttuple (Array.to_list array) |
||

461 | 66359a5e | ploc | |

462 | let type_desc t = t.tdesc |
||

463 | |||

464 | |||

465 | |||

466 | let type_int = mk_basic BasicT.type_int_builder |
||

467 | let type_real = mk_basic BasicT.type_real_builder |
||

468 | let type_bool = mk_basic BasicT.type_bool_builder |
||

469 | let type_string = mk_basic BasicT.type_string_builder |
||

470 | 333e3a25 | ploc | |

471 | 66359a5e | ploc | end |

472 | |||

473 | |||

474 | module type S = |
||

475 | sig |
||

476 | module BasicT: BASIC_TYPES |
||

477 | type basic_type = BasicT.t |
||

478 | type type_expr = |
||

479 | {mutable tdesc: type_desc; |
||

480 | tid: int} |
||

481 | and type_desc = |
||

482 | | Tconst of ident (* type constant *) |
||

483 | | Tbasic of basic_type |
||

484 | | Tclock of type_expr (* A type expression explicitely tagged as carrying a clock *) |
||

485 | | Tarrow of type_expr * type_expr |
||

486 | | Ttuple of type_expr list |
||

487 | | Tenum of ident list |
||

488 | | Tstruct of (ident * type_expr) list |
||

489 | | Tarray of dim_expr * type_expr |
||

490 | | Tstatic of dim_expr * type_expr (* a type carried by a dimension expression *) |
||

491 | | Tlink of type_expr (* During unification, make links instead of substitutions *) |
||

492 | | Tvar (* Monomorphic type variable *) |
||

493 | | Tunivar (* Polymorphic type variable *) |
||

494 | |||

495 | type error = |
||

496 | Unbound_value of ident |
||

497 | | Already_bound of ident |
||

498 | | Already_defined of ident |
||

499 | | Undefined_var of ISet.t |
||

500 | | Declared_but_undefined of ident |
||

501 | | Unbound_type of ident |
||

502 | | Not_a_dimension |
||

503 | | Not_a_constant |
||

504 | | Assigned_constant of ident |
||

505 | | WrongArity of int * int |
||

506 | | WrongMorphism of int * int |
||

507 | | Type_mismatch of ident |
||

508 | | Type_clash of type_expr * type_expr |
||

509 | | Poly_imported_node of ident |
||

510 | |||

511 | exception Unify of type_expr * type_expr |
||

512 | exception Error of Location.t * error |
||

513 | |||

514 | val is_real_type: type_expr -> bool |
||

515 | val is_int_type: type_expr -> bool |
||

516 | val is_bool_type: type_expr -> bool |
||

517 | 3c3414c5 | ploc | val is_const_type: type_expr -> ident -> bool |

518 | 66359a5e | ploc | val is_static_type: type_expr -> bool |

519 | val is_array_type: type_expr -> bool |
||

520 | val is_dimension_type: type_expr -> bool |
||

521 | val is_address_type: type_expr -> bool |
||

522 | val is_generic_type: type_expr -> bool |
||

523 | val print_ty: Format.formatter -> type_expr -> unit |
||

524 | val repr: type_expr -> type_expr |
||

525 | val dynamic_type: type_expr -> type_expr |
||

526 | val type_desc: type_expr -> type_desc |
||

527 | val new_var: unit -> type_expr |
||

528 | val new_univar: unit -> type_expr |
||

529 | val new_ty: type_desc -> type_expr |
||

530 | val type_int: type_desc |
||

531 | val type_real: type_desc |
||

532 | val type_bool: type_desc |
||

533 | val type_string: type_desc |
||

534 | val array_element_type: type_expr -> type_expr |
||

535 | val type_list_of_type: type_expr -> type_expr list |
||

536 | val print_node_ty: Format.formatter -> type_expr -> unit |
||

537 | val get_clock_base_type: type_expr -> type_expr option |
||

538 | val get_static_value: type_expr -> Dimension.dim_expr option |
||

539 | val is_tuple_type: type_expr -> bool |
||

540 | val type_of_type_list: type_expr list -> type_expr |
||

541 | val split_arrow: type_expr -> type_expr * type_expr |
||

542 | val unclock_type: type_expr -> type_expr |
||

543 | val bottom: type_expr |
||

544 | val map_tuple_type: (type_expr -> type_expr) -> type_expr -> type_expr |
||

545 | val array_base_type: type_expr -> type_expr |
||

546 | val array_type_dimension: type_expr -> Dimension.dim_expr |
||

547 | val pp_error: Format.formatter -> error -> unit |
||

548 | val struct_field_type: type_expr -> ident -> type_expr |
||

549 | val array_type_multi_dimension: type_expr -> Dimension.dim_expr list |
||

550 | end (* with type type_expr = BasicT.t type_expr_gen *) |
||

551 | |||

552 | module type Sbasic = S with type BasicT.t = Basic.t |
||

553 | |||

554 | module Main : Sbasic = Make (Basic) |
||

555 | include Main |
||

556 | 22fe1c93 | ploc | |

557 | |||

558 | (* Local Variables: *) |
||

559 | (* compile-command:"make -C .." *) |
||

560 | (* End: *) |