Project

General

Profile

Revision 12af4908 src/types.ml

View differences:

src/types.ml
39 39
  | Tarrow of type_expr * type_expr
40 40
  | Ttuple of type_expr list
41 41
  | Tenum of ident list
42
  | Tstruct of (ident * type_expr) list
42 43
  | Tarray of dim_expr * type_expr
43 44
  | Tstatic of dim_expr * type_expr (* a type carried by a dimension expression *)
44 45
  | Tlink of type_expr (* During unification, make links instead of substitutions *)
......
62 63

  
63 64
(* Pretty-print*)
64 65
open Format
65
  
66
let rec print_ty fmt ty =
66

  
67
let rec print_struct_ty_field fmt (label, ty) =
68
  fprintf fmt "%a : %a" pp_print_string label print_ty ty
69
and print_ty fmt ty =
67 70
  match ty.tdesc with
68 71
  | Tvar ->
69 72
    fprintf fmt "_%s" (name_of_type ty.tid)
......
87 90
    fprintf fmt "(%a)"
88 91
      (Utils.fprintf_list ~sep:"*" print_ty) tylist
89 92
  | Tenum taglist ->
90
    fprintf fmt "(%a)"
91
      (Utils.fprintf_list ~sep:" + " pp_print_string) taglist
93
    fprintf fmt "enum {%a }"
94
      (Utils.fprintf_list ~sep:", " pp_print_string) taglist
95
  | Tstruct fieldlist ->
96
    fprintf fmt "struct {%a }"
97
      (Utils.fprintf_list ~sep:"; " print_struct_ty_field) fieldlist
92 98
  | Tarray (e, ty) ->
93 99
    fprintf fmt "%a^%a" print_ty ty Dimension.pp_dimension e
94 100
  | Tlink ty ->
......
96 102
  | Tunivar ->
97 103
    fprintf fmt "'%s" (name_of_type ty.tid)
98 104

  
99
let rec print_node_ty fmt ty =
105
let rec print_node_struct_ty_field fmt (label, ty) =
106
  fprintf fmt "%a : %a" pp_print_string label print_node_ty ty
107
and print_node_ty fmt ty =
100 108
  match ty.tdesc with
101 109
  | Tint ->
102 110
    fprintf fmt "int"
......
118 126
    fprintf fmt "(%a)"
119 127
      (Utils.fprintf_list ~sep:"*" print_ty) tylist
120 128
  | Tenum taglist ->
121
    fprintf fmt "(%a)"
122
      (Utils.fprintf_list ~sep:" + " pp_print_string) taglist
129
    fprintf fmt "enum {%a }"
130
      (Utils.fprintf_list ~sep:", " pp_print_string) taglist
131
  | Tstruct fieldlist ->
132
    fprintf fmt "struct {%a }"
133
      (Utils.fprintf_list ~sep:"; " print_node_struct_ty_field) fieldlist
123 134
  | Tarray (e, ty) ->
124 135
    fprintf fmt "%a^%a" print_ty ty Dimension.pp_dimension e
125 136
  | Tlink ty ->
......
172 183
  | t -> t
173 184

  
174 185
let get_static_value ty =
175
 match (repr ty).tdesc with
176
 | Tstatic (d, _) -> Some d
177
 | _              -> None
186
  match (repr ty).tdesc with
187
  | Tstatic (d, _) -> Some d
188
  | _              -> None
189

  
190
let get_field_type ty label =
191
  match (repr ty).tdesc with
192
  | Tstruct fl -> (try Some (List.assoc label fl) with Not_found -> None)
193
  | _          -> None
178 194

  
179 195
let is_clock_type ty =
180 196
 match (repr ty).tdesc with
......
263 279
  | Tclock ty -> is_polymorphic ty
264 280
  | Tarrow (ty1,ty2) -> (is_polymorphic ty1) || (is_polymorphic ty2)
265 281
  | Ttuple tl -> List.exists (fun t -> is_polymorphic t) tl
282
  | Tstruct fl -> List.exists (fun (_, t) -> is_polymorphic t) fl
266 283
  | Tlink t' -> is_polymorphic t'
267 284
  | Tarray (d, ty)
268 285
  | Tstatic (d, ty) -> Dimension.is_polymorphic d || is_polymorphic ty

Also available in: Unified diff