diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/type_check.ml | 38 |
1 files changed, 35 insertions, 3 deletions
diff --git a/src/type_check.ml b/src/type_check.ml index 776f9d78..ff56a8f0 100644 --- a/src/type_check.ml +++ b/src/type_check.ml @@ -2024,6 +2024,24 @@ let replace_env env = function | Some t -> Some { t with env = env } | None -> None +(* Helpers for implicit arguments in infer_funapp' *) +let is_not_implicit (Typ_aux (aux, _)) = + match aux with + | Typ_app (id, [A_aux (A_nexp (Nexp_aux (Nexp_var impl, _)), _)]) when string_of_id id = "implicit" -> false + | _ -> true + +let implicit_to_int (Typ_aux (aux, l)) = + match aux with + | Typ_app (id, args) when string_of_id id = "implicit" -> Typ_aux (Typ_app (mk_id "atom", args), l) + | _ -> Typ_aux (aux, l) + +let rec get_implicits typs = + match typs with + | Typ_aux (Typ_app (id, [A_aux (A_nexp (Nexp_aux (Nexp_var impl, _)), _)]), _) :: typs when string_of_id id = "implicit" -> + impl :: get_implicits typs + | _ :: typs -> get_implicits typs + | [] -> [] + let infer_lit env (L_aux (lit_aux, l) as lit) = match lit_aux with | L_unit -> unit_typ @@ -3535,9 +3553,16 @@ and infer_funapp' l env f (typq, f_typ) xs expected_ret_typ = typ_debug (lazy ("Quantifiers " ^ Util.string_of_list ", " string_of_quant_item !quants)); - if not (List.length typ_args = List.length xs) then - typ_error env l (Printf.sprintf "Function %s applied to %d args, expected %d" (string_of_id f) (List.length xs) (List.length typ_args)) - else (); + let implicits, typ_args = + if not (List.length typ_args = List.length xs) then + let typ_args' = List.filter is_not_implicit typ_args in + if not (List.length typ_args' = List.length xs) then + typ_error env l (Printf.sprintf "Function %s applied to %d args, expected %d" (string_of_id f) (List.length xs) (List.length typ_args)) + else + get_implicits typ_args, typ_args' + else + [], List.map implicit_to_int typ_args + in let instantiate_quant (v, arg) (QI_aux (aux, l) as qi) = match aux with @@ -3597,6 +3622,13 @@ and infer_funapp' l env f (typq, f_typ) xs expected_ret_typ = let xs, _, env = List.fold_left fold_instantiate ([], typ_args, env) xs in let xs = List.rev xs in + let solve_implicit impl = match KBindings.find_opt impl !all_unifiers with + | Some (A_aux (A_nexp (Nexp_aux (Nexp_constant c, _)), _)) -> irule infer_exp env (mk_lit_exp (L_num c)) + | Some (A_aux (A_nexp n, _)) -> irule infer_exp env (mk_exp (E_sizeof n)) + | _ -> typ_error env l "bad" + in + let xs = List.map solve_implicit implicits @ xs in + if not (List.for_all (solve_quant env) !quants) then typ_raise env l (Err_unresolved_quants (f, !quants, Env.get_locals env, Env.get_constraints env)) else (); |
