| 370 |
|
|
| 371 |
open Typed |
open Typed |
| 372 |
|
|
| 373 |
|
|
| 374 |
|
let check loc t s msg = |
| 375 |
|
if not (Types.subtype t s) then raise_loc loc (Constraint (t, s, msg)) |
| 376 |
|
|
| 377 |
let rec compute_type env e = |
let rec compute_type env e = |
| 378 |
let d = compute_type' e.exp_loc env e.exp_descr in |
let d = compute_type' e.exp_loc env e.exp_descr in |
| 379 |
e.exp_typ <- Types.cup e.exp_typ d; |
e.exp_typ <- Types.cup e.exp_typ d; |
| 428 |
| Match (e,b) -> |
| Match (e,b) -> |
| 429 |
let t = compute_type env e in |
let t = compute_type env e in |
| 430 |
type_branches loc env t b |
type_branches loc env t b |
| 431 |
| Map (e,b) -> assert false |
| Map (e,b) -> |
| 432 |
|
let t = compute_type env e in |
| 433 |
|
Sequence.map (fun t -> type_branches loc env t b) t |
| 434 |
|
|
| 435 |
and type_branches loc env targ brs = |
and type_branches loc env targ brs = |
| 436 |
if Types.is_empty targ then Types.empty |
if Types.is_empty targ then Types.empty |
| 469 |
type_int_binop Intervals.add loc1 t1 loc2 t2 |
type_int_binop Intervals.add loc1 t1 loc2 t2 |
| 470 |
| ("*", [loc1,t1; loc2,t2]) -> |
| ("*", [loc1,t1; loc2,t2]) -> |
| 471 |
type_int_binop (fun i1 i2 -> Intervals.any) loc1 t1 loc2 t2 |
type_int_binop (fun i1 i2 -> Intervals.any) loc1 t1 loc2 t2 |
| 472 |
|
| ("@", [loc1,t1; loc2,t2]) -> |
| 473 |
|
check loc1 t1 Sequence.any |
| 474 |
|
"The first argument of @ must be a sequence"; |
| 475 |
|
Sequence.concat t1 t2 |
| 476 |
|
| ("flatten", [loc1,t1]) -> |
| 477 |
|
check loc1 t1 Sequence.seqseq |
| 478 |
|
"The argument of flatten must be a sequence of sequences"; |
| 479 |
|
Sequence.flatten t1 |
| 480 |
| _ -> assert false |
| _ -> assert false |
| 481 |
|
|
| 482 |
and type_int_binop f loc1 t1 loc2 t2 = |
and type_int_binop f loc1 t1 loc2 t2 = |
Parent Directory
| 
Revision Log
| 
Patch