Revision 6cbbe1c1
Added by LĂ©lio Brun almost 2 years ago
src/typing.ml  

208  208 
let rec unif t1 t2 = 
209  209 
let t1 = repr t1 in 
210  210 
let t2 = repr t2 in 
211 
if t1==t2 then


211 
if t1 == t2 then


212  212 
() 
213  213 
else 
214  214 
match t1.tdesc,t2.tdesc with 
215  215 
(* strictly subtyping cases first *) 
216  216 
 _ , Tclock t2 when sub && (get_clock_base_type t1 = None) > 
217 
unif t1 t2


217 
unif t1 t2


218  218 
 _ , Tstatic (_, t2) when sub && (get_static_value t1 = None) > 
219 
unif t1 t2


219 
unif t1 t2


220  220 
(* This case is not mandatory but will keep "older" types *) 
221  221 
 Tvar, Tvar > 
222 
if t1.tid < t2.tid then


223 
t2.tdesc < Tlink t1


224 
else


225 
t1.tdesc < Tlink t2


222 
if t1.tid < t2.tid then 

223 
t2.tdesc < Tlink t1 

224 
else 

225 
t1.tdesc < Tlink t2 

226  226 
 Tvar, _ when (not semi) && (not (occurs t1 t2)) > 
227 
t1.tdesc < Tlink t2


227 
t1.tdesc < Tlink t2 

228  228 
 _, Tvar when (not (occurs t2 t1)) > 
229 
t2.tdesc < Tlink t1


229 
t2.tdesc < Tlink t1 

230  230 
 Tarrow (t1,t2), Tarrow (t1',t2') > 
231 
begin


232 
unif t2 t2';


233 
unif t1' t1


234 
end


231 
begin


232 
unif t2 t2'; 

233 
unif t1' t1


234 
end


235  235 
 Ttuple tl, Ttuple tl' when List.length tl = List.length tl' > 
236 
List.iter2 unif tl tl'


236 
List.iter2 unif tl tl'


237  237 
 Ttuple [t1] , _ > unif t1 t2 
238  238 
 _ , Ttuple [t2] > unif t1 t2 
239  239 
 Tstruct fl, Tstruct fl' when List.map fst fl = List.map fst fl' > 
240 
List.iter2 (fun (_, t) (_, t') > unif t t') fl fl'


240 
List.iter2 (fun (_, t) (_, t') > unif t t') fl fl'


241  241 
 Tclock _, Tstatic _ 
242 
 Tstatic _, Tclock _ > raise (Unify (t1, t2))


242 
 Tstatic _, Tclock _ > raise (Unify (t1, t2)) 

243  243 
 Tclock t1', Tclock t2' > unif t1' t2' 
244 
 Tbasic t1, Tbasic t2 when t1 == t2 > ()


244 
(*  Tbasic t1, Tbasic t2 when t1 == t2 > () *)


245  245 
 Tunivar, _  _, Tunivar > () 
246  246 
 (Tconst t, _) > 
247 
let def_t = get_type_definition t in


248 
unif def_t t2


247 
let def_t = get_type_definition t in


248 
unif def_t t2


249  249 
 (_, Tconst t) > 
250 
let def_t = get_type_definition t in


251 
unif t1 def_t


250 
let def_t = get_type_definition t in


251 
unif t1 def_t


252  252 
 Tenum tl, Tenum tl' when tl == tl' > () 
253  253 
 Tstatic (e1, t1'), Tstatic (e2, t2') 
254 
 Tarray (e1, t1'), Tarray (e2, t2') >


255 
let eval_const =


256 
if semi


257 
then (fun c > Some (Dimension.mkdim_ident Location.dummy_loc c))


258 
else (fun _ > None) in


259 
begin


260 
unif t1' t2';


261 
Dimension.eval Basic_library.eval_dim_env eval_const e1;


262 
Dimension.eval Basic_library.eval_dim_env eval_const e2;


263 
Dimension.unify ~semi:semi e1 e2;


264 
end


254 
 Tarray (e1, t1'), Tarray (e2, t2') > 

255 
let eval_const =


256 
if semi


257 
then (fun c > Some (Dimension.mkdim_ident Location.dummy_loc c))


258 
else (fun _ > None) in


259 
begin


260 
unif t1' t2';


261 
Dimension.eval Basic_library.eval_dim_env eval_const e1;


262 
Dimension.eval Basic_library.eval_dim_env eval_const e2;


263 
Dimension.unify ~semi:semi e1 e2;


264 
end


265  265 
(* Special cases for machine_types. Rules to unify static types infered 
266 
for numerical constants with non static ones for variables with


267 
possible machine types *)


266 
for numerical constants with non static ones for variables with


267 
possible machine types *)


268  268 
 Tbasic bt1, Tbasic bt2 when BasicT.is_unifiable bt1 bt2 > BasicT.unify bt1 bt2 
269  269 
 _,_ > raise (Unify (t1, t2)) 
270  270 
in unif t1 t2 
...  ...  
274  274 
try 
275  275 
unify ~sub:sub ~semi:semi ty1 ty2 
276  276 
with 
277 
 Unify _ >


277 
 Unify (t1', t2') >


278  278 
raise (Error (loc, Type_clash (ty1,ty2))) 
279  279 
 Dimension.Unify _ > 
280  280 
raise (Error (loc, Type_clash (ty1,ty2))) 
Also available in: Unified diff
start again with spec representation