Project

General

Profile

Revision b878abe5 src/typing.ml

View differences:

src/typing.ml
136 136
    type_coretype (fun d -> ()) (Hashtbl.find type_table (Tydec_const tname))
137 137
  with Not_found -> raise (Error (Location.dummy_loc, Unbound_type tname))
138 138

  
139
(** [unify env t1 t2] unifies types [t1] and [t2]. Raises [Unify
139
(** [unify t1 t2] unifies types [t1] and [t2]. Raises [Unify
140 140
    (t1,t2)] if the types are not unifiable.*)
141 141
(* Standard destructive unification *)
142 142
let rec unify t1 t2 =
......
190 190
      end
191 191
    | _,_ -> raise (Unify (t1, t2))
192 192

  
193
(** [semi_unify t1 t2] checks whether type [t1] is an instance of type [t2]. Raises [Unify
194
    (t1,t2)] if the types are not semi-unifiable.*)
195
(* Standard destructive semi-unification *)
196
let rec semi_unify t1 t2 =
197
  let t1 = repr t1 in
198
  let t2 = repr t2 in
199
  if t1=t2 then
200
    ()
201
  else
202
    (* No type abbreviations resolution for now *)
203
    match t1.tdesc,t2.tdesc with
204
      (* This case is not mandory but will keep "older" types *)
205
    | Tvar, Tvar ->
206
        if t1.tid < t2.tid then
207
          t2.tdesc <- Tlink t1
208
        else
209
          t1.tdesc <- Tlink t2
210
    | (Tvar, _) -> raise (Unify (t1, t2))
211
    | (_,Tvar) when (not (occurs t2 t1)) ->
212
        t2.tdesc <- Tlink t1
213
    | Tarrow (t1,t2), Tarrow (t1',t2') ->
214
      begin
215
        unify t1 t1';
216
	unify t2 t2'
217
      end
218
    | Ttuple tlist1, Ttuple tlist2 ->
219
        if (List.length tlist1) <> (List.length tlist2) then
220
	  raise (Unify (t1, t2))
221
	else
222
          List.iter2 semi_unify tlist1 tlist2
223
    | Tclock _, Tstatic _
224
    | Tstatic _, Tclock _ -> raise (Unify (t1, t2))
225
    | Tclock t1', _ -> semi_unify t1' t2
226
    | _, Tclock t2' -> semi_unify t1 t2'
227
    | Tint, Tint | Tbool, Tbool | Trat, Trat
228
    | Tunivar, _ | _, Tunivar -> ()
229
    | (Tconst t, _) ->
230
      let def_t = get_type_definition t in
231
      semi_unify def_t t2
232
    | (_, Tconst t)  ->
233
      let def_t = get_type_definition t in
234
      semi_unify t1 def_t
235
    | Tenum tl, Tenum tl' when tl == tl' -> ()
236
    | Tstatic (e1, t1'), Tstatic (e2, t2')
237
    | Tarray (e1, t1'), Tarray (e2, t2') ->
238
      begin
239
	semi_unify t1' t2';
240
	Dimension.eval Basic_library.eval_env (fun c -> None) e1;
241
	Dimension.eval Basic_library.eval_env (fun c -> None) e2;
242
	Dimension.semi_unify e1 e2;
243
      end
244
    | _,_ -> raise (Unify (t1, t2))
245

  
193 246
let try_unify ty1 ty2 loc =
194 247
  try
195 248
    unify ty1 ty2

Also available in: Unified diff