Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Cleaned up [@@unbox] validity check.

master
Rodolphe Lepigre 2018-10-04 21:44:45 +02:00 committed by Gabriel Scherer
parent 6aa2ceaf08
commit 20b62c8386
2 changed files with 33 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
testsuite/tests/typing-unboxed-types/test.ml
View File

@ -88,7 +88,7 @@ Line 1, characters 0-56:
1 | type t9 = K of { j : string; l : int } [@@ocaml.unboxed];; 1 | type t9 = K of { j : string; l : int } [@@ocaml.unboxed];;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This type cannot be unboxed because Error: This type cannot be unboxed because
its constructor has more than one argument. its constructor has more than one field.
|}];; |}];;
(* let rec must be rejected *) (* let rec must be rejected *)

68
typing/typedecl.ml
View File

@ -360,47 +360,43 @@ let transl_declaration env sdecl id =
in in
let raw_status = get_unboxed_from_attributes sdecl in let raw_status = get_unboxed_from_attributes sdecl in
if raw_status.unboxed && not raw_status.default then begin if raw_status.unboxed && not raw_status.default then begin
let bad msg = raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute msg)) in
match sdecl.ptype_kind with match sdecl.ptype_kind with
| Ptype_abstract -> | Ptype_abstract -> bad "it is abstract"
raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute | Ptype_open -> bad "extensible variant types cannot be unboxed"
"it is abstract")) | Ptype_record fields -> begin match fields with
| Ptype_variant [{pcd_args = Pcstr_tuple []; _}] -> | [] -> bad "it has no fields"
raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute | _::_::_ -> bad "it has more than one field"
"its constructor has no argument")) | [{pld_mutable = Mutable}] -> bad "it is mutable"
| Ptype_variant [{pcd_args = Pcstr_tuple [_]; _}] -> () | [{pld_mutable = Immutable}] -> ()
| Ptype_variant [{pcd_args = Pcstr_tuple _; _}] -> end
raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute | Ptype_variant constructors -> begin match constructors with
"its constructor has more than one argument")) | [] -> bad "it has no constructor"
| Ptype_variant [{pcd_args = Pcstr_record | (_::_::_) -> bad "it has more than one constructor"
[{pld_mutable=Immutable; _}]; _}] -> () | [c] -> begin match c.pcd_args with
| Ptype_variant [{pcd_args = Pcstr_record [{pld_mutable=Mutable; _}]; _}] -> | Pcstr_tuple [] ->
raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute "it is mutable")) bad "its constructor has no argument"
| Ptype_variant [{pcd_args = Pcstr_record _; _}] -> | Pcstr_tuple (_::_::_) ->
raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute bad "its constructor has more than one argument"
"its constructor has more than one argument")) | Pcstr_tuple [_] ->
| Ptype_variant _ -> ()
raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute | Pcstr_record [] ->
"it has more than one constructor")) bad "its constructor has no fields"
| Ptype_record [{pld_mutable=Immutable; _}] -> () | Pcstr_record (_::_::_) ->
| Ptype_record [{pld_mutable=Mutable; _}] -> bad "its constructor has more than one field"
raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute | Pcstr_record [{pld_mutable = Mutable}] ->
"it is mutable")) bad "it is mutable"
| Ptype_record _ -> | Pcstr_record [{pld_mutable = Immutable}] ->
raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute ()
"it has more than one field")) end
| Ptype_open -> end
raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute
"extensible variant types cannot be unboxed"))
end; end;
let unboxed_status = let unboxed_status =
match sdecl.ptype_kind with match sdecl.ptype_kind with
| Ptype_variant [{pcd_args = Pcstr_tuple [_]; _}] | Ptype_variant [{pcd_args = Pcstr_tuple [_]; _}]
| Ptype_variant [{pcd_args = Pcstr_record | Ptype_variant [{pcd_args = Pcstr_record [{pld_mutable=Immutable; _}]; _}]
[{pld_mutable = Immutable; _}]; _}] | Ptype_record [{pld_mutable=Immutable; _}] -> raw_status
| Ptype_record [{pld_mutable = Immutable; _}] -> | _ -> unboxed_false_default_false (* Not unboxable, mark as boxed *)
raw_status
| _ -> (* The type is not unboxable, mark it as boxed *)
unboxed_false_default_false
in in
let unbox = unboxed_status.unboxed in let unbox = unboxed_status.unboxed in
let (tkind, kind) = let (tkind, kind) =