our
$VERSION
= 0.004_000;
package
gmp_integer;
package
boolean;
package
unsigned_integer;
package
integer;
package
number;
package
character;
package
string;
RPerl::HelperFunctions_cpp::cpp_load();
our
@EXPORT
=
qw(
gmp_integer_CHECK gmp_integer_CHECKTRACE
gmp_integer_to_boolean gmp_integer_to_unsigned_integer gmp_integer_to_integer gmp_integer_to_number gmp_integer_to_character gmp_integer_to_string
boolean_to_gmp_integer integer_to_gmp_integer unsigned_integer_to_gmp_integer number_to_gmp_integer character_to_gmp_integer string_to_gmp_integer
)
;
our
@EXPORT_OK
=
qw(gmp_integer_typetest0 gmp_integer_typetest1)
;
sub
new {
{
my
gmp_integer
$RETURN_TYPE
};
(
my
string
$class
,
my
number
$input
) =
@ARG
;
if
(
defined
$input
) {
return
Math::BigInt::new(
'gmp_integer'
,
$input
); }
else
{
return
Math::BigInt::new(
'gmp_integer'
, 0 ); }
return
;
}
sub
gmp_integer_CHECK {
{
my
void
$RETURN_TYPE
};
(
my
$possible_gmp_integer
) =
@ARG
;
if
( not(
defined
$possible_gmp_integer
) ) {
die
(
"\nERROR EMPV00, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ngmp_integer external wrapper value expected but undefined/null value found,\ndying\n"
);
}
if
( not( main::RPerl_SvHROKp(
$possible_gmp_integer
) ) ) {
die
(
"\nERROR EMPV01, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ngmp_integer external wrapper value expected but non-hashref value found,\ndying\n"
);
}
my
string
$classname
= main::class(
$possible_gmp_integer
);
if
( not
defined
$classname
) {
die
(
"\nERROR EMPV02, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ngmp_integer external wrapper value expected but non-object (blessed hashref) value found,\ndying\n"
);
}
if
( not( UNIVERSAL::isa(
$possible_gmp_integer
,
'Math::BigInt'
) ) ) {
die
(
"\nERROR EMPV03, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ngmp_integer external wrapper value expected but non-Math::BigInt-derived object value found,\ndying\n"
);
}
if
(
$classname
ne
'gmp_integer'
) {
die
(
"\nERROR EMPV04, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ngmp_integer external wrapper value expected but non-gmp_integer object value found,\ndying"
);
}
if
( not
exists
$possible_gmp_integer
->{value} ) {
die
(
"\nERROR EMPV05, MISSING HASH ENTRY, PERLOPS_PERLTYPES:\ngmp_integer internal wrapped object in hash entry expected at key 'value' but no hash entry exists,\ndying\n"
);
}
if
( not
defined
$possible_gmp_integer
->{value} ) {
die
(
"\nERROR EMPV06, MISSING HASH ENTRY, PERLOPS_PERLTYPES:\ngmp_integer internal wrapped object in hash entry expected at key 'value' but no hash entry defined;\nOR\nERROR EMPV07, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ngmp_integer internal wrapped value expected but undefined/null value found,\ndying\n"
);
}
if
( not
defined
main::class(
$possible_gmp_integer
->{value} ) ) {
die
(
"\nERROR EMPV08, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ngmp_integer internal wrapped value expected but non-object (blessed hashref) value found,\ndying\n"
);
}
if
( not( UNIVERSAL::isa(
$possible_gmp_integer
->{value},
'Math::BigInt::GMP'
) ) ) {
die
(
"\nERROR EMPV09, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ngmp_integer internal wrapped value expected but non-Math::BigInt::GMP object value found,\ndying\n"
);
}
return
;
}
sub
gmp_integer_CHECKTRACE {
{
my
void
$RETURN_TYPE
};
(
my
$possible_gmp_integer
,
my
$variable_name
,
my
$subroutine_name
) =
@ARG
;
if
( not(
defined
$possible_gmp_integer
) ) {
die
(
"\nERROR EMPV00, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ngmp_integer external wrapper value expected but undefined/null value found,\nin variable "
.
$variable_name
.
" from subroutine "
.
$subroutine_name
.
",\ndying\n"
);
}
if
( not( main::RPerl_SvHROKp(
$possible_gmp_integer
) ) ) {
die
(
"\nERROR EMPV01, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ngmp_integer external wrapper value expected but non-hashref value found,\nin variable "
.
$variable_name
.
" from subroutine "
.
$subroutine_name
.
",\ndying\n"
);
}
my
string
$classname
= main::class(
$possible_gmp_integer
);
if
( not
defined
$classname
) {
die
(
"\nERROR EMPV02, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ngmp_integer external wrapper value expected but non-object (blessed hashref) value found,\nin variable "
.
$variable_name
.
" from subroutine "
.
$subroutine_name
.
",\ndying\n"
);
}
if
( not( UNIVERSAL::isa(
$possible_gmp_integer
,
'Math::BigInt'
) ) ) {
die
(
"\nERROR EMPV03, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ngmp_integer external wrapper value expected but non-Math::BigInt-derived object value found,\nin variable "
.
$variable_name
.
" from subroutine "
.
$subroutine_name
.
",\ndying\n"
);
}
if
(
$classname
ne
'gmp_integer'
) {
die
(
"\nERROR EMPV04, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ngmp_integer external wrapper value expected but non-gmp_integer object value found,\nin variable "
.
$variable_name
.
" from subroutine "
.
$subroutine_name
.
",\ndying\n"
);
}
if
( not
exists
$possible_gmp_integer
->{value} ) {
die
(
"\nERROR EMPV05, MISSING HASH ENTRY, PERLOPS_PERLTYPES:\ngmp_integer internal wrapped object in hash entry expected at key 'value' but no hash entry exists,\nin variable "
.
$variable_name
.
" from subroutine "
.
$subroutine_name
.
",\ndying\n"
);
}
if
( not
defined
$possible_gmp_integer
->{value} ) {
die
(
"\nERROR EMPV06, MISSING HASH ENTRY, PERLOPS_PERLTYPES:\ngmp_integer internal wrapped object in hash entry expected at key 'value' but no hash entry defined;\nOR\nERROR EMPV07, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ngmp_integer internal wrapped value expected but undefined/null value found,\nin variable "
.
$variable_name
.
" from subroutine "
.
$subroutine_name
.
",\ndying\n"
);
}
if
( not
defined
main::class(
$possible_gmp_integer
->{value} ) ) {
die
(
"\nERROR EMPV08, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ngmp_integer internal wrapped value expected but non-object (blessed hashref) value found,\nin variable "
.
$variable_name
.
" from subroutine "
.
$subroutine_name
.
",\ndying\n"
);
}
if
( not( UNIVERSAL::isa(
$possible_gmp_integer
->{value},
'Math::BigInt::GMP'
) ) ) {
die
(
"\nERROR EMPV09, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ngmp_integer internal wrapped value expected but non-Math::BigInt::GMP object value found,\nin variable "
.
$variable_name
.
" from subroutine "
.
$subroutine_name
.
",\ndying\n"
);
}
return
;
}
sub
gmp_integer_to_boolean {
{
my
boolean
$RETURN_TYPE
};
(
my
gmp_integer
$input_gmp_integer
) =
@ARG
;
gmp_integer_CHECKTRACE(
$input_gmp_integer
,
'$input_gmp_integer'
,
'gmp_integer_to_boolean()'
);
if
( gmp_get_signed_integer(
$input_gmp_integer
) == 0 ) {
return
0; }
else
{
return
1; }
return
;
}
sub
gmp_integer_to_unsigned_integer {
{
my
unsigned_integer
$RETURN_TYPE
};
(
my
gmp_integer
$input_gmp_integer
) =
@ARG
;
gmp_integer_CHECKTRACE(
$input_gmp_integer
,
'$input_gmp_integer'
,
'gmp_integer_to_unsigned_integer()'
);
return
abs
$input_gmp_integer
->numify();
}
sub
gmp_integer_to_integer {
{
my
integer
$RETURN_TYPE
};
(
my
gmp_integer
$input_gmp_integer
) =
@ARG
;
gmp_integer_CHECKTRACE(
$input_gmp_integer
,
'$input_gmp_integer'
,
'gmp_integer_to_integer()'
);
return
$input_gmp_integer
->numify();
}
sub
gmp_integer_to_number {
{
my
number
$RETURN_TYPE
};
(
my
gmp_integer
$input_gmp_integer
) =
@ARG
;
gmp_integer_CHECKTRACE(
$input_gmp_integer
,
'$input_gmp_integer'
,
'gmp_integer_to_number()'
);
return
$input_gmp_integer
->numify() * 1.0;
}
sub
gmp_integer_to_character {
{
my
character
$RETURN_TYPE
};
(
my
gmp_integer
$input_gmp_integer
) =
@ARG
;
gmp_integer_CHECKTRACE(
$input_gmp_integer
,
'$input_gmp_integer'
,
'gmp_integer_to_character()'
);
my
string
$tmp_string
= gmp_integer_to_string(
$input_gmp_integer
);
if
(
$tmp_string
eq
q{}
) {
return
q{}
; }
else
{
return
substr
$tmp_string
, 0, 1; }
return
;
}
sub
gmp_integer_to_string {
{
my
string
$RETURN_TYPE
};
(
my
gmp_integer
$input_gmp_integer
) =
@ARG
;
gmp_integer_CHECKTRACE(
$input_gmp_integer
,
'$input_gmp_integer'
,
'gmp_integer_to_string()'
);
my
integer
$is_negative
=
$input_gmp_integer
->is_neg();
my
string
$retval
=
reverse
$input_gmp_integer
->bstr();
if
(
$is_negative
) {
chop
$retval
; }
$retval
=~ s/(\d{3})/$1_/gxms;
if
( (
substr
$retval
, -1, 1 ) eq
'_'
) {
chop
$retval
; }
$retval
=
reverse
$retval
;
if
(
$is_negative
) {
$retval
=
q{-}
.
$retval
; }
return
$retval
;
}
sub
boolean_to_gmp_integer {
{
my
gmp_integer
$RETURN_TYPE
};
(
my
boolean
$input_boolean
) =
@ARG
;
::boolean_CHECKTRACE(
$input_boolean
,
'$input_boolean'
,
'boolean_to_gmp_integer()'
);
my
gmp_integer
$output_gmp_integer
= gmp_integer->new(
$input_boolean
);
return
$output_gmp_integer
;
}
sub
integer_to_gmp_integer {
{
my
gmp_integer
$RETURN_TYPE
};
(
my
integer
$input_integer
) =
@ARG
;
::integer_CHECKTRACE(
$input_integer
,
'$input_integer'
,
'integer_to_gmp_integer()'
);
my
gmp_integer
$output_gmp_integer
= gmp_integer->new(
$input_integer
);
return
$output_gmp_integer
;
}
sub
unsigned_integer_to_gmp_integer {
{
my
gmp_integer
$RETURN_TYPE
};
(
my
unsigned_integer
$input_unsigned_integer
) =
@ARG
;
::unsigned_integer_CHECKTRACE(
$input_unsigned_integer
,
'$input_unsigned_integer'
,
'unsigned_integer_to_gmp_integer()'
);
my
gmp_integer
$output_gmp_integer
= gmp_integer->new(
$input_unsigned_integer
);
return
$output_gmp_integer
;
}
sub
number_to_gmp_integer {
{
my
gmp_integer
$RETURN_TYPE
};
(
my
number
$input_number
) =
@ARG
;
::number_CHECKTRACE(
$input_number
,
'$input_number'
,
'number_to_gmp_integer()'
);
my
gmp_integer
$output_gmp_integer
= gmp_integer->new( number_to_integer(
$input_number
) );
return
$output_gmp_integer
;
}
sub
character_to_gmp_integer {
{
my
gmp_integer
$RETURN_TYPE
};
(
my
character
$input_character
) =
@ARG
;
::character_CHECKTRACE(
$input_character
,
'$input_character'
,
'character_to_gmp_integer()'
);
my
gmp_integer
$output_gmp_integer
= gmp_integer->new( character_to_integer(
$input_character
) );
return
$output_gmp_integer
;
}
sub
string_to_gmp_integer {
{
my
gmp_integer
$RETURN_TYPE
};
(
my
string
$input_string
) =
@ARG
;
::string_CHECKTRACE(
$input_string
,
'$input_string'
,
'string_to_gmp_integer()'
);
my
gmp_integer
$output_gmp_integer
= gmp_integer->new( string_to_integer(
$input_string
) );
return
$output_gmp_integer
;
}
sub
gmp_integer_typetest0 {
{
my
gmp_integer
$RETURN_TYPE
};
my
gmp_integer
$retval
= ( 21 / 7 ) + main::RPerl__DataType__Integer__MODE_ID();
return
(
$retval
);
}
sub
gmp_integer_typetest1 {
{
my
gmp_integer
$RETURN_TYPE
};
(
my
gmp_integer
$lucky_gmp_integer
) =
@ARG
;
::gmp_integer_CHECKTRACE(
$lucky_gmp_integer
,
'$lucky_gmp_integer'
,
'gmp_integer_typetest1()'
);
return
( (
$lucky_gmp_integer
* 2 ) + main::RPerl__DataType__Integer__MODE_ID() );
}
1;