Revision b616fe7a src/typing.ml
src/typing.ml | ||
---|---|---|
417 | 417 |
(* typing an application implies: |
418 | 418 |
- checking that const formal parameters match real const (maybe symbolic) arguments |
419 | 419 |
- checking type adequation between formal and real arguments |
420 |
An application may embed an homomorphic/internal function, in which case we need to split |
|
421 |
it in many calls |
|
420 | 422 |
*) |
421 | 423 |
and type_appl env in_main loc const f args = |
424 |
let args = expr_list_of_expr args in |
|
425 |
if Basic_library.is_internal_fun f && List.exists is_tuple_expr args |
|
426 |
then |
|
427 |
try |
|
428 |
let args = Utils.transpose_list (List.map expr_list_of_expr args) in |
|
429 |
Types.type_of_type_list (List.map (type_call env in_main loc const f) args) |
|
430 |
with |
|
431 |
Utils.TransposeError (l, l') -> raise (Error (loc, WrongMorphism (l, l'))) |
|
432 |
else |
|
433 |
type_call env in_main loc const f args |
|
434 |
|
|
435 |
(* type a (single) call. [args] is here a list of arguments. *) |
|
436 |
and type_call env in_main loc const f args = |
|
422 | 437 |
let tfun = type_ident env in_main loc const f in |
423 | 438 |
let tins, touts = split_arrow tfun in |
424 | 439 |
let tins = type_list_of_type tins in |
425 |
let args = expr_list_of_expr args in |
|
426 | 440 |
if List.length args <> List.length tins then |
427 | 441 |
raise (Error (loc, WrongArity (List.length args, List.length tins))) |
428 | 442 |
else |
... | ... | |
432 | 446 |
(** [type_expr env in_main expr] types expression [expr] in environment |
433 | 447 |
[env], expecting it to be [const] or not. *) |
434 | 448 |
and type_expr env in_main const expr = |
435 |
let res = |
|
449 |
let resulting_ty =
|
|
436 | 450 |
match expr.expr_desc with |
437 | 451 |
| Expr_const c -> |
438 | 452 |
let ty = type_const expr.expr_loc c in |
... | ... | |
541 | 555 |
let ty = type_expr env in_main const e in |
542 | 556 |
expr.expr_type <- ty; |
543 | 557 |
ty |
544 |
in (*Format.eprintf "typing %B %a at %a = %a@." const Printers.pp_expr expr Location.pp_loc expr.expr_loc Types.print_ty res;*) res |
|
558 |
in |
|
559 |
Log.report ~level:3 (fun fmt -> Format.fprintf fmt "Type of expr %a: %a@." Printers.pp_expr expr Types.print_ty resulting_ty); |
|
560 |
resulting_ty |
|
545 | 561 |
|
546 | 562 |
and type_branches env in_main loc const hl = |
547 | 563 |
let typ_in = new_var () in |
Also available in: Unified diff