view release on metacpan or  search on metacpan

lib/Fukurama/Class/DataTypes.pm  view on Meta::CPAN

			$OVERFLOW_SIGN = $float * 1;
			last;
		}
		if($i > 1_000) {
			$OVERFLOW_SIGN = 'inf';
			last;
		}
	}
}
my $HAS_OVERFLOW = sub {
	($_[0] * 1) eq $OVERFLOW_SIGN;
};
# param: value:SCALAR, type:STRING
my $TYPES = {
	void	=> sub {
		return 1 if(!defined($_[0]));
		(0, $_[0]);
	},
	scalar	=> sub {
		1
	},
	scalarref	=> sub {
		return 1 if(ref($_[0]) eq 'SCALAR');
		(0, $_[0]);
	},
	arrayref	=> sub {
		return 1 if(ref($_[0]) eq 'ARRAY');
		(0, $_[0]);
	},
	hashref		=> sub {
		return 1 if(ref($_[0]) eq 'HASH');
		(0, $_[0]);
	},
	typglobref	=> sub {
		return 1 if(ref($_[0]) eq 'GLOB');
		(0, $_[0]);
	},
	string	=> sub {
		return 1 if(defined($_[0]) && !ref($_[0]));
		(0, $_[0]);
	},
	boolean	=> sub {
		return 1 if(defined($_[0]) && ($_[0] eq '0' || $_[0] eq '1'));
		(0, $_[0]);
	},
	int		=> sub {
		return 1 if(defined($_[0]) && $_[0] =~ m/^\-?[0-9]+$/ && ($_[0] * 1) eq $_[0]);
		return (0, $_[0]) if(!defined($_[0]));
		return (0, $_[0], 'noInt') if($_[0] !~ m/^\-?[0-9]+$/);
		return (0, $_[0] * 1, 'overflow') if(&$HAS_OVERFLOW($_[0]) || ($_[0] * 1) ne $_[0]);
		(0, $_[0] * 1);
	},
	float		=> sub {
		return 1 if(
			defined($_[0])
			&& ( $_[0] =~ m/^[0-9]+\.?[0-9]*$/ || $_[0] =~ m/^[0-9]+\.?[0-9]*e\+?[0-9]+/)
			&& ($_[0] * 1) == $_[0]
			&& !&$HAS_OVERFLOW($_[0])
		);
		return (0, $_[0]) if(!defined($_[0]));
		return (0, $_[0], 'NaN') if($_[0] !~ m/^[0-9]+\.?[0-9]*$/ && $_[0] !~ m/^[0-9]+\.?[0-9]*e\+?[0-9]+$/);
		return (0, $_[0] * 1, 'overflow') if(&$HAS_OVERFLOW($_[0]) || ($_[0] * 1) != $_[0]);
		(0, $_[0]);
	},
	decimal		=> sub {
		return 1 if(defined($_[0]) && $_[0] =~ m/^\-?[0-9]+\.?[0-9]*$/ && ($_[0] * 1) eq $_[0]);
		return (0, $_[0]) if(!defined($_[0]));
		return (0, $_[0], 'NaN') if($_[0] !~ m/^[0-9]+\.?[0-9]*$/ && $_[0] !~ m/^[0-9]+\.?[0-9]*e\+?[0-9]+$/);
		return (0, $_[0] * 1, 'overflow') if(&$HAS_OVERFLOW($_[0]) || ($_[0] * 1) ne $_[0]);
		return (0, $_[0], 'noDec') if($_[0] !~ m/^\-?[0-9]+\.?[0-9]*$/);
		(0, $_[0] * 1);
	},
	class		=> sub {
		return 1 if(!ref($_[0]) && UNIVERSAL::isa($_[0], $_[0]));
		(0, $_[0]);
	},
	object		=> sub {
		return 1 if(ref($_[0]) && UNIVERSAL::isa($_[0], ref($_[0])));
		(0, $_[0]);
	},
	'*class*'	=> sub {
		return 1 if(ref($_[0]) && UNIVERSAL::isa($_[0], $_[1]));
		(0, $_[0]);
	},
};
my $CLASS_TYPES = {
	class	=> 1,
	object	=> 1,
};
# param: check_sub:CODE, value:SCALAR, type:STRING, pos:\INT, all_io:\ARRAY
my $REFS = {
	''		=> sub {
		&{$_[0]}($_[1], $_[2]);
	},
	'[]'	=> sub {
		return 0 if(ref($_[1]) ne 'ARRAY');
		my $i = 0;
		my $error = undef;
		foreach my $entry (@{$_[1]}) {
			my @result = &{$_[0]}($entry, $_[2]);
			if(!$result[0]) {
				$_[1]->[$i] = $result[1];
				$error = \@result;
			}
			++$i;
		}
		if($error) {
			$error->[1] = $_[1];
			return @$error;
		}
		1;
	},
	'()'	=> sub {
		my $error = undef;
		my @io = @{$_[4]}[${$_[3]}..$#{$_[4]}];
		foreach my $entry (@io) {
			my @result = &{$_[0]}($entry, $_[2]);
			if(!$result[0]) {
				$error = \@result;
				last;
			}
		}
		${$_[3]} = $#{$_[4]};
		return @$error if($error);
		1;
	},
	'{}'	=> sub {
		return 0 if(ref($_[1]) ne 'HASH');