Skip to content

Commit

Permalink
Add hint for common misplaced [@unboxed] attribute (ocaml-flambda#1164)
Browse files Browse the repository at this point in the history
  • Loading branch information
ccasin authored Mar 2, 2023
1 parent 347af67 commit a73ceca
Show file tree
Hide file tree
Showing 3 changed files with 40 additions and 8 deletions.
24 changes: 24 additions & 0 deletions ocaml/testsuite/tests/typing-unboxed-types/test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -128,6 +128,30 @@ Error: Signature mismatch:
the first declaration uses unboxed representation.
|}];;

module M' : sig
type t = A of string [@ocaml.unboxed]
end = struct
type t = A of string [@@ocaml.unboxed]
end;;
[%%expect{|
Lines 3-5, characters 6-3:
3 | ......struct
4 | type t = A of string [@@ocaml.unboxed]
5 | end..
Error: Signature mismatch:
Modules do not match:
sig type t = A of string [@@unboxed] end
is not included in
sig type t = A of string end
Type declarations do not match:
type t = A of string [@@unboxed]
is not included in
type t = A of string
Their internal representations differ:
the first declaration uses unboxed representation.
Hint: the second declaration has [@unboxed]. Did you mean [@@unboxed]?
|}];;

module N : sig
type t = A of string [@@ocaml.unboxed]
end = struct
Expand Down
22 changes: 15 additions & 7 deletions ocaml/typing/includecore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -226,7 +226,7 @@ type type_mismatch =
| Variance
| Record_mismatch of record_mismatch
| Variant_mismatch of variant_change list
| Unboxed_representation of position
| Unboxed_representation of position * attributes
| Immediate of Type_immediacy.Violation.t

let report_locality_mismatch first second ppf err =
Expand Down Expand Up @@ -469,10 +469,13 @@ let report_type_mismatch first second decl env ppf err =
report_record_mismatch first second decl env ppf err
| Variant_mismatch err ->
report_patch pp_variant_diff first second decl env ppf err
| Unboxed_representation ord ->
| Unboxed_representation (ord, attrs) ->
pr "Their internal representations differ:@ %s %s %s."
(choose ord first second) decl
"uses unboxed representation"
"uses unboxed representation";
if Builtin_attributes.has_unboxed attrs then
pr "@ Hint: %s %s has [%@unboxed]. Did you mean [%@%@unboxed]?"
(choose ord second first) decl
| Immediate violation ->
let first = StringLabels.capitalize_ascii first in
match violation with
Expand Down Expand Up @@ -618,8 +621,8 @@ module Record_diffing = struct
else
match rep1, rep2 with
| Record_unboxed _, Record_unboxed _ -> None
| Record_unboxed _, _ -> Some (Unboxed_representation First)
| _, Record_unboxed _ -> Some (Unboxed_representation Second)
| Record_unboxed _, _ -> Some (Unboxed_representation (First, []))
| _, Record_unboxed _ -> Some (Unboxed_representation (Second, []))

| Record_float, Record_float -> None
| Record_float, _ ->
Expand Down Expand Up @@ -766,16 +769,21 @@ module Variant_diffing = struct
cstrs1 cstrs2 rep1 rep2
=
let err = compare ~loc env params1 params2 cstrs1 cstrs2 in
let attrs_of_only cstrs =
match cstrs with
| [cstr] -> cstr.Types.cd_attributes
| _ -> []
in
match err, rep1, rep2 with
| None, Variant_regular, Variant_regular
| None, Variant_unboxed, Variant_unboxed ->
None
| Some err, _, _ ->
Some (Variant_mismatch err)
| None, Variant_unboxed, Variant_regular ->
Some (Unboxed_representation First)
Some (Unboxed_representation (First, attrs_of_only cstrs2))
| None, Variant_regular, Variant_unboxed ->
Some (Unboxed_representation Second)
Some (Unboxed_representation (Second, attrs_of_only cstrs1))
end

(* Inclusion between "private" annotations *)
Expand Down
2 changes: 1 addition & 1 deletion ocaml/typing/includecore.mli
Original file line number Diff line number Diff line change
Expand Up @@ -104,7 +104,7 @@ type type_mismatch =
| Variance
| Record_mismatch of record_mismatch
| Variant_mismatch of variant_change list
| Unboxed_representation of position
| Unboxed_representation of position * attributes
| Immediate of Type_immediacy.Violation.t

val value_descriptions:
Expand Down

0 comments on commit a73ceca

Please sign in to comment.