File 2072-Implement-the-new-ceil-1-and-floor-1-guard... of Package erlang

Overview Repositories Revisions Requests Users Attributes Meta

File 2072-Implement-the-new-ceil-1-and-floor-1-guard-BIFs.patch of Package erlang (Revision b921e8aed3aceafaa8c09c18784302db)

Currently displaying revision b921e8aed3aceafaa8c09c18784302db , Show latest

From 986d32a62b20c32338dac4dfd27c141c8f9be0fe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Mon, 20 Jun 2016 13:25:04 +0200
Subject: [PATCH 1/2] Implement the new ceil/1 and floor/1 guard BIFs

Implement as ceil/1 and floor/1 as new guard BIFs (essentially part of
Erlang language). They are guard BIFs because trunc/1 is a guard
BIF. It would be strange to have trunc/1 as a part of the language, but
not ceil/1 and floor/1.
---
 erts/doc/src/erlang.xml              |  27 +++++++++++
 erts/emulator/beam/bif.tab           |   7 +++
 erts/emulator/beam/erl_bif_guard.c   |  65 +++++++++++++++++++++++++++
 erts/emulator/test/num_bif_SUITE.erl |  84 ++++++++++++++++++++++++++++-------
 erts/preloaded/ebin/erlang.beam      | Bin 105100 -> 105400 bytes
 erts/preloaded/src/erlang.erl        |  19 +++++++-
 lib/compiler/src/beam_validator.erl  |   2 +
 lib/compiler/src/erl_bifs.erl        |   2 +
 lib/compiler/src/sys_core_fold.erl   |   2 +
 lib/compiler/test/bif_SUITE.erl      |   4 +-
 lib/hipe/cerl/erl_bif_types.erl      |  12 +++++
 lib/stdlib/src/erl_internal.erl      |   4 ++
 lib/tools/emacs/erlang.el            |   2 +
 13 files changed, 209 insertions(+), 21 deletions(-)

diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index d0a3a77..18a7a5b 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -693,6 +693,19 @@ Z = erlang:adler32_combine(X,Y,iolist_size(Data2)).</code>
     </func>
 
     <func>
+      <name name="ceil" arity="1"/>
+      <fsummary>Returns the smallest integer not less than the argument</fsummary>
+      <desc>
+        <p>Returns the smallest integer not less than
+	<c><anno>Number</anno></c>.
+        For example:</p>
+        <pre>
+> <input>ceil(5.5).</input>
+6</pre>
+        <p>Allowed in guard tests.</p>
+      </desc>
+    </func>
+    <func>
       <name name="check_old_code" arity="1"/>
       <fsummary>Check if a module has old code.</fsummary>
       <desc>
@@ -1417,6 +1430,20 @@ true</pre>
     </func>
 
     <func>
