Skip to content

Commit

Permalink
Remove more explicit uses of function$.
Browse files Browse the repository at this point in the history
  • Loading branch information
cristianoc committed Dec 20, 2024
1 parent be7ea6e commit d862a37
Show file tree
Hide file tree
Showing 2 changed files with 7 additions and 22 deletions.
17 changes: 3 additions & 14 deletions compiler/ml/includemod.ml
Original file line number Diff line number Diff line change
Expand Up @@ -504,23 +504,12 @@ let show_locs ppf (loc1, loc2) =
show_loc "Expected declaration" ppf loc2;
show_loc "Actual declaration" ppf loc1

let include_err ~env ppf = function
let include_err ppf = function
| Missing_field (id, loc, kind) ->
fprintf ppf "The %s `%a' is required but not provided" kind ident id;
show_loc "Expected declaration" ppf loc
| Value_descriptions (id, d1, d2) ->
let curry_kind_1, curry_kind_2 =
match
(Ctype.expand_head env d1.val_type, Ctype.expand_head env d2.val_type)
with
| {desc = Tarrow _}, {desc = Tconstr (Pident {name = "function$"}, _, _)}
->
(" (curried)", " (uncurried)")
| {desc = Tconstr (Pident {name = "function$"}, _, _)}, {desc = Tarrow _}
->
(" (uncurried)", " (curried)")
| _ -> ("", "")
in
let curry_kind_1, curry_kind_2 = ("", "") in
fprintf ppf
"@[<hv 2>Values do not match:@ %a%s@;<1 -2>is not included in@ %a%s@]"
(value_description id) d1 curry_kind_1 (value_description id) d2
Expand Down Expand Up @@ -606,7 +595,7 @@ let context ppf cxt =

let include_err ppf (cxt, env, err) =
Printtyp.wrap_printing_env env (fun () ->
fprintf ppf "@[<v>%a%a@]" context (List.rev cxt) (include_err ~env) err)
fprintf ppf "@[<v>%a%a@]" context (List.rev cxt) include_err err)

let buffer = ref Bytes.empty
let is_big obj =
Expand Down
12 changes: 4 additions & 8 deletions compiler/ml/typecore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -4458,18 +4458,14 @@ let report_error env ppf error =
| Some valid_methods -> spellcheck ppf me valid_methods)
| Not_subtype (tr1, tr2) ->
report_subtyping_error ppf env tr1 "is not a subtype of" tr2
| Too_many_arguments (in_function, ty) -> (
| Too_many_arguments (in_function, ty) ->
if (* modified *)
in_function then (
fprintf ppf "@[This function expects too many arguments,@ ";
fprintf ppf "it should have type@ %a@]" type_expr ty)
else
match ty with
| {desc = Tconstr (Pident {name = "function$"}, _, _)} ->
fprintf ppf "This expression is expected to have an uncurried function"
| _ ->
fprintf ppf "@[This expression should not be a function,@ ";
fprintf ppf "the expected type is@ %a@]" type_expr ty)
else (
fprintf ppf "@[This expression should not be a function,@ ";
fprintf ppf "the expected type is@ %a@]" type_expr ty)
| Abstract_wrong_label (l, ty) ->
let label_mark = function
| Nolabel -> "but its first argument is not labelled"
Expand Down

0 comments on commit d862a37

Please sign in to comment.