This file is indexed.

/usr/lib/perl5/Scalar/Number.pm is in libscalar-number-perl 0.006-1build2.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
=head1 NAME

Scalar::Number - numeric aspects of scalars

=head1 SYNOPSIS

	use Scalar::Number qw(scalar_num_part);

	$num = scalar_num_part($scalar);

	use Scalar::Number qw(sclnum_is_natint sclnum_is_float);

	if(sclnum_is_natint($value)) { ...
	if(sclnum_is_float($value)) { ...

	use Scalar::Number qw(sclnum_val_cmp sclnum_id_cmp);

	@sorted_nums = sort { sclnum_val_cmp($a, $b) } @floats;
	@sorted_nums = sort { sclnum_id_cmp($a, $b) } @floats;

=head1 DESCRIPTION

This module is about the numeric part of plain (string) Perl scalars.
A scalar has a numeric value, which may be expressed in either the
native integer type or the native floating point type.  Many values
are expressible both ways, in which case the exact representation is
insignificant.  To fully understand Perl arithmetic it is necessary to
know about both of these representations, and the differing behaviours
of numbers according to which way they are expressible.

This module provides functions to extract the numeric part of a scalar,
classify a number by expressibility, and compare numbers across
representations.

This module is implemented in XS, with a pure Perl backup version for
systems that can't handle XS.

=cut

package Scalar::Number;

{ use 5.006; }
use warnings;
use strict;

our $VERSION = "0.006";

use parent "Exporter";
our @EXPORT_OK = qw(
	scalar_num_part
	sclnum_is_natint sclnum_is_float
	sclnum_val_cmp sclnum_id_cmp
);

eval { local $SIG{__DIE__};
	require XSLoader;
	XSLoader::load(__PACKAGE__, $VERSION);
};

if($@ eq "") {
	close(DATA);
	*scalar_num_part = sub($) {
		no warnings qw(numeric uninitialized);
		return _warnable_scalar_num_part($_[0]);
	};
} else {
	local $/ = undef;
	my $pp_code = <DATA>;
	close(DATA);
	{
		local $SIG{__DIE__};
		eval $pp_code;
	}
	die $@ if $@ ne "";
}

1;

__DATA__

use Carp qw(croak);
use Data::Float 0.008 qw(
	have_signed_zero significand_bits max_integer
	float_is_infinite pow2 mult_pow2
);
use Data::Integer 0.003 qw(natint_bits min_natint max_natint hex_natint);
use overload ();

BEGIN {
	# In perl 5.6, arithmetic is performed in floating point by default,
	# even if the arguments are native integers that lose precision upon
	# conversion to float.  If there are such native integers then these
	# semantics make it impossible in some cases to tell the difference
	# between an integer and a nearby floating point value.  Specifically,
	# the maximum integer and its float approximation (which has a
	# numeric value 1 higher) are indistinguishable.  In that case, this
	# module cannot be implemented in pure Perl.  Detect that here by
	# max_natint-2 appearing to be even.  (perl 5.6.0 has even more messed
	# up arithmetic, such that max_natint%2 misleadingly gives the result
	# 1.)
	if((max_natint-2) % 2 != 1) {
		die "Scalar::Number cannot operate in pure Perl due to there ".
			"being native integer values not exactly ".
			"representable as native floats combined with ".
			"uncooperative numeric semantics";
	}
	# With that case excluded, it is guaranteed that default arithmetic
	# will operate correctly on all native integer values when performing
	# operations within the native integer range.  The correctness is
	# either due to perl 5.8+ numeric semantics, which perform such
	# operations in native integer arithmetic, or due to all native
	# integers being losslessly representable in floating point.
}

# Floating point constants arount max_natint: high_max has the value
# max_natint+1, and low_max is the next lower floating point value.
# reduced_high_max is the difference between them.  These are only
# valid if there are native integers that are not representable in
# floating point.  In other cases they have unpredictable values and
# are not used.
#
# Note: bug in Perl (bug in v5.8.8, bug ID #41288): floating point values
# in the high positive part of the native integer range don't necessarily
# get translated to native integers for integer operations as they're
# supposed to.  Therefore it is vital that low_max below is defined using
# integer arithmetic.

use constant high_max => pow2(natint_bits);
use constant low_max => ((1 << (natint_bits-1)) -
			 (1 << (natint_bits - (significand_bits+1)))) +
			(1 << (natint_bits-1));
use constant reduced_high_max => 1 << (natint_bits - (significand_bits+1));

BEGIN {
	# We need the refaddr() function from Scalar::Util.  However, if
	# Scalar::Util isn't available then we can reimplement it less
	# efficiently.
	eval { local $SIG{__DIE__}; require Scalar::Util; };
	if($@ eq "") {
		*_refaddr = \&Scalar::Util::refaddr;
	} else {
		*_refaddr = sub($) {
			overload::StrVal($_[0]) =~ /0x([0-9a-f]+)\)\z/
				or die "don't understand StrVal output";
			return hex_natint($1);
		};
	}
}

=head1 FUNCTIONS

Each "sclnum_" function takes one or more scalar numeric arguments
to operate on.  These arguments must be numeric; giving non-numeric
arguments will cause mayhem.  See L<Params::Classify/is_number> for a way
to check for numericness.  Only the numeric value of the scalar is used;
the string value is completely ignored, so dualvars are not a problem.

=head2 Decomposition

=over

=item scalar_num_part(SCALAR)

Extracts the numeric value of SCALAR, and returns it as a pure numeric
scalar.  The argument is permitted to be any scalar.

Every scalar has both a string value and a numeric value.  In pure string
scalars, those resulting from string literals or string operations,
the numeric value is determined from the string value.  In pure numeric
scalars, those resulting from numeric literals or numeric operations,
the string value is determined from the numeric value.  In the general
case, however, a plain scalar's string and numeric values may be
set independently, which is known as a dualvar.  Non-plain scalars,
principally references, determine their string and numeric values in other
ways, and in particular a reference to a blessed object can stringify
and numerify however the class wishes.

This function does not warn if given an ostensibly non-numeric argument,
because the whole point of it is to extract the numeric value of scalars
that are not pure numeric.

=cut

my %zero = (
	"+0+0" => 0,
	"+0-0" => +0.0,
	"-0+0" => -0.0,
);
sub scalar_num_part($) {
	my($val) = @_;
	no warnings qw(numeric uninitialized);
	while(ref($val) ne "") {
		my $meth = overload::Method($val, "0+");
		return _refaddr($val) unless defined $meth;
		my $newval = eval { local $SIG{__DIE__};
			$meth->($val, undef, "");
		};
		if($@ ne "" || (ref($newval) ne "" &&
				_refaddr($newval) == _refaddr($val))) {
			return _refaddr($val);
		}
		$val = $newval;
	}
	if(have_signed_zero && (my $tval = $val) == 0) {
		if(!defined($val) || ref(\$val) eq "GLOB") {
			$val = 0.0;
		} elsif(do {
			my $warned;
			local $SIG{__WARN__} = sub { $warned = 1; };
			use warnings qw(numeric uninitialized);
			no warnings "void";
			0 + (my $tval = $val);
			$warned;
		}) {
			$val = "0";
		}
		return my $zero = $zero{sprintf("%+.f%+.f", $val, -$val)};
	} else {
		return 0 + $val;
	}
}

=back

=head2 Classification

=over

=item sclnum_is_natint(VALUE)

Returns a truth value indicating whether the provided VALUE can be represented
in the native integer data type.  If the floating point type includes
signed zeroes then they do not qualify; the only zero representable in
the integer type is unsigned.

=cut

sub sclnum_is_natint($) {
	my($val) = @_;
	if(have_signed_zero && $val == 0) {
		$val = $_[0];
		return sprintf("%+.f%+.f", $val, -$val) eq "+0+0";
	} elsif(int($val) != $val) {
		return 0;
	} elsif(significand_bits+1 >= natint_bits) {
		# all native integers are representable as floats, so
		# straight comparison against max_natint works
		return $val >= min_natint && $val <= max_natint;
	} else {
		# Some native integers can't be exactly represented as
		# floats, so naive comparisons will cause lossy
		# conversions.  min_natint, being the negation of a power
		# of two, can be represented correctly as a float, but
		# max_natint cannot.  We have two float constants, low_max
		# and high_max, which are the adjacent representable
		# values bracketing the value of max_natint.  A value
		# below low_max compares so, and so is easily accepted.
		# A float that is above high_max compares so, and so is
		# easily rejected.
		#
		# What remains is the float values low_max and high_max
		# themselves, and all the integers in the range [low_max,
		# high_max).  The only one of these values that is to be
		# rejected is high_max itself, but it can't be directly
		# detected because any of the integers except for low_max
		# might convert to high_max when floated for comparison.
		# The solution is to subtract out low_max, leaving much
		# smaller values that are all exactly representable as
		# integers.  high_max can then be correctly detected.
		return $val >= min_natint &&
			($val < low_max ||
			 ($val <= high_max &&
			  $val - low_max != reduced_high_max));
	}
}

=item sclnum_is_float(VALUE)

Returns a truth value indicating whether the provided VALUE can be represented
in the native floating point data type.  If the floating point type
includes signed zeroes then an unsigned zero (from the native integer
type) does not qualify.

=cut

sub sclnum_is_float($) {
	my($val) = @_;
	if(have_signed_zero && $val == 0.0) {
		$val = $_[0];
		return sprintf("%+.f%+.f", $val, -$val) ne "+0+0";
	} elsif(int($val) != $val || float_is_infinite($val)) {
		return 1;
	} elsif(significand_bits+1 >= natint_bits) {
		# all native integers are representable as floats
		# (except possibly zero, handled above)
		return 1;
	} else {
		# any integer within the continuous integer range of the
		# float type is a float
		return 1 if $val >= -max_integer() && $val <= max_integer;
		# Anything outside the native integer range is trivially
		# a float.  We can't reliably detect the upper end of this
		# range, because max_natint isn't representable as a
		# float, so compare against the representable high_max.
		return 1 if $val < min_natint || $val > high_max;
		# What remains is an integer that is either high_max or
		# representable as a native integer.  Whether it is a
		# float depends on the length of its binary representation.
		if($val > low_max) {
			# Might be high_max, so we can't use integer
			# arithmetic on it directly.  Shift it down one
			# bit so that we definitely can.  If the bit we
			# lose is set then it's definitely not a float.
			$val -= (1 << (natint_bits-1));
			return 0 if ($val & 1);
			$val = ($val >> 1) + (1 << (natint_bits-2));
		} else {
			$val = abs($val);
		}
		while($val >= (1 << (significand_bits+1))) {
			return 0 if ($val & 1);
			$val >>= 1;
		}
		return 1;
	}
}

=back

=head2 Comparison

=over

=item sclnum_val_cmp(A, B)

Numerically compares the values A and B.  Integer and floating point
values are compared correctly with each other, even if there is no
available format in which both values can be accurately represented.
Returns -1, 0, +1, or undef, indicating whether A is less than, equal
to, greater than, or not comparable with B.  The "not comparable"
situation arises if either value is a floating point NaN (not-a-number).
All flavours of zero compare equal.

This is very similar to Perl's built-in <=> operator.  The only difference
is the capability to compare integer against floating point (where neither
can be represented exactly in the other's format).  <=> performs such
comparisons in floating point, losing accuracy of the integer value.

=cut

sub sclnum_val_cmp($$) {
	my($a, $b) = @_;
	# Due to perl bug #41202, a text->float conversion sometimes
	# gives the wrong answer, but if a text->integer conversion is
	# done first then a later integer->float conversion can give a
	# more accurate answer.  Here we trigger such text->integer
	# conversions, in the situations where it is useful.
	{
		no warnings "void";
		0 + $a;
		0 + $b;
	}
	# Comparison between an integer and a float might be lossy.
	# Specifically, it could show values as equal when they're
	# not.  It can never show equal values as unequal, or give
	# the opposite of the correct order.  So first do the basic
	# comparison, and perform further analysis only if that
	# shows equality and integer->float conversion is in fact
	# lossy.
	my $cmp = $a <=> $b;
	return $cmp unless natint_bits > significand_bits+1 &&
			   defined($cmp) && $cmp == 0;
	# do the rest in positive values
	($a, $b) = (-$b, -$a) if $a < 0;
	# Subtract out powers of two until a difference is detected or we
	# get into the safely comparable range.  Powers of two can be
	# represented as both float and int, so all the arithmetic is exact.
	for(my $t = -min_natint(); $t != (1 << significand_bits); $t >>= 1) {
		next unless $a >= $t && $b >= $t;
		$a -= $t;
		$b -= $t;
		$cmp = $a <=> $b;
		return $cmp unless $cmp == 0;
	}
	return 0;
}

=item sclnum_id_cmp(A, B)

This is a comparison function supplying a total ordering of scalar
numeric values.  Returns -1, 0, or +1, indicating whether A is to be
sorted before, the same as, or after B.

The ordering is of the identities of numeric values, not their numerical
values.  If floating point zeroes are signed, then the three types
(positive, negative, and unsigned) are considered to be distinct.
NaNs compare equal to each other, but different from all numeric values.
The exact ordering provided is mostly numerical order: NaNs come first,
followed by negative infinity, then negative finite values, then negative
zero, then unsigned zero, then positive zero, then positive finite values,
then positive infinity.

In addition to sorting, this function can be useful to check for a zero
of a particular sign.

=cut

my %zero_order = (
	"-0+0" => 0,
	"+0+0" => 1,
	"+0-0" => 2,
);
sub sclnum_id_cmp($$) {
	my($a, $b) = @_;
	if($a != $a) {
		return $b != $b ? 0 : -1;
	} elsif($b != $b) {
		return +1;
	} elsif(have_signed_zero && $a == 0 && $b == 0) {
		($a, $b) = @_;
		return $zero_order{sprintf("%+.f%+.f", $a, -$a)} <=>
			$zero_order{sprintf("%+.f%+.f", $b, -$b)};
	} else {
		return sclnum_val_cmp($a, $b);
	}
}

=back

=head1 BUGS

In Perl 5.6, if configured with a wider-than-usual native integer type
such that there are native integers that can't be represented exactly in
the native floating point type, it is not always possible to distinguish
between integer and floating point values in pure Perl code.  In order
to get the full benefit of either type, one is expected (by the numeric
semantics) to know in advance which of them one is using.  The pure Perl
version of this module can't operate on such a system, but the XS version
works fine.  This problem is resolved by Perl 5.8's new numeric semantics.

=head1 SEE ALSO

L<Data::Float>,
L<Data::Integer>,
L<perlnumber(1)>

=head1 AUTHOR

Andrew Main (Zefram) <zefram@fysh.org>

=head1 COPYRIGHT

Copyright (C) 2007, 2009, 2010 Andrew Main (Zefram) <zefram@fysh.org>

=head1 LICENSE

This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;