+      <name name="floor" arity="1"/>
+      <fsummary>Returns the largest integer not greater than the argument</fsummary>
+      <desc>
+        <p>Returns the largest integer not greater than
+	<c><anno>Number</anno></c>.
+        For example:</p>
+        <pre>
+> <input>floor(-10.5).</input>
+-11</pre>
+        <p>Allowed in guard tests.</p>
+      </desc>
+    </func>
+
+    <func>
       <name name="fun_info" arity="1"/>
       <fsummary>Information about a fun.</fsummary>
       <desc>
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -5449,6 +5449,10 @@ translate_gc_bif(void* gcf)
 	return round_1;
     } else if (gcf == erts_gc_trunc_1) {
 	return round_1;
+    } else if (gcf == erts_gc_ceil_1) {
+	return ceil_1;
+    } else if (gcf == erts_gc_floor_1) {
+	return floor_1;
     } else if (gcf == erts_gc_binary_part_2) {
 	return binary_part_2;
     } else if (gcf == erts_gc_binary_part_3) {
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -4048,6 +4048,10 @@ gen_guard_bif1(LoaderState* stp, GenOpAr
 	op->a[1].val = (BeamInstr) (void *) erts_gc_round_1;
     } else if (bf == trunc_1) {
 	op->a[1].val = (BeamInstr) (void *) erts_gc_trunc_1;
+    } else if (bf == ceil_1) {
+	op->a[1].val = (BeamInstr) (void *) erts_gc_ceil_1;
+    } else if (bf == floor_1) {
+	op->a[1].val = (BeamInstr) (void *) erts_gc_floor_1;
     } else {
 	op->op = genop_unsupported_guard_bif_3;
 	op->arity = 3;
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 7a35c02..67eae35 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -653,6 +653,13 @@ bif erlang:has_prepared_code_on_load/1
 bif maps:take/2
 
 #
+# New in 20.0
+#
+
+bif erlang:floor/1
+bif erlang:ceil/1
+
+#
 # Obsolete
 #
 
diff --git a/erts/emulator/beam/erl_bif_guard.c b/erts/emulator/beam/erl_bif_guard.c
index b42d2dc..458315f 100644
--- a/erts/emulator/beam/erl_bif_guard.c
+++ b/erts/emulator/beam/erl_bif_guard.c
@@ -141,6 +141,39 @@ BIF_RETTYPE trunc_1(BIF_ALIST_1)
     BIF_RET(res);
 }
 
+BIF_RETTYPE floor_1(BIF_ALIST_1)
+{
+    Eterm res;
+    FloatDef f;
+
+    if (is_not_float(BIF_ARG_1)) {
+	if (is_integer(BIF_ARG_1))
+	    BIF_RET(BIF_ARG_1);
+	BIF_ERROR(BIF_P, BADARG);
+    }
+    GET_DOUBLE(BIF_ARG_1, f);
+    res = double_to_integer(BIF_P, floor(f.fd));
+    BIF_RET(res);
+}
+
+BIF_RETTYPE ceil_1(BIF_ALIST_1)
+{
+    Eterm res;
+    FloatDef f;
+
+    /* check arg */
+    if (is_not_float(BIF_ARG_1)) {
+	if (is_integer(BIF_ARG_1))
+	    BIF_RET(BIF_ARG_1);
+	BIF_ERROR(BIF_P, BADARG);
+    }
+    /* get the float */
+    GET_DOUBLE(BIF_ARG_1, f);
+
+    res = double_to_integer(BIF_P, ceil(f.fd));
+    BIF_RET(res);
+}
+
 BIF_RETTYPE round_1(BIF_ALIST_1)
 {
     Eterm res;
@@ -621,6 +654,38 @@ Eterm erts_gc_trunc_1(Process* p, Eterm* reg, Uint live)
 				reg, live);
 }
 
