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