Project

General

Profile

Revision e7cc5186 src/modules.ml

View differences:

src/modules.ml
15 15

  
16 16
let add_symbol loc msg hashtbl name value =
17 17
 if Hashtbl.mem hashtbl name
18
 then raise (Error (loc, Already_bound_symbol msg))
18
 then raise (Error (loc, Error.Already_bound_symbol msg))
19 19
 else Hashtbl.add hashtbl name value
20 20

  
21 21
let check_symbol loc msg hashtbl name =
22 22
 if not (Hashtbl.mem hashtbl name)
23
 then raise (Error (loc, Unbound_symbol msg))
23
 then raise (Error (loc, Error.Unbound_symbol msg))
24 24
 else ()
25 25

  
26 26
let add_imported_node name value =
......
33 33
    let itf = value.top_decl_itf in
34 34
    match value'.top_decl_desc, value.top_decl_desc with
35 35
    | Node _        , ImportedNode _  when owner = owner' && itf' && (not itf) -> Hashtbl.add node_table name value
36
    | ImportedNode _, ImportedNode _            -> raise (Error (value.top_decl_loc, Already_bound_symbol ("node " ^ name)))
36
    | ImportedNode _, ImportedNode _            -> raise (Error (value.top_decl_loc, Error.Already_bound_symbol ("node " ^ name)))
37 37
    | _                                         -> assert false
38 38
  with
39 39
    Not_found                                   -> Hashtbl.add node_table name value
......
48 48
    let itf = value.top_decl_itf in
49 49
    match value'.top_decl_desc, value.top_decl_desc with
50 50
    | ImportedNode _, Node _          when owner = owner' && itf' && (not itf) -> ()
51
    | Node _        , Node _                    -> raise (Error (value.top_decl_loc, Already_bound_symbol ("node " ^ name)))
51
    | Node _        , Node _                    -> raise (Error (value.top_decl_loc, Error.Already_bound_symbol ("node " ^ name)))
52 52
    | _                                         -> assert false
53 53
  with
54 54
    Not_found                                   -> Hashtbl.add node_table name value
......
56 56

  
57 57
let add_tag loc name typ =
58 58
  if Hashtbl.mem tag_table name then
59
    raise (Error (loc, Already_bound_symbol ("enum tag " ^ name)))
59
    raise (Error (loc, Error.Already_bound_symbol ("enum tag " ^ name)))
60 60
  else Hashtbl.add tag_table name typ
61 61

  
62 62
let add_field loc name typ =
63 63
  if Hashtbl.mem field_table name then
64
    raise (Error (loc, Already_bound_symbol ("struct field " ^ name)))
64
    raise (Error (loc, Error.Already_bound_symbol ("struct field " ^ name)))
65 65
  else Hashtbl.add field_table name typ
66 66

  
67 67
let import_typedef name tydef =
......
75 75
    | Tydec_clock ty      -> import ty
76 76
    | Tydec_const c       ->
77 77
       if not (Hashtbl.mem type_table (Tydec_const c))
78
       then raise (Error (loc, Unbound_symbol ("type " ^ c)))
78
       then raise (Error (loc, Error.Unbound_symbol ("type " ^ c)))
79 79
       else ()
80 80
    | Tydec_array (c, ty) -> import ty
81 81
    | _                   -> ()
......
91 91
    let itf = value.top_decl_itf in
92 92
    match value'.top_decl_desc, value.top_decl_desc with
93 93
    | TypeDef ty', TypeDef ty when coretype_equal ty'.tydef_desc ty.tydef_desc && owner' = owner && itf' && (not itf) -> ()
94
    | TypeDef ty', TypeDef ty -> raise (Error (value.top_decl_loc, Already_bound_symbol ("type " ^ name)))
94
    | TypeDef ty', TypeDef ty -> raise (Error (value.top_decl_loc, Error.Already_bound_symbol ("type " ^ name)))
95 95
    | _       -> assert false
96 96
  with Not_found -> (import_typedef name value; Hashtbl.add type_table (Tydec_const name) value)
97 97

  
98 98
let check_type loc name =
99 99
 if not (Hashtbl.mem type_table (Tydec_const name))
100
 then raise (Error (loc, Unbound_symbol ("type " ^ name)))
100
 then raise (Error (loc, Error.Unbound_symbol ("type " ^ name)))
101 101
 else ()
102 102

  
103 103
let add_const itf name value =
......
109 109
    let itf = value.top_decl_itf in
110 110
    match value'.top_decl_desc, value.top_decl_desc with
111 111
    | Const c', Const c when c.const_value = c'.const_value && owner' = owner && itf' && (not itf) -> ()
112
    | Const c', Const c -> raise (Error (value.top_decl_loc, Already_bound_symbol ("const " ^ name)))
112
    | Const c', Const c -> raise (Error (value.top_decl_loc, Error.Already_bound_symbol ("const " ^ name)))
113 113
    | _       -> assert false
114 114
  with Not_found -> Hashtbl.add consts_table name value
115 115

  
......
124 124
  | Sys_error msg ->
125 125
    begin
126 126
      (*Format.eprintf "Error: %s@." msg;*)
127
      raise (Error (loc, Unknown_library basename))
127
      raise (Error (loc, Error.Unknown_library basename))
128 128
    end
129 129
  | Corelang.Error (_, msg) -> raise (Corelang.Error (loc, msg))
130 130

  
......
134 134
  with
135 135
  | Corelang.Error (_, err) as exc -> (
136 136
    Format.eprintf "Import error: %a%a@."
137
      Corelang.pp_error err
137
      Error.pp_error_msg err
138 138
      Location.pp_loc loc;
139 139
    raise exc
140 140
  )
......
145 145
  with
146 146
  | Corelang.Error (loc, err) as exc -> (
147 147
    Format.eprintf "Import error: %a%a@."
148
      Corelang.pp_error err
148
      Error.pp_error_msg err
149 149
      Location.pp_loc loc;
150 150
    raise exc
151 151
  )
......
170 170
  with
171 171
    Corelang.Error (loc, err) as exc -> (
172 172
      Format.eprintf "Import error: %a%a@."
173
	Corelang.pp_error err
173
	Error.pp_error_msg err
174 174
	Location.pp_loc loc;
175 175
      raise exc
176 176
    );;
......
195 195
  with
196 196
    Corelang.Error (loc, err) as exc -> (
197 197
      Format.eprintf "Import error: %a%a@."
198
	Corelang.pp_error err
198
	Error.pp_error_msg err
199 199
	Location.pp_loc loc;
200 200
      raise exc
201 201
    );;

Also available in: Unified diff