+Eterm erts_gc_floor_1(Process* p, Eterm* reg, Uint live)
+{
+    Eterm arg;
+    FloatDef f;
+
+    arg = reg[live];
+    if (is_not_float(arg)) {
+	if (is_integer(arg))  {
+	    return arg;
+	}
+	BIF_ERROR(p, BADARG);
+    }
+    GET_DOUBLE(arg, f);
+    return gc_double_to_integer(p, floor(f.fd), reg, live);
+}
+
+Eterm erts_gc_ceil_1(Process* p, Eterm* reg, Uint live)
+{
+    Eterm arg;
+    FloatDef f;
+
+    arg = reg[live];
+    if (is_not_float(arg)) {
+	if (is_integer(arg))  {
+	    return arg;
+	}
+	BIF_ERROR(p, BADARG);
+    }
+    GET_DOUBLE(arg, f);
+    return gc_double_to_integer(p, ceil(f.fd), reg, live);
+}
+
 static Eterm
 gc_double_to_integer(Process* p, double x, Eterm* reg, Uint live)
 {
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -1436,6 +1436,8 @@ Eterm erts_gc_abs_1(Process* p, Eterm* r
 Eterm erts_gc_float_1(Process* p, Eterm* reg, Uint live);
 Eterm erts_gc_round_1(Process* p, Eterm* reg, Uint live);
 Eterm erts_gc_trunc_1(Process* p, Eterm* reg, Uint live);
+Eterm erts_gc_ceil_1(Process* p, Eterm* reg, Uint live);
+Eterm erts_gc_floor_1(Process* p, Eterm* reg, Uint live);
 Eterm erts_gc_binary_part_3(Process* p, Eterm* reg, Uint live);
 Eterm erts_gc_binary_part_2(Process* p, Eterm* reg, Uint live);
 
diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl
index d1c9648..1a1ab0e 100644
--- a/erts/emulator/test/num_bif_SUITE.erl
+++ b/erts/emulator/test/num_bif_SUITE.erl
@@ -32,6 +32,8 @@
 %%	list_to_integer/1
 %%	round/1
 %%	trunc/1
+%%      floor/1
+%%      ceil/1
 %%	integer_to_binary/1
 %%	integer_to_binary/2
 %%	binary_to_integer/1
@@ -41,7 +43,7 @@
 	 t_float_to_string/1, t_integer_to_string/1,
 	 t_string_to_integer/1, t_list_to_integer_edge_cases/1,
 	 t_string_to_float_safe/1, t_string_to_float_risky/1,
-	 t_round/1, t_trunc/1
+	 t_round/1, t_trunc_and_friends/1
      ]).
 
 suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -49,7 +51,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
 all() ->
     [t_abs, t_float, t_float_to_string, t_integer_to_string,
      {group, t_string_to_float}, t_string_to_integer, t_round,
-     t_trunc, t_list_to_integer_edge_cases].
+     t_trunc_and_friends, t_list_to_integer_edge_cases].
 
 groups() ->
     [{t_string_to_float, [],
@@ -295,30 +297,78 @@ t_round(Config) when is_list(Config) ->
     -6209607916799025 = round(id(-6209607916799025.0)),
     ok.
 
-t_trunc(Config) when is_list(Config) ->
-    0 = trunc(id(0.0)),
-    5 = trunc(id(5.3333)),
-    -10 = trunc(id(-10.978987)),
+%% Test trunc/1, floor/1, ceil/1, and round/1.
+t_trunc_and_friends(_Config) ->
+    MinusZero = 0.0 / (-1.0),
+    0 = trunc_and_friends(MinusZero),
+    0 = trunc_and_friends(0.0),
+    5 = trunc_and_friends(5.3333),
+    -10 = trunc_and_friends(-10.978987),
 
-    % The largest smallnum, converted to float (OTP-3722):
+    %% The largest smallnum, converted to float (OTP-3722):
     X = id((1 bsl 27) - 1),
-    F = id(X + 0.0),
+    F = X + 0.0,
     io:format("X = ~p/~w/~w, F = ~p/~w/~w, trunc(F) = ~p/~w/~w~n",
 	      [X, X, binary_to_list(term_to_binary(X)),
 	       F, F, binary_to_list(term_to_binary(F)),
-	       trunc(F), trunc(F), binary_to_list(term_to_binary(trunc(F)))]),
-    X = trunc(F),
-    X = trunc(F+1)-1,
-    X = trunc(F-1)+1,
-    X = -trunc(-F),
-    X = -trunc(-F-1)-1,
-    X = -trunc(-F+1)+1,
+	       trunc_and_friends(F),
+	       trunc_and_friends(F),
+	       binary_to_list(term_to_binary(trunc_and_friends(F)))]),
+    X = trunc_and_friends(F),
+    X = trunc_and_friends(F+1)-1,
+    X = trunc_and_friends(F-1)+1,
+    X = -trunc_and_friends(-F),
+    X = -trunc_and_friends(-F-1)-1,
+    X = -trunc_and_friends(-F+1)+1,
 
     %% Bignums.
-    4294967305 = trunc(id(4294967305.7)),
-    -4294967305 = trunc(id(-4294967305.7)),
+    4294967305 = trunc_and_friends(4294967305.7),
+    -4294967305 = trunc_and_friends(-4294967305.7),
+    18446744073709551616 = trunc_and_friends(float(1 bsl 64)),
+    -18446744073709551616 = trunc_and_friends(-float(1 bsl 64)),
+
+    %% Random.
+    t_trunc_and_friends_rand(100),
     ok.
 
+t_trunc_and_friends_rand(0) ->
+    ok;
+t_trunc_and_friends_rand(N) ->
+    F0 = rand:uniform() * math:pow(10, 50*rand:normal()),
+    F = case rand:uniform() of
+	    U when U < 0.5 -> -F0;
+	    _ -> F0
+	end,
+    _ = trunc_and_friends(F),
+    t_trunc_and_friends_rand(N-1).
+
+trunc_and_friends(F) ->
+    Trunc = trunc(F),
+    Floor = floor(F),
+    Ceil = ceil(F),
+    Round = round(F),
+
+    Trunc = trunc(Trunc),
+    Floor = floor(Floor),
+    Ceil = ceil(Ceil),
+    Round = round(Round),
+
+    Trunc = trunc(float(Trunc)),
+    Floor = floor(float(Floor)),
+    Ceil = ceil(float(Ceil)),
+    Round = round(float(Round)),
+
+    true = Floor =< Trunc andalso Trunc =< Ceil,
+    true = Ceil - Floor =< 1,
+    true = Round =:= Floor orelse Round =:= Ceil,
+
+    if
+	F < 0 ->
+	    Trunc = Ceil;
+	true ->
+	    Trunc = Floor
+    end,
+    Trunc.
 
 %% Tests integer_to_binary/1.
 
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index 652a954..5bd73fe 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -91,7 +91,8 @@
 -export([binary_to_list/3, binary_to_term/1, binary_to_term/2]).
 -export([bit_size/1, bitsize/1, bitstring_to_list/1]).
 -export([bump_reductions/1, byte_size/1, call_on_load_function/1]).
