Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Deprecate Obj.set_tag #1725

Merged
merged 6 commits into from Feb 14, 2019
Merged

Deprecate Obj.set_tag #1725

Show file tree
Hide file tree
Changes from 3 commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
c39f771
Deprecate Obj.set_tag.
stedolan Feb 12, 2019
51025d1
Add optimisations in simplif.ml for Obj.with_tag.
stedolan Feb 12, 2019
a17b37c
Changes entry and review fixes
stedolan Feb 12, 2019
fa6304f
check_typo fix
stedolan Feb 12, 2019
4721c93
Bootstrap
stedolan Feb 13, 2019
05e08bb
update Changes
stedolan Feb 14, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
5 changes: 5 additions & 0 deletions Changes
View file
Open in desktop
Expand Up @@ -8,6 +8,11 @@ Working version
- GPR#2229: Env: remove prefix_idents cache
(Thomas Refis, review by Frédéric Bour and Gabriel Scherer)

### Runtime system:

- GPR#1725: Deprecate Obj.set_tag
(Stephen Dolan, review by Gabriel Scherer)

OCaml 4.08.0
------------

Expand Down
10 changes: 10 additions & 0 deletions bytecomp/simplif.ml
View file
Open in desktop
Expand Up @@ -235,6 +235,16 @@ let simplify_exits lam =
ap_args=[x];
ap_inlined=Default_inline;
ap_specialised=Default_specialise}
(* Simplify %identity *)
| Pidentity, [e] -> e
gasche marked this conversation as resolved.
Show resolved Hide resolved

(* Simplify Obj.with_tag *)
| Pccall { Primitive.prim_name = "caml_obj_with_tag"; _ },
[Lconst (Const_base (Const_int tag)); Lprim (Pmakeblock (_, mut, shape), fields, loc)] ->
Lprim (Pmakeblock(tag, mut, shape), fields, loc)
| Pccall { Primitive.prim_name = "caml_obj_with_tag"; _ },
[Lconst (Const_base (Const_int tag)); Lconst (Const_block (_, fields))] ->
Lconst (Const_block (tag, fields))

| _ -> Lprim(p, ll, loc)
end
Expand Down
21 changes: 17 additions & 4 deletions runtime/obj.c
View file
Open in desktop
Expand Up @@ -72,6 +72,13 @@ CAMLprim value caml_obj_set_tag (value arg, value new_tag)
return Val_unit;
}

CAMLprim value caml_obj_make_forward (value blk, value fwd)
{
caml_modify(&Field(blk, 0), fwd);
Tag_val (blk) = Forward_tag;
return Val_unit;
}

/* [size] is a value encoding a number of blocks */
CAMLprim value caml_obj_block(value tag, value size)
{
Expand All @@ -90,16 +97,16 @@ CAMLprim value caml_obj_block(value tag, value size)
}

