| 399 |
|
|
| 400 |
let rec type_check env e constr precise = |
let rec type_check env e constr precise = |
| 401 |
(* Format.fprintf Format.std_formatter "constr=%a precise=%b@\n" |
(* Format.fprintf Format.std_formatter "constr=%a precise=%b@\n" |
| 402 |
Types.Print.print_descr constr precise; *) |
Types.Print.print_descr constr precise; |
| 403 |
|
*) |
| 404 |
let d = type_check' e.exp_loc env e.exp_descr constr precise in |
let d = type_check' e.exp_loc env e.exp_descr constr precise in |
| 405 |
e.exp_typ <- Types.cup e.exp_typ d; |
e.exp_typ <- Types.cup e.exp_typ d; |
| 406 |
d |
d |
| 470 |
in |
in |
| 471 |
res |
res |
| 472 |
|
|
| 473 |
|
| Map (e,b) -> |
| 474 |
|
let t = type_check env e (Sequence.star b.br_accept) true in |
| 475 |
|
|
| 476 |
|
let constr' = Sequence.approx (Types.cap Sequence.any constr) in |
| 477 |
|
let exact = Types.subtype (Sequence.star constr') constr in |
| 478 |
|
|
| 479 |
|
if exact then |
| 480 |
|
let res = type_check_branches loc env t b constr' precise in |
| 481 |
|
if precise then Sequence.star res else constr |
| 482 |
|
else |
| 483 |
|
(* Note: |
| 484 |
|
- could be more precise by integrating the decomposition |
| 485 |
|
of constr inside Sequence.map. |
| 486 |
|
*) |
| 487 |
|
let res = |
| 488 |
|
Sequence.map |
| 489 |
|
(fun t -> type_check_branches loc env t b constr' true) |
| 490 |
|
t in |
| 491 |
|
if not exact then check loc res constr ""; |
| 492 |
|
if precise then res else constr |
| 493 |
|
| Op ("@", [e1;e2]) -> |
| 494 |
|
let constr' = Sequence.star |
| 495 |
|
(Sequence.approx (Types.cap Sequence.any constr)) in |
| 496 |
|
let exact = Types.subtype constr' constr in |
| 497 |
|
if exact then |
| 498 |
|
let t1 = type_check env e1 constr' precise |
| 499 |
|
and t2 = type_check env e2 constr' precise in |
| 500 |
|
if precise then Sequence.concat t1 t2 else constr |
| 501 |
|
else |
| 502 |
|
(* Note: |
| 503 |
|
the knownledge of t1 may makes it useless to |
| 504 |
|
check t2 with 'precise' ... *) |
| 505 |
|
let t1 = type_check env e1 constr' true |
| 506 |
|
and t2 = type_check env e2 constr' true in |
| 507 |
|
let res = Sequence.concat t1 t2 in |
| 508 |
|
check loc res constr ""; |
| 509 |
|
if precise then res else constr |
| 510 |
| _ -> |
| _ -> |
| 511 |
let t : Types.descr = compute_type' loc env e in |
let t : Types.descr = compute_type' loc env e in |
| 512 |
check loc t constr ""; |
check loc t constr ""; |
Parent Directory
| 
Revision Log
| 
Patch