--export([cancel_timer/1, cancel_timer/2, check_old_code/1, check_process_code/2,
+-export([cancel_timer/1, cancel_timer/2, ceil/1,
+	 check_old_code/1, check_process_code/2,
 	 check_process_code/3, crc32/1]).
 -export([crc32/2, crc32_combine/3, date/0, decode_packet/3]).
 -export([delete_element/2]).
@@ -100,7 +101,7 @@
 -export([error/1, error/2, exit/1, exit/2, external_size/1]).
 -export([external_size/2, finish_after_on_load/2, finish_loading/1, float/1]).
 -export([float_to_binary/1, float_to_binary/2,
-	 float_to_list/1, float_to_list/2]).
+	 float_to_list/1, float_to_list/2, floor/1]).
 -export([fun_info/2, fun_info_mfa/1, fun_to_list/1, function_exported/3]).
 -export([garbage_collect/0, garbage_collect/1, garbage_collect/2]).
 -export([garbage_collect_message_area/0, get/0, get/1, get_keys/0, get_keys/1]).
@@ -465,6 +466,13 @@ cancel_timer(_TimerRef) ->
 cancel_timer(_TimerRef, _Options) ->
     erlang:nif_error(undefined).
 
+%% ceil/1
+%% Shadowed by erl_bif_types: erlang:ceil/1
+-spec ceil(Number) -> integer() when
+      Number :: number().
+ceil(_) ->
+    erlang:nif_error(undef).
+
 %% check_old_code/1
 -spec check_old_code(Module) -> boolean() when
       Module :: module().
@@ -828,6 +836,13 @@ float_to_list(_Float) ->
 float_to_list(_Float, _Options) ->
     erlang:nif_error(undefined).
 
+%% floor/1
+%% Shadowed by erl_bif_types: erlang:floor/1
+-spec floor(Number) -> integer() when
+      Number :: number().
+floor(_) ->
+    erlang:nif_error(undef).
+
 %% fun_info/2
 -spec erlang:fun_info(Fun, Item) -> {Item, Info} when
       Fun :: function(),
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 4c0cb67..fd340bd 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -1506,7 +1506,9 @@ bif_type(abs, [Num], Vst) ->
 bif_type(float, _, _) -> {float,[]};
 bif_type('/', _, _) -> {float,[]};
 %% Integer operations.
+bif_type(ceil, [_], _) -> {integer,[]};
 bif_type('div', [_,_], _) -> {integer,[]};
+bif_type(floor, [_], _) -> {integer,[]};
 bif_type('rem', [_,_], _) -> {integer,[]};
 bif_type(length, [_], _) -> {integer,[]};
 bif_type(size, [_], _) -> {integer,[]};
diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl
index 6b2d781..7240592 100644
--- a/lib/compiler/src/erl_bifs.erl
+++ b/lib/compiler/src/erl_bifs.erl
@@ -75,10 +75,12 @@ is_pure(erlang, binary_to_list, 1) -> true;
 is_pure(erlang, binary_to_list, 3) -> true;
 is_pure(erlang, bit_size, 1) -> true;
 is_pure(erlang, byte_size, 1) -> true;
+is_pure(erlang, ceil, 1) -> true;
 is_pure(erlang, element, 2) -> true;
 is_pure(erlang, float, 1) -> true;
 is_pure(erlang, float_to_list, 1) -> true;
 is_pure(erlang, float_to_binary, 1) -> true;
+is_pure(erlang, floor, 1) -> true;
 is_pure(erlang, hash, 2) -> false;
 is_pure(erlang, hd, 1) -> true;
 is_pure(erlang, integer_to_binary, 1) -> true;
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index e0de50f..b806517 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -2949,7 +2949,9 @@ returns_integer(bit_size, [_]) -> true;
 returns_integer('bsl', [_,_]) -> true;
 returns_integer('bsr', [_,_]) -> true;
 returns_integer(byte_size, [_]) -> true;
+returns_integer(ceil, [_]) -> true;
 returns_integer('div', [_,_]) -> true;
+returns_integer(floor, [_]) -> true;
 returns_integer(length, [_]) -> true;
 returns_integer('rem', [_,_]) -> true;
 returns_integer('round', [_]) -> true;
diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl
index 9453ca6..32d5d39 100644
--- a/lib/hipe/cerl/erl_bif_types.erl
+++ b/lib/hipe/cerl/erl_bif_types.erl
@@ -560,6 +560,9 @@ type(erlang, byte_size, 1, Xs, Opaques) ->
   strict(erlang, byte_size, 1, Xs,
 	 fun (_) -> t_non_neg_integer() end, Opaques);
 %% Guard bif, needs to be here.
+type(erlang, ceil, 1, Xs, Opaques) ->
+  strict(erlang, ceil, 1, Xs, fun (_) -> t_integer() end, Opaques);
+%% Guard bif, needs to be here.
 %% Also much more expressive than anything you could write in a spec...
 type(erlang, element, 2, Xs, Opaques) ->
   strict(erlang, element, 2, Xs,
@@ -588,6 +591,9 @@ type(erlang, element, 2, Xs, Opaques) ->
 type(erlang, float, 1, Xs, Opaques) ->
   strict(erlang, float, 1, Xs, fun (_) -> t_float() end, Opaques);
 %% Guard bif, needs to be here.
+type(erlang, floor, 1, Xs, Opaques) ->
+  strict(erlang, floor, 1, Xs, fun (_) -> t_integer() end, Opaques);
+%% Guard bif, needs to be here.
 type(erlang, hd, 1, Xs, Opaques) ->
   strict(erlang, hd, 1, Xs, fun ([X]) -> t_cons_hd(X) end, Opaques);
 type(erlang, info, 1, Xs, _) -> type(erlang, system_info, 1, Xs); % alias
@@ -2341,6 +2347,9 @@ arg_types(erlang, bit_size, 1) ->
 %% Guard bif, needs to be here.
 arg_types(erlang, byte_size, 1) ->
   [t_bitstr()];
+%% Guard bif, needs to be here.
+arg_types(erlang, ceil, 1) ->
+  [t_number()];
 arg_types(erlang, halt, 0) ->
   [];
 arg_types(erlang, halt, 1) ->
@@ -2361,6 +2370,9 @@ arg_types(erlang, element, 2) ->
 arg_types(erlang, float, 1) ->
   [t_number()];
 %% Guard bif, needs to be here.
+arg_types(erlang, floor, 1) ->
+  [t_number()];
+%% Guard bif, needs to be here.
 arg_types(erlang, hd, 1) ->
   [t_cons()];
 arg_types(erlang, info, 1) ->
diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl
index 5d6aa0e..006e794 100644
--- a/lib/stdlib/src/erl_internal.erl
+++ b/lib/stdlib/src/erl_internal.erl
@@ -63,6 +63,8 @@ guard_bif(binary_part, 2) -> true;
 
 guard_bif(abs, 1) -> true;
 guard_bif(float, 1) -> true;
+guard_bif(ceil, 1) -> true;
+guard_bif(floor, 1) -> true;
 guard_bif(trunc, 1) -> true;
 guard_bif(round, 1) -> true;
 guard_bif(length, 1) -> true;
@@ -271,6 +273,7 @@ bif(bitsize, 1) -> true;
 bif(bit_size, 1) -> true;
 bif(bitstring_to_list, 1) -> true;
 bif(byte_size, 1) -> true;
+bif(ceil, 1) -> true;
 bif(check_old_code, 1) -> true;
 bif(check_process_code, 2) -> true;
 bif(check_process_code, 3) -> true;
@@ -291,6 +294,7 @@ bif(float_to_list, 1) -> true;
 bif(float_to_list, 2) -> true;
 bif(float_to_binary, 1) -> true;
 bif(float_to_binary, 2) -> true;
+bif(floor, 1) -> true;
 bif(garbage_collect, 0) -> true;
 bif(garbage_collect, 1) -> true;
 bif(garbage_collect, 2) -> true;
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index 73c6b8d..a0f9512 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -743,6 +743,7 @@ resulting regexp is surrounded by \\_< and \\_>."
       "bitsize"
       "bitstring_to_list"
       "byte_size"
+      "ceil"
       "check_old_code"
       "check_process_code"
       "date"
@@ -753,6 +754,7 @@ resulting regexp is surrounded by \\_< and \\_>."
       "erase"
       "error"
       "exit"
+      "floor"
       "float"
       "float_to_binary"
       "float_to_list"
-- 
2.10.0

Places

File 2072-Implement-the-new-ceil-1-and-floor-1-guard-BIFs.patch of Package erlang (Revision b921e8aed3aceafaa8c09c18784302db)

Places