/* Spacetime profiling assumes that this function is only called from OCaml. */
CAMLprim value caml_obj_dup(value arg)
CAMLprim value caml_obj_with_tag(value new_tag_v, value arg)
{
CAMLparam1 (arg);
CAMLparam2 (new_tag_v, arg);
CAMLlocal1 (res);
mlsize_t sz, i;
tag_t tg;

sz = Wosize_val(arg);
if (sz == 0) CAMLreturn (arg);
tg = Tag_val(arg);
tg = (tag_t)Long_val(new_tag_v);
if (sz == 0) CAMLreturn (Atom(tg));
gasche marked this conversation as resolved.
Show resolved Hide resolved
if (tg >= No_scan_tag) {
res = caml_alloc(sz, tg);
memcpy(Bp_val(res), Bp_val(arg), sz * sizeof(value));
Expand All @@ -115,6 +122,12 @@ CAMLprim value caml_obj_dup(value arg)
CAMLreturn (res);
}

/* Spacetime profiling assumes that this function is only called from OCaml. */
CAMLprim value caml_obj_dup(value arg)
{
return caml_obj_with_tag(Val_long(Tag_val(arg)), arg);
}

/* Shorten the given block to the given size and return void.
Raise Invalid_argument if the given size is less than or equal
to 0 or greater than the current size.
Expand Down
10 changes: 4 additions & 6 deletions stdlib/camlinternalLazy.ml
View file
Open in desktop
Expand Up @@ -21,15 +21,15 @@ exception Undefined

let raise_undefined = Obj.repr (fun () -> raise Undefined)

external make_forward : Obj.t -> Obj.t -> unit = "caml_obj_make_forward"

(* Assume [blk] is a block with tag lazy *)
let force_lazy_block (blk : 'arg lazy_t) =
let closure = (Obj.obj (Obj.field (Obj.repr blk) 0) : unit -> 'arg) in
Obj.set_field (Obj.repr blk) 0 raise_undefined;
try
let result = closure () in
(* do set_field BEFORE set_tag *)
Obj.set_field (Obj.repr blk) 0 (Obj.repr result);
Obj.set_tag (Obj.repr blk) Obj.forward_tag;
make_forward (Obj.repr blk) (Obj.repr result);
result
with e ->
Obj.set_field (Obj.repr blk) 0 (Obj.repr (fun () -> raise e));
Expand All @@ -41,9 +41,7 @@ let force_val_lazy_block (blk : 'arg lazy_t) =
let closure = (Obj.obj (Obj.field (Obj.repr blk) 0) : unit -> 'arg) in
Obj.set_field (Obj.repr blk) 0 raise_undefined;
let result = closure () in
(* do set_field BEFORE set_tag *)
gasche marked this conversation as resolved.
Show resolved Hide resolved
Obj.set_field (Obj.repr blk) 0 (Obj.repr result);
Obj.set_tag (Obj.repr blk) (Obj.forward_tag);
make_forward (Obj.repr blk) (Obj.repr result);
result


Expand Down
8 changes: 4 additions & 4 deletions stdlib/camlinternalMod.ml
View file
Open in desktop
Expand Up @@ -13,6 +13,8 @@
(* *)
(**************************************************************************)

external make_forward : Obj.t -> Obj.t -> unit = "caml_obj_make_forward"

type shape =
| Function
| Lazy
Expand Down Expand Up @@ -56,12 +58,10 @@ let rec update_mod shape o n =
if Obj.tag n = Obj.lazy_tag then
Obj.set_field o 0 (Obj.field n 0)
else if Obj.tag n = Obj.forward_tag then begin (* PR#4316 *)
Obj.set_tag o Obj.forward_tag;
Obj.set_field o 0 (Obj.field n 0)
make_forward o (Obj.field n 0)
end else begin
(* forwarding pointer was shortcut by GC *)
Obj.set_tag o Obj.forward_tag;
Obj.set_field o 0 n
make_forward o n
end
| Class ->
assert (Obj.tag n = 0 && Obj.size n = 4);
Expand Down
1 change: 1 addition & 0 deletions stdlib/obj.ml
View file
Open in desktop
Expand Up @@ -38,6 +38,7 @@ external new_block : int -> int -> t = "caml_obj_block"
external dup : t -> t = "caml_obj_dup"
external truncate : t -> int -> unit = "caml_obj_truncate"
external add_offset : t -> Int32.t -> t = "caml_obj_add_offset"
external with_tag : int -> t -> t = "caml_obj_with_tag"

let marshal (obj : t) =
Marshal.to_bytes obj []
Expand Down
3 changes: 3 additions & 0 deletions stdlib/obj.mli
View file
Open in desktop
Expand Up @@ -55,6 +55,7 @@ external field : t -> int -> t = "%obj_field"
*)
external set_field : t -> int -> t -> unit = "%obj_set_field"
external set_tag : t -> int -> unit = "caml_obj_set_tag"
[@@ocaml.deprecated "Use with_tag instead."]
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It's not necessarily a great idea to deprecate a feature at the same version that the replacement is added: a maintainer that would follow the deprecation advice must force its users to upgrade to the latest version (or use conditionals). Could we wait for one version between with_tag and set_tag's deprecation?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Happy to follow whatever deprecation policy works best here, but I don't really understand the issue. I thought @@ocaml.deprecated was the way to signal that a replacement is available? Is the concern here programs compiled with -warn-error breaking?

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Normally, we would deprecate it now and remove it in the next deprecation purge, in about 5 years. We still don't have any mechanism to indicate degrees of deprecation (or how much time before it gets removed). Such a mechanism might be an intermediate step before deprecation.

In the case of Obj.set_tag I think we'll remove it out-of-cycle to avoid delaying multicore, so it's better to deprecate right now anyway.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It's not necessarily a great idea to deprecate a feature at the same version that the replacement is added:

Regarding this comment about @gasche I fear a bit nothing is ever going to be deprecated (people will simply forget) if nothing special is done. One simple measure would be to have in the repo text file with a table of the form:

ID | vReplacement | vDeprecated notice | vRemove
--------------------------------------------------

Before a release one could then apply appropriate changes according to what the table says.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@dbuenzli yes, that sounds like a good idea. I guess some of your merged PRs have some maybe-deprecate-later identifiers in flight, do you have enough to send a PR to populate that file? (Did we merge PrintExc successor yet?)

(The file should also point to the (M/G)PR that contains the deprecation action/discussion.)

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

(Did we merge PrintExc successor yet?)

No, it is #2137, but it is not yet ready, more work needed.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I could have a look but a bit busy® right now®.


val [@inline always] double_field : t -> int -> float (* @since 3.11.2 *)
val [@inline always] set_double_field : t -> int -> float -> unit
Expand All @@ -64,6 +65,8 @@ external dup : t -> t = "caml_obj_dup"
external truncate : t -> int -> unit = "caml_obj_truncate"
external add_offset : t -> Int32.t -> t = "caml_obj_add_offset"
(* @since 3.12.0 *)
external with_tag : int -> t -> t = "caml_obj_with_tag"
(* @since 4.09.0 *)

val first_non_constant_constructor_tag : int
val last_non_constant_constructor_tag : int
Expand Down
4 changes: 2 additions & 2 deletions testsuite/tests/backtrace/backtrace2.byte.reference
View file
Open in desktop
Expand Up @@ -46,13 +46,13 @@ Called from file "backtrace2.ml", line 52, characters 43-52
Called from file "backtrace2.ml", line 52, characters 43-52
Called from file "backtrace2.ml", line 52, characters 43-52
Called from file "backtrace2.ml", line 52, characters 43-52
Called from file "camlinternalLazy.ml", line 29, characters 17-27
Called from file "camlinternalLazy.ml", line 31, characters 17-27
Re-raised at file "camlinternalLazy.ml", line 36, characters 10-11
Called from file "backtrace2.ml", line 67, characters 11-23
Uncaught exception Not_found
Raised at file "hashtbl.ml", line 194, characters 19-28
Called from file "backtrace2.ml", line 55, characters 8-41
Re-raised at file "camlinternalLazy.ml", line 35, characters 62-63
Called from file "camlinternalLazy.ml", line 29, characters 17-27
Called from file "camlinternalLazy.ml", line 31, characters 17-27
Re-raised at file "camlinternalLazy.ml", line 36, characters 10-11
Called from file "backtrace2.ml", line 67, characters 11-23
4 changes: 2 additions & 2 deletions testsuite/tests/backtrace/backtrace2.opt.reference
View file
Open in desktop
Expand Up @@ -46,13 +46,13 @@ Called from file "backtrace2.ml", line 52, characters 43-52
Called from file "backtrace2.ml", line 52, characters 43-52
Called from file "backtrace2.ml", line 52, characters 43-52
Called from file "backtrace2.ml", line 52, characters 43-52
Called from file "camlinternalLazy.ml", line 29, characters 17-27
Called from file "camlinternalLazy.ml", line 31, characters 17-27
Re-raised at file "camlinternalLazy.ml", line 36, characters 4-11
Called from file "backtrace2.ml", line 67, characters 11-23
Uncaught exception Not_found
Raised at file "hashtbl.ml", line 194, characters 13-28
Called from file "backtrace2.ml", line 55, characters 8-41
Re-raised at file "camlinternalLazy.ml", line 35, characters 56-63
Called from file "camlinternalLazy.ml", line 29, characters 17-27
Called from file "camlinternalLazy.ml", line 31, characters 17-27
Re-raised at file "camlinternalLazy.ml", line 36, characters 4-11
Called from file "backtrace2.ml", line 67, characters 11-23
1 change: 1 addition & 0 deletions testsuite/tests/lib-obj/ocamltests
View file
Open in desktop
@@ -1 +1,2 @@
reachable_words.ml
with_tag.ml
31 changes: 31 additions & 0 deletions testsuite/tests/lib-obj/with_tag.ml
View file
Open in desktop
@@ -0,0 +1,31 @@
(* TEST
*)

type t =
| A of string * float
| B of string * float

let () =
assert (Obj.dup (Obj.repr (A ("hello", 10.))) = Obj.repr (A ("hello", 10.)));
assert (Obj.with_tag 1 (Obj.repr (A ("hello", 10.))) = Obj.repr (B ("hello", 10.)))

let () =
assert (Obj.tag (Obj.with_tag 42 (Obj.repr [| |])) = 42)
gasche marked this conversation as resolved.
Show resolved Hide resolved

(* check optimisations *)
let raw_allocs f =
let before = Gc.minor_words () in
f ();
let after = Gc.minor_words () in
int_of_float (after -. before)

let allocs =
let overhead = raw_allocs (fun () -> ()) in
fun f -> raw_allocs f - overhead

let () =
assert (allocs (fun () -> Obj.with_tag 1 (Obj.repr (A ("hello", 10.)))) = 0);
assert (allocs (fun () -> Obj.with_tag 1 (Obj.repr (ref 10))) = 2)

let () =
print_endline "ok"
1 change: 1 addition & 0 deletions testsuite/tests/lib-obj/with_tag.reference
View file
Open in desktop
@@ -0,0 +1 @